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_be(Spatial, eat, t) - 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%   state(Spatial, open, t) - container is state(Spatial, open, t) (must be state(Spatial, open, t) to be used. there is no "closed").
   32%   can_be(Spatial, open, t) - can be opened and closed
   33%   capacity(N) - number of objects a container or supporter can hold
   34%   state(Spatial, locked, t) - cannot be opened
   35%   can_be(Spatial, lock, t), 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 state(Spatial, open, 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%   is_reachable(actor)
   55%   valid(verb) - is object seeable, reachable, etc.
   56%   verification(verb) - is verb logical for this object
   57% Parser disambiguation:
   58%   eliminate objs not see, reachable, etc.
   59%   check preconditions for acting on a candidate object
   60
   61
   62%:- op(900, xfx, props).
   63:- op(900, fy, '~').   64
   65istate([
   66       structure_label(istate),
   67
   68       props('floyd~1', [name('Floyd the robot'), inherit(autonomous,t),  % can_do(Spatial, eat, f), 
   69           inherit(robot,t)]),
   70       props('player~1', [name($self),inherit(console,t), inherit(humanoid,t)]),
   71
   72       % props(telnet, [inherit(telnet,t),isnt(console),inherit('player~1')]),
   73	
   74	
   75       h(Spatial, in, 'floyd~1', pantry),
   76	
   77	
   78	h(Spatial, in, 'player~1', kitchen),
   79	h(Spatial, worn_by, 'watch~1', 'player~1'),
   80	h(Spatial, held_by, 'bag~1', 'player~1'),
   81	
   82       h(Spatial, in, 'coins~1', 'bag~1'),
   83       h(Spatial, held_by, 'wrench~1', 'floyd~1'),
   84
   85  props('coins~1',[inherit(coins,t)]),
   86  % Relationships
   87
   88  h(Spatial, exit(south), pantry, kitchen), % pantry exits south to kitchen
   89  h(Spatial, exit(north), kitchen, pantry),
   90  h(Spatial, exit(down), pantry, basement),
   91  h(Spatial, exit(up), basement, pantry),
   92  h(Spatial, exit(south), kitchen, garden),
   93  h(Spatial, exit(north), garden, kitchen),
   94  h(Spatial, exit(east), kitchen, dining_room),
   95  h(Spatial, exit(west), dining_room, kitchen),
   96  h(Spatial, exit(north), dining_room, living_room),
   97  h(Spatial, exit(east), living_room, dining_room),
   98  h(Spatial, exit(south), living_room, kitchen),
   99  h(Spatial, exit(west), kitchen, living_room),
  100
  101  h(Spatial, in, a(shelf), pantry), % shelf is in pantry
  102       h(Spatial, in, a(table), kitchen), % a table is in kitchen
  103       h(Spatial, on, a(lamp), the(table)), % a lamp is on the table
  104  h(Spatial, in, a(rock), garden),
  105  h(Spatial, in, a(mushroom), garden),
  106  h(Spatial, reverse(on), a(table), a(table_leg)),
  107  h(Spatial, on, a(box), a(table)),
  108  h(Spatial, in, a(bowl), a(box)),
  109  h(Spatial, in, a(flour), a(bowl)),
  110  h(Spatial, in, a(shovel), basement), % FYI shovel has not props (this is a lttle test to see what happens)
  111  h(Spatial, in, a(videocamera), living_room),
  112  h(Spatial, in, screendoor, kitchen),
  113  h(Spatial, in, screendoor, garden),
  114
  115       class_props(unthinkable, [
  116          can_be(Spatial, examine(_), f),
  117          class_desc(['It is normally unthinkable'])]),
  118
  119       class_props(thinkable, [
  120          can_be(Spatial, examine(_), t),
  121          class_desc(['It is normally thinkable'])]),
  122
  123       class_props(only_conceptual, [   
  124          can_be(Spatial, examine(Spatial), f),
  125          inherit(thinkable,t),
  126          class_desc(['It is completely conceptual'])]),
  127
  128       class_props(noncorporial, [
  129          can_be(Spatial, examine(Spatial), f),
  130          can_be(Spatial, touch, f),
  131          inherit(thinkable,t),
  132          desc(['It is completely non-corporial'])]),
  133
  134       class_props(partly_noncorporial, [
  135          inherit(corporial,t),
  136          inherit(noncorporial,t),
  137          class_desc(['It is both partly corporial and non-corporial'])]),
  138
  139       class_props(corporial, [
  140          can_be(Spatial, touch, t),
  141          can_be(Spatial, examine(Spatial), t),
  142          inherit(thinkable,t),
  143          class_desc(['It is corporial'])]),
  144
  145  % People
  146   class_props(character, [
  147       has_rel(Spatial, held_by),
  148       has_rel(Spatial, worn_by),
  149       % overridable defaults
  150       mass(50), volume(50), % liters     (water is 1 kilogram per liter)
  151       can_do(Spatial, eat, t),
  152       can_do(Spatial, examine, t),
  153       can_do(Spatial, touch, t),
  154       has_sense(Sense),
  155       inherit(perceptq,t),
  156       inherit(memorize,t),
  157       iherit(partly_noncorporial)
  158   ]),
  159
  160      class_props(natural_force, [
  161          ~has_rel(Spatial, held_by),
  162          ~has_rel(Spatial, worn_by),
  163          can_do(Spatial, eat, f),
  164
  165          can_do(Spatial, examine, t),
  166          can_be(Spatial, touch, f),
  167          has_sense(Sense),
  168          iherit(character)
  169      ]),
  170
  171       class_props(humanoid, [
  172         can_do(Spatial, eat, t),
  173           volume(50), % liters     (water is 1 kilogram per liter)
  174           mass(50), % kilograms
  175            inherit(character,t),
  176            inherit(memorize,t),
  177            inherit(player,t),
  178            % players use power but cant be powered down
  179            can_be(Spatial, switch, f), state(Spatial, powered, t)
  180      ]),
  181
  182  class_props(robot, [
  183    can_do(Spatial, eat, f),
  184    inherit(autonomous,t),
  185    EmittingLight,
  186    volume(50), mass(200), % density(4) % kilograms per liter
  187    nouns(robot),
  188    adjs(metallic),
  189    desc('Your classic robot: metallic with glowing red eyes, enthusiastic but not very clever.'),
  190    can_be(Spatial, switch, t),
  191    inherit(memorize,t),
  192    inherit(shiny,t),
  193    inherit(character,t),
  194    state(Spatial, powered, t),
  195    % TODO: 'floyd~1' should `look(Spatial)` when turned back on.
  196        effect(switch(Spatial, on), setprop($self, state(Spatial, powered, t))),
  197        effect(switch(Spatial, off), setprop($self, state(Spatial, powered, f)))
  198  ]),
  199
  200  % Places
  201  class_props(place, [can_be(Spatial, move, f), inherit(container,t), volume_capacity(10000), has_rel(exit(_), t)]),
  202
  203  class_props(container, [
  204
  205         oper(put(Spatial, Thing, in, $self),
  206            % precond(Test, FailureMessage)
  207            precond(~getprop(Thing, inherit(liquid,t)), ['liquids would spill out']),
  208           % body(clause)
  209            body(move(Spatial, Thing, in, $self))),
  210         has_rel(Spatial, in)
  211       ]),
  212
  213  class_props(flask, [
  214
  215           oper(put(Spatial, Thing, in, $self),
  216              % precond(Test, FailureMessage)
  217              precond(getprop(Thing, inherit(corporial,t)), ['non-physical would spill out']),
  218             % body(clause)
  219              body(move(Spatial, Thing, in, $self))),
  220
  221           inherit(container,t)
  222       ]),
  223
  224  props(basement, [
  225    inherit(place,t),
  226    desc('This is a very dark basement.'),
  227    TooDark
  228  ]),
  229  props(dining_room, [inherit(place,t)]),
  230  props(garden, [
  231    inherit(place,t),
  232    % goto(Spatial, dir, result) provides special handling for going in a direction.
  233    goto(Spatial, up, 'You lack the ability to fly.'),
  234    effect(goto(Spatial, _, north), getprop(screendoor, state(Spatial, open, t))),
  235    oper(/*garden, */ goto(Spatial, _, north),
  236         % precond(Test, FailureMessage)
  237         precond(getprop(screendoor, state(Spatial, open, t)), ['you must open the door first']),
  238         % body(clause)
  239         body(inherited)
  240    ),
  241    % cant_go provides last-ditch special handling for Go.
  242    cant_goto(Spatial, 'The fence surrounding the garden is too tall and solid to pass.')
  243  ]),
  244  props(kitchen, [inherit(place,t)]),
  245  props(living_room, [inherit(place,t)]),
  246  props(pantry, [
  247    inherit(place,t),
  248    nouns(closet),
  249    nominals(kitchen),
  250    desc('You\'re in a dark pantry.'),
  251    TooDark
  252  ]),
  253
  254  % Things
  255  
  256  class_props(bag, [
  257    inherit(container,t),
  258    volume_capacity(10),
  259    TooDark
  260  ]),
  261  class_props(bowl, [
  262    inherit(container,t),
  263    volume_capacity(2),
  264    fragile(shards),
  265    inherit(flask,t),
  266    name('porcelain bowl'),
  267    desc('This is a modest glass cooking bowl with a yellow flower motif glazed into the outside surface.')
  268  ]),
  269  class_props(box, [
  270    inherit(container,t),
  271    volume_capacity(15),
  272    fragile(splinters),
  273    %can_be(Spatial, open, t),
  274    state(Spatial, open, f),
  275    %can_be(Spatial, lock, t),
  276    state(Spatial, locked, t),
  277    TooDark
  278  ]),
  279
  280  class_props(measurable,[has_rel(quantity,ammount,t)]),
  281  
  282  % shiny things are corporial
  283  class_props(shiny, [adjs(shiny), inherit(corporial,t)]),
  284
  285  class_props(coins, [inherit(shiny,t),inherit(measurable,t)]),
  286  class_props(flour,[can_be(Spatial, eat, t),inherit(measurable,t)]),
  287  class_props(lamp, [
  288    name('shiny brass lamp'),
  289    nouns(light),
  290    nominals(brass),
  291    inherit(shiny,t),
  292    can_be(Spatial, switch, t),
  293    state(Spatial, powered, t),
  294    EmittingLight,
  295    effect(switch(Spatial, on), setprop($self, EmittingLight)),
  296    effect(switch(Spatial, off), delprop($self, EmittingLight)),
  297    fragile(broken_lamp)
  298  ]),
  299  class_props(broken_lamp, [
  300    name('dented brass lamp'),
  301    % TODO: prevent user from referring to 'broken_lamp'
  302    nouns(light),
  303    nominals(brass),
  304    adjs(dented),
  305    can_be(Spatial, switch, t),
  306    effect(switch(Spatial, on), true),
  307    effect(switch(Spatial, off), true) % calls true(S0, S1) !
  308  ]),
  309       props(iLamp, [
  310         inherit(broken,t), 
  311         effect(switch(Spatial, on), print_("Switch is flipped")),
  312         effect(hit, ['print_'("Hit iLamp"), setprop($self, inherit(broken,t))]),
  313         inherit(lamp,t)
  314       ]),
  315       class_props(broken, [
  316          effect(switch(Spatial, on), true),
  317          effect(switch(Spatial, off), true),
  318          can_be(Spatial, switch, t),
  319          adjs(broken)
  320       ]),
  321  class_props(mushroom, [
  322    % Sense DM4
  323    name('speckled mushroom'),
  324    % singular,
  325    nouns([mushroom, fungus, toadstool]),
  326    adjs([speckled]),
  327    % initial(description used until initial state changes)
  328    initial('A speckled mushroom grows out of the sodden earth, on a long stalk.'),
  329    % description(examination description)
  330    desc('The mushroom is capped with blotches, and you aren\'t at all sure it\'s not a toadstool.'),
  331    can_be(Spatial, eat, t),
  332    % before(VERB, CODE) -- Call CODE before default code for VERB.
  333    %                      If CODE succeeds, don't call VERB.
  334    before(eat, (random(100) =< 30, die('It was poisoned!'); 'yuck!')),
  335    after(take,
  336          (initial, 'You pick the mushroom, neatly cleaving its thin stalk.'))
  337  ]),
  338  props(screendoor, [
  339    can_be(Spatial, move, f),
  340    % see DM4
  341    door_to(garden),
  342    %can_be(Spatial, open, t)
  343    state(Spatial, open, f)
  344  ]),
  345  class_props(shelf, [has_rel(Spatial, on), can_be(Spatial, move, f)]),
  346  class_props(table, [has_rel(Spatial, on), has_rel(Spatial, under)]),
  347  class_props(wrench, [inherit(shiny,t)]),
  348  class_props(videocamera, [
  349    inherit(memorize,t),
  350    inherit(perceptq,t),    
  351    can_be(Spatial, switch, t),
  352        effect(switch(Spatial, on), setprop($self, state(Spatial, powered, t))),
  353        effect(switch(Spatial, off), setprop($self, state(Spatial, powered, f))),
  354    state(Spatial, powered, t),
  355    has_sense(Sense),
  356    fragile(broken_videocam)
  357  ]),
  358  class_props(broken_videocam, [can_be(Spatial, switch, f),state(Spatial, powered, f), inherit(videocamera,t)])
  359         
  360]) :-
  361  sensory_model_problem_solution(Sense, Spatial, TooDark, EmittingLight).
  362
  363
  364%:- op(0, xfx, props).