1/*
    2% NomicMUD: A MUD server written in Prolog
    3% Maintainer: Douglas Miles
    4% Dec 13, 2035
    5%
    6% Bits and pieces:
    7%
    8% LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    9%
   10% Copyright (C) 2004 Marty White under the GNU GPL
   11% Sept 20, 1999 - Douglas Miles
   12% July 10, 1996 - John Eikenberry
   13%
   14% Logicmoo Project changes:
   15%
   16% Main file.
   17%
   18*/
   19
   20% Some Inform properties:
   21% light - rooms that have light in them
   22% can(eat) - can be eaten
   23% static - can't be taken or moved
   24% scenery - assumed to be in the room description (implies static)
   25% concealed - obscured, not listed, not part of 'all', but there
   26% found_in - lists places where scenery objects are seen
   27% absent - hides object entirely
   28% clothing - can be worn
   29% worn - is being worn
   30% container
   31% (opened = t) - container is open (must be opened) to be used. there is no "closed").
   32% can(open) - can be opened and closed
   33% capacity(N) - number of objects a container or supporter can hold
   34% state(locked) - cannot be opened
   35% can(lock), with_key
   36% enterable
   37% supporter
   38% article - specifies indefinite article ('a', 'le')
   39% cant_go
   40% daemon - called each turn, if it is enabled for this object
   41% description
   42% inside_description
   43% invent - code for inventory listing of that object
   44% list_together - way to handle "5 fish"
   45% plural - pluralized-name =  if different from singular
   46% when_closed - description when closed
   47% when_open - description when (opened = t)
   48% when_on, when_off - like when_closed, etc.
   49% Some TADS properties:
   50% thedesc
   51% pluraldesc
   52% is_indistinguishable
   53% is_visible(vantage)
   54% touchable($agent, actor)
   55% valid(verb) - is object seeable, touchable, etc.
   56% verification(verb) - is verb logical for this object
   57% Parser disambiguation:
   58% eliminate objs not visalbe, touchable, etc.
   59% check preconditions for acting on a candidate object
   60
   61
   62:- op(1199, xfx, props).   63:- op(1199, xfx, type).   64:- op(900, fx, ~).   65
   66
   67dest_target(spatially(in, Dest), Target):- nonvar(Dest), !, dest_target(Dest, Target).
   68dest_target(spatially(to, Dest), Target):- nonvar(Dest), !, dest_target(Dest, Target).
   69dest_target(loc(_, _, _, Target), Target):- nonvar(Target), !.
   70
   71
   72type_functor(dest, spatially(in, inst)).
   73type_functor(dest, spatially(at, inst)).
   74type_functor(dest, spatially(on, inst)).
   75type_functor(dest, of(up, $here)).
   76type_functor(dest, of(west, $here)).
   77
   78
   79type_functor(nv_of_any, structure_label(term)).
   80
   81
   82type_functor(memory, goals(list(goals))).
   83type_functor(memory, todo(list(doing))).
   84%type_functor(memory, model(list(state_with_stamps))).
   85type_functor(event, timestamp(ordinal, timept)).
   86
   87%type_functor(state_with_stamps, holds_at(h(domrel, inst, inst), timept)).
   88
   89type_functor(state, type_props(type, list(nv))).
   90type_functor(state, props(inst, list(nv))).
   91type_functor(state, memories(inst, list(event))).
   92type_functor(state, preceptq(inst, list(event))).
   93type_functor(state, h(domrel, inst, inst)).
   94
   95
   96type_functor(doing, inventory(agent)).
   97type_functor(doing, look(agent)).
   98type_functor(doing, examine(agent, optional(sense, see), optional(inst, here), optional(depth, 1))).
   99type_functor(event, percept_props(agent, sense, inst, depth, list(nv))).
  100
  101
  102type_functor(doing, dig(agent, holetype, prep, dest, inst)).
  103type_functor(doing, create(type)).
  104
  105type_functor(doing, eat(agent, inst)).
  106type_functor(doing, hit(agent, inst, with)).
  107type_functor(doing, destroy(inst)).
  108
  109type_functor(doing, switch(agent, tfstate, tf, inst)).
  110type_functor(doing, touch(agent, inst)).
  111
  112%type_functor(doing, touchable(agent, instance)).
  113
  114
  115%type_functor(doing, say(Message)).  % undirected message
  116type_functor(doing, emote(agent, emotype, dest, statement)).
  117type_functor(event, emoted(agent, emotype, dest, statement)).
  118
  119
  120type_functor(doing, wait(agent)).
  121type_functor(event, time_passes(agent)).
  122
  123
  124type_functor(doing, recall(agent, prop, inst2)).
  125type_functor(doing, properties(inst)).
  126type_functor(doing, inspect(agent, getprop(inst, nv))).
  127type_functor(doing, setprop(inst, nv)).
  128type_functor(doing, print_(agent, msg)).
  129
  130
  131
  132type_functor(doing, give(agent, inst, agnt2)).
  133type_functor(doing, take(agent, inst)).
  134type_functor(doing, drop(agent, inst)).
  135
  136type_functor(doing, go_dir(agent, movetype, dir)).
  137type_functor(doing, goto_obj(agent, movetype, obj)).
  138type_functor(doing, goto_prep_obj(agent, movetype, domrel, obj)).
  139
  140type_functor(doing, goto_loc(agent, movetype, dest)).
  141
  142type_functor(doing, throw(agent, inst, dest)).
  143type_functor(doing, put(agent, inst, dest)).
  144type_functor(event, moved(agent, how, inst, from, prop, to)).
  145
  146
  147
  148type_functor(event, carrying(agent, list(inst))).
  149type_functor(event, destroyed(inst)).
  150type_functor(event, did(action)).
  151type_functor(event, percept(agent, exit_list(in, dest, list(exit)))).
  152type_functor(event, percept(agent, child_list(sense, dest, domrel, depth, list(inst)))).
  153type_functor(event, failed(doing, msg)).
  154type_functor(event, transformed(inst, inst2)).
  155
  156
  157
  158type_functor(nv, adjs(list(text))).
  159type_functor(nv, can(actverb, tf)).
  160type_functor(nv, knows_verbs(actverb, tf)).
  161type_functor(nv, cant_go(inst, dir, text)).
  162type_functor(nv, class_desc(list(text))).
  163type_functor(nv, co(list(nv))).
  164type_functor(nv, desc(sv(text))).
  165type_functor(nv, door_to(inst)).
  166type_functor(nv, effect(verb_targeted, script)).
  167type_functor(nv, breaks_into = type).
  168type_functor(nv, has_rel(domrel, tf)).
  169type_functor(nv, has_sense(sense)).
  170type_functor(nv, isnt(type)).
  171type_functor(nv, inherit(type, tf)).
  172type_functor(nv, inherited(type)).
  173type_functor(nv, inheriting(type)).
  174type_functor(nv, inst(sv(term))).
  175type_functor(nv, name = (sv(text))).
  176type_functor(nv, nominals(list(text))).
  177type_functor(nv, nouns(list(text))).
  178type_functor(nv, oper(doing, preconds, postconds)).
  179type_functor(nv, =(name, value)).
  180
  181two_adjs(W1,W2,W3):- var(W1),var(W2),!,s(A,B,W1,_,_,_),once((ant(A,B,C,D),A>C,at(A,E),at(C,E),s(C,D,W2,_,_,_),s(E,1,W3,_,_,_))).
  182two_adjs(W1,W2,W3):- var(W1),nonvar(W2),!,two_adjs(W2,W1,W3).
  183two_adjs(W1,W2,W3):- s(A,B,W1,_,_,_),once((ant(A,B,C,D),at(A,E),at(C,E),s(C,D,W2,_,_,_),s(E,1,W3,_,_,_))).
  184
  185:- dynamic(istate/1).  186istate([ structure_label(istate) ]).
  187
  188:- push_to_state([
  189
  190% Relationships
  191
  192in(floyd, pantry),
  193in(the(player), kitchen),
  194worn_by(the(watch), the(player)),
  195held_by(the(bag), the(player)),
  196
  197in(the(coins), the(bag)),
  198held_by(the(wrench), floyd),
  199
  200exit(south, pantry, kitchen), % pantry exits south to kitchen
  201exit(north, kitchen, pantry),
  202exit(down, pantry, basement),
  203exit(up, basement, pantry),
  204exit(south, kitchen, garden),
  205exit(north, garden, kitchen),
  206exit(east, kitchen, dining_room),
  207exit(west, dining_room, kitchen),
  208exit(north, dining_room, living_room),
  209exit(east, living_room, dining_room),
  210exit(south, living_room, kitchen),
  211exit(west, kitchen, living_room),
  212
  213in(the(shelf), pantry), % shelf is in pantry
  214in(the(locker), pantry), % locker is in pantry
  215in(the(rock), garden),
  216in(the(fountain), garden),
  217in(the(mushroom), garden),
  218in(the(shovel), basement), % FYI shovel has no props (this is a lttle test to see what happens)
  219in(the(videocamera), living_room),
  220in(the(fireplace), living_room),
  221in(screendoor, kitchen),
  222in(the(crate), kitchen),
  223in(the(apple), the(crate)),
  224in(screendoor, garden),
  225in(brklamp, garden)
  226
  227]).  228
  229term_expansion(StateInfo, (:- push_to_state(StateInfo))):- is_state_info(StateInfo).
  230
  231
  232door type
  233  ~can(take),
  234   can(open),
  235   can(close),
  236   (opened = t),
  237   nouns(door),
  238   fully_corporial.
  239
  240food type
  241   can(eat),
  242   object,
  243   measurable.
  244
  245basement props place,
  246   desc('This is a very dark basement.'),
  247   (dark= t).
  248
  249dining_room props place.
  250
  251
  252:- push_to_state([
  253
  254   props(garden,
  255     [place,
  256   % goto($agent, Prep, Dir, dir, result) provides special handling for going in a direction.
  257   cant_go($agent, up, 'You lack the ability to fly.'),
  258   oper(/*garden, */ go_dir($agent, _, south),
  259   % precond(Test, FailureMessage)
  260     precond(getprop(screendoor, (opened = t)), ['you must open the door first']),
  261   % body(clause)
  262     body(inherited)),
  263   % cant_go provides last-ditch special handling for Go.
  264   cant_go($agent, _Dir, 'The fence surrounding the garden is too tall and solid to pass.')]),
  265
  266   props(kitchen, [inherit(place), desc('cooking happens here')]),
  267
  268   h(reverse(on), the(table), the(table_leg)),
  269   on(the(box), the(table)),
  270   in(the(bowl), the(box)),
  271   in(the(flour), the(bowl)),
  272   in(the(table), kitchen), % a table is in kitchen
  273   on(the(lamp), the(table)), % a lamp is on the table
  274
  275   in(the(sink), kitchen),
  276   in(the(plate), the(sink)),
  277   in(the(cabinate), kitchen),
  278   in(the(cup), the(cabinate)),
  279
  280end_of_list]).  281
  282props(living_room, [inherit(place)]).
  283
  284props(pantry, [
  285   volume_capacity = 1000,
  286   nouns(closet),
  287   nominals(kitchen),
  288   desc('You\'re in a dark kitchen pantry.'),
  289   dark = t,
  290   inherit(place)
  291]).
  292
  293% Things
  294
  295props(brklamp,
  296   inherit(broken),
  297   name = ('possibly broken lamp'),
  298   effect(switch(on), print_(_Agent, "Switch is flipped")),
  299   effect(hit, ['print_'("Hit brklamp"), setprop($self, inherit(broken))]),
  300   inherit(lamp)).
  301
  302    
  303props(screendoor, [
  304   % see DM4
  305   door_to(kitchen),
  306   door_to(garden),
  307   opened = f,
  308   inherit(door)
  309]).
  310
  311
  312:- push_to_state([
  313 type_props(broken, [
  314    name = ('definately broken'),
  315    effect(switch(on), true),
  316    effect(switch(off), true),
  317    can(switch),
  318    adjs([dented]),
  319    adjs($class)
  320 ]),
  321
  322 type_props(mushroom, [
  323   % See DM4
  324   name = ('speckled mushroom'),
  325   % singular,                     
  326   inherit(food),
  327   nouns([mushroom, fungus, toadstool]),
  328   adjs([speckled]),
  329   % initial(description used until initial state changes)
  330   initial('A speckled mushroom grows out of the sodden earth, on a long stalk.'),
  331   % description(examination description)
  332   desc('The mushroom is capped with blotches, and you aren\'t at all sure it\'s not a toadstool.'),
  333   can(eat),
  334   % before(VERB, CODE) -- Call CODE before default code for VERB.
  335   %  If CODE succeeds, don't call VERB.
  336   before(eat, (random100 =< 30, die('It was poisoned!'); 'yuck!')),
  337   after(take,
  338    (initial, 'You pick the mushroom, neatly cleaving its thin stalk.'))]),
  339                               
  340 type_props(door, [
  341   ~can(take),
  342    can(open),
  343    can(close),
  344    (opened = t),
  345    nouns($class),
  346    inherit(fully_corporial)]),
  347
  348 type_props(unthinkable, [
  349   ~can(examine),
  350    adjs($class),
  351    class_desc(['kind is normally unthinkable'])]),
  352
  353 type_props(thinkable, [
  354    can(examine),
  355    nouns($self),
  356    adjs($class),
  357    class_desc(['kind is normally thinkable'])]),
  358
  359 type_props(noncorporial, [
  360   ~can(examine),
  361   ~can(touch),
  362    inherit(thinkable),
  363    adjs($class),
  364   ~inherit(fully_corporial),
  365    class_desc(['direct inheriters are completely noncorporial'])]),
  366
  367 type_props(only_conceptual, [
  368   adjs($class),
  369   inherit(noncorporial),
  370   inherit(thinkable),
  371   class_desc(['kind is only conceptual'])]),
  372
  373 type_props(partly_noncorporial, [
  374   inherit(fully_corporial),
  375   adjs($class),
  376   inherit(noncorporial),
  377   class_desc(['kind is both partly corporial and non-corporial'])]),
  378   
  379 type_props(fully_corporial, [
  380   can(touch),
  381   can(examine),
  382   inherit(thinkable),
  383   cleanliness=clean,
  384   adjs($class),
  385   class_desc(['kind is corporial'])]),
  386   
  387 type_props(object, [
  388    can(examine),
  389    adjs(physical),
  390    can(move),
  391    inherit(fully_corporial),
  392    inherit(thinkable),
  393    class_desc(['kind is an Movable Object'])]),
  394   
  395 type_props(untakeable, [
  396    adjs($class),
  397   ~can(take),
  398    class_desc(['kind is an Immobile Object'])]),
  399   
  400   
  401 type_props(furnature, [
  402   can(examine),
  403   inherit(untakeable),
  404   inherit(fully_corporial),
  405   inherit(surface),
  406   inherit(thinkable),
  407   adjs(physical),
  408   class_desc(['kind is furnature'])]),
  409   
  410
  411  
  412
  413  % People
  414
  415 props(floyd, [name = ('Floyd the robot'), powered = f, inherit(autonomous),inherit(robot)]),
  416
  417 type_props(telnet, [adjs([remote]), inherit(player), nouns([player])]),
  418 type_props(player, [name = ($self),
  419   % 1 = look at object  2 = glance at child_list 3 = glance at grandchildren 
  420   model_depth = 3, % how much of the model to get
  421   % 5 = save game |  4 = debug | 3 = look at Obj | 2 =  | 1 = basic fun info
  422   % prop_depth = 3, % what prop level to get
  423   % Basic fun props
  424   look_depth = 2, 
  425   user_mode = 2, % 1 = fun-only, normal, debug
  426   access_level = admin, % guest,user,admin,wizard
  427   inherit(console), inherit(humanoid)]),
  428 type_props(console, [adjs(physical), nominals([console]), nouns([player])]),
  429
  430 % p(a,b,c).
  431 % c1_p_a1(a),c1_p_a1(b),c1_p_a1(c):-
  432
  433
  434
  435 type_props(humanoid, [
  436   knows_verbs(eat),
  437   volume = 50, % liters  (water is 1 kilogram per liter)
  438   mass = 50, % kilograms
  439   inherit(character),
  440   inherit(memorize),
  441   
  442   % players use power but cant be powered down
  443   can(switch(off), f), powered = t
  444  ]),
  445   
  446 type_props(autonomous, [inherit(autoscan)]),
  447
  448 type_props(character, [
  449   has_rel(worn_by),
  450   has_rel(held_by),
  451   % overridable defaults
  452   model_depth = 3,
  453   mass = 50, volume = 50, % liters  (water is 1 kilogram per liter)
  454   has_sense(see),
  455   %inherit(perceptq),
  456   inherit(no_perceptq),
  457   inherit(memorize),
  458   inherit(actor),
  459   inherit(autoscan),
  460   inherit(partly_noncorporial)
  461  ]),
  462
  463 type_props(actor, [
  464   knows_verbs(examine),
  465   inherit(partly_noncorporial)
  466  ]),
  467
  468 type_props(robot, [
  469  ~knows_verbs(eat),
  470   inherit(autonomous),
  471   emitting(see, light),
  472   volume = 50, mass = 200, % density 4 % kilograms per liter
  473   nouns([robot]),
  474   adjs([metallic]),
  475   desc('Your classic robot: metallic with glowing red eyes, enthusiastic but not very clever.'),
  476   can(switch),
  477   inherit(memorize),
  478   nouns($class),
  479   inherit(shiny),
  480   inherit(character),
  481   powered = t,
  482   % TODO: floyd should `look($agent)` when turned back on.
  483   effect(switch(on), setprop($self, powered = t)),
  484   effect(switch(off), setprop($self, (powered= f)))
  485  ]),
  486
  487  type_props(natural_force, [
  488   ~knows_verbs(eat),      
  489   ~can(touch),
  490   ~has_rel(held_by),
  491   ~has_rel(worn_by),
  492    has_sense(see),
  493    inherit(no_perceptq),
  494    inherit(noncorporial),
  495    inherit(actor)
  496   ]),
  497
  498   
  499   % Places
  500 type_props(place, [
  501   volume_capacity = 10000,
  502   default_rel = in,
  503   has_rel(in),
  504   nouns([here, $self]),
  505   adjs([locally]),
  506  ~can(move),
  507  ~can(take),
  508   oper(discard($agent, Thing),
  509    precond(h(child, $agent, Thing), ['dont have']), % precond(Test, FailureMessage)
  510    body(take($agent, Thing, in, $self))), % body(clause)
  511   % inherit(container),
  512   has_rel(exit(_))
  513  ]),
  514   
  515 type_props(container, [
  516   default_rel = in,
  517   opened = f,
  518   can(open),
  519   has_rel(in),
  520  oper(put($agent, Thing, in, $self),
  521   precond(~getprop(Thing, inherit(liquid)), ['liquids would spill out']), % precond(Test, FailureMessage)
  522   body(take($agent, Thing, in, $self)))  % body(clause)
  523  ]),
  524
  525
  526 type_props(bag, [
  527   volume_capacity = 10,
  528   inherit(container),
  529   inherit(object)   
  530  ]),
  531   
  532 type_props(cup, [inherit(flask)]),
  533   
  534 type_props(flask, [
  535   adjs(physical),
  536  oper(put($agent, Thing, in, $self),
  537   % precond(Test, FailureMessage)
  538   precond(getprop(Thing, inherit(fully_corporial)), ['non-physical would spill out']),
  539   % body(clause)
  540   body(take($agent, Thing, in, $self))),
  541   inherit(container),
  542   inherit(object)
  543  ]),
  544   
  545 type_props(bowl, [
  546   inherit(uncloseable),
  547   inherit(flask),
  548   volume_capacity = 2,
  549   breaks_into = shards,
  550   cleanliness = dirty,
  551   name = ('porcelain bowl'),
  552   desc('This is a modest glass cooking bowl with a yellow flower motif glazed into the outside surface.')
  553  ]),
  554
  555 type_props(plate, [
  556   inherit(surface),
  557   inherit(object),
  558   volume_capacity = 2,
  559   breaks_into = shards,
  560   cleanliness = dirty,
  561   name($class)
  562  ]),
  563
  564 type_props(fireplace, [
  565  ~has_rel(on),
  566   has_rel(over),
  567   inherit(uncloseable),
  568   volume_capacity = 20,
  569   inherit(furnature)
  570  ]),
  571
  572 type_props(box, [
  573   opened = f,
  574   volume_capacity = 11,
  575   inherit(container),
  576   inherit(object),   
  577   inherit(cardboard)
  578  ]),
  579
  580 type_props(crate, [
  581    inherit(container),
  582    inherit(object),
  583    volume_capacity = 13,
  584    inherit(wooden),
  585    (opened = t)
  586  ]),
  587
  588 type_props(locker, [
  589    inherit(container),
  590    inherit(object),
  591    volume_capacity = 13,
  592    inherit(metal),
  593    opened = f
  594  ]),
  595 type_props(wooden, [
  596   breaks_into = splinters,
  597   can(burn)
  598  ]),
  599
  600 type_props(metal, [
  601  ~can(burn)
  602  ]),
  603
  604 type_props(cardboard, [
  605   inherit(paper)
  606  ]),
  607
  608 type_props(paper, [
  609   can(burn)
  610  ]),
  611
  612 type_props(sink, [
  613   cleanliness = dirty,
  614   inherit(uncloseable),
  615   inherit(flask),
  616   inherit(furnature),
  617   volume_capacity = 5
  618  ]),
  619
  620 type_props(uncloseable, [
  621   opened = t,
  622  ~can(close),
  623  ~can(open),
  624   inherit(container)
  625  ]),
  626
  627 type_props(cabinate, [
  628   inherit(container),
  629   inherit(furnature),
  630   volume_capacity = 10
  631  ]),
  632
  633 type_props(fountain, [
  634   volume_capacity = 150,
  635   inherit(place),
  636   inherit(sink)
  637  ]),
  638   
  639 type_props(measurable, [adjs($class), ammount = some]),
  640   
  641   
  642   % shiny things are fully_corporial
  643 type_props(shiny, [adjs($class), inherit(object), inherit(fully_corporial)]),
  644   
  645 type_props(coins, [inherit(shiny), inherit(measurable)]),
  646   
  647 type_props(flour, [inherit(food), inherit(measurable)]),
  648
  649 type_props(lamp, [
  650   name = ('shiny brass lamp'),
  651   powered = t,
  652   can(switch),
  653   nouns(light),
  654   nominals(brass),
  655   inherit(shiny),
  656   inherit(object),
  657   emitting(see, light),
  658   effect(switch(on), setprop($self, emitting(see, light))),
  659   effect(switch(off), delprop($self, emitting(see, light))),
  660   breaks_into = (broken_lamp)
  661  ]),
  662
  663 type_props(broken_lamp, [
  664   name = ('dented brass lamp'),
  665   % TODO: prevent user from referring to 'broken_lamp'
  666   nouns(light),
  667   nominals(brass),
  668   adjs(dented),
  669   can(switch),
  670   effect(switch(on), true),
  671   effect(switch(off), true) % calls true(S0, S1) !
  672  ]),
  673   
  674 type_props(surface, [has_rel(on), default_rel = on, adjs(physical), cleanliness=clean]),
  675   
  676 type_props(shelf, [inherit(surface), adjs(physical), inherit(furnature)]),
  677   
  678 type_props(table, [inherit(surface), adjs(physical), default_rel=on])
  679 ]).  680
  681 type_props(wrench, [inherit(shiny)]).
  682
  683 type_props(videocamera, [
  684   inherit(memorize),
  685   inherit(perceptq),
  686   inherit(memorize_perceptq),
  687   can(switch),
  688   effect(switch(on), setprop($self, powered = t)),
  689   effect(switch(off), setprop($self, (powered= f))),
  690   powered = t,
  691   has_sense(see),
  692   breaks_into = (broken_videocam)
  693  ]).
  694
  695  type_props(broken_videocam, [~can(switch), (powered= f), inherit(videocamera)]).
  696
  697
  698
  699:- multifile(extra_decl/2).  700:- dynamic(extra_decl/2).  701
  702extra_decl(T, PP):- extra_decl0(T, P), correct_props(T, P, PP).
  703extra_decl0(T, P):- member(type_props(T, P), [  ]).
  704   
  705:- op(0, xfx, props).  706
  707%:- istate(IState),sort(IState,SIState),reverse(SIState,RIState), pprint(RIState, always).