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
   21
   22
   23:- dynamic(adv:agent_last_action/3).
   24
   25time_since_last_action(Agent,When):- 
   26  (adv:agent_last_action(Agent,_Action,Last),clock_time(T),When is T - Last) *-> true; clock_time(When).
   27
   28set_last_action(Agent,Action):- 
   29   clock_time(T),
   30   retractall(adv:agent_last_action(Agent,_,_)),
   31   assertz(adv:agent_last_action(Agent,Action,T)).
   32
   33
   34
   35
   36% drop -> move -> touch
   37subsetof(touch, touch).
   38subsetof(move, touch).
   39subsetof(drop, move).
   40subsetof(eat, touch).
   41subsetof(hit, touch).
   42subsetof(put, drop).
   43subsetof(give, drop).
   44subsetof(take, move).
   45subsetof(throw, drop).
   46subsetof(open, touch).
   47subsetof(close, touch).
   48subsetof(lock, touch).
   49subsetof(unlock, touch).
   50subsetof(switch, touch).
   51
   52
   53% feel <- taste <- smell <- look <- listen  (by distance)
   54subsetof(examine, examine).
   55subsetof(listen, examine).
   56subsetof(look, examine).
   57% in order to smell it you have to at least be in sight distance
   58subsetof(smell, look).
   59subsetof(eat, taste).
   60subsetof(taste, smell).
   61subsetof(taste, feel).
   62subsetof(feel, examine).
   63subsetof(feel, touch).
   64subsetof(X,Y):- ground(subsetof(X,Y)),X=Y.
   65
   66subsetof(SpatialVerb1, SpatialVerb2):- compound(SpatialVerb1), compound(SpatialVerb2), !,
   67  SpatialVerb1=..[Verb1,Arg1|_],
   68  SpatialVerb2=..[Verb2,Arg2|_],
   69  subsetof(Verb1, Verb2),
   70  subsetof(Arg1, Arg2).
   71
   72subsetof(SpatialVerb, Verb2):- compound(SpatialVerb), functor(SpatialVerb, Verb, _), !,
   73  subsetof(Verb, Verb2).
   74
   75subsetof(Verb, SpatialVerb2):- compound(SpatialVerb2), functor(SpatialVerb2, Verb2, _), !,
   76  subsetof(Verb, Verb2).
   77
   78% proper subset - C may not be a subset of itself.
   79psubsetof(A, B):- A==B, !, fail.
   80psubsetof(A, B) :- subsetof(A, B).
   81psubsetof(A, C) :-
   82  subsetof(A, B),
   83  subsetof(B, C).
   84
   85
   86
   87
   88do_command(Agent, Action, S0, S1) :-
   89  do_metacmd(Action, S0, S1), !,
   90  redraw_prompt(Agent).
   91
   92do_command(Agent, Action, _, _) :- set_last_action(Agent,Action), fail.
   93  
   94do_command(Agent, Action, S0, S1) :-
   95  declared(memories(Agent, Mem), S0),
   96  do_introspect(Action, Answer, Mem),
   97  queue_percept(Agent, [answer(Answer), Answer], S0, S1), !.
   98  %player_format('~w~n', [Answer]).
   99do_command(Agent, Action, S0, S3) :-
  100  undeclare(memories(Agent, Mem0), S0, S1),
  101  memorize(did(Action), Mem0, Mem1),
  102  declare(memories(Agent, Mem1), S1, S2),
  103  must_act(Agent, Action, S2, S3), !,
  104  nop(redraw_prompt(Agent)).
  105do_command(Agent, Action, S0, S0) :-
  106  player_format('Failed or No Such Command: ~w~n', Action), !,
  107  nop(redraw_prompt(Agent)).
  108
  109% --------
  110
  111do_todo(Agent, S0, S0):- 
  112  declared(memories(Agent, Mem0), S0),member(todo([]),Mem0),!.
  113do_todo(Agent, S0, S9) :- 
  114  undeclare(memories(Agent, Mem0), S0, S1),
  115  forget(todo(OldToDo), Mem0, Mem1),
  116  append([Action], NewToDo, OldToDo),
  117  memorize(todo(NewToDo), Mem1, Mem2),
  118  declare(memories(Agent, Mem2), S1, S2),
  119  apply_first_arg_state(Agent, do_command(Action), S2, S9).
  120do_todo(_Agent, S0, S0).
  121
  122%do_todo_while(Agent, S0, S9) :-
  123%  declared(memories(Agent, Mem0), S0),
  124%  thought(todo(ToDo), Mem0),
  125%  append([Action], NewToDo, OldToDo),
  126
  127
  128
  129% ---- apply_act(Agent, Action, State, NewState)
  130%  where the states also contain Percepts.
  131% In Inform, actions work in the following order:
  132%   game-wide preconditions
  133%   Player preconditions
  134%   objects-in-vicinity react_before conditions
  135%   room before-conditions
  136%   direct-object before-conditions
  137%   verb
  138%   objects-in-vicinity react_after conditions
  139%   room after-conditions
  140%   direct-object after-conditions
  141%   game-wide after-conditions
  142% In TADS:
  143%   "verification" methods perferm tests only
  144
  145no_debug_cant(floyd, _).
  146no_debug_cant('floyd~1', _).
  147no_debug_cant(_, _).
  148
  149apply_act(Agent, examine(How, Thing), State, NewState) :-
  150  (equals_efffectly(sense, Sense, _), equals_efffectly(model, Spatial, _)) ->
  151  Sense \== Spatial, How == Spatial, !,
  152  apply_act(Agent, examine(Sense, Thing), State, NewState).
  153
  154apply_act(Agent, Action, State, NewState) :- no_debug_cant(Agent, Action),
  155  cant(Agent, Action, Reason, State),
  156  reason2eng(Reason, Eng),
  157  queue_percept(Agent, [failure(Action, Reason), Eng], State, NewState), !.
  158
  159apply_act(Agent, Action, State, NewState) :- \+ no_debug_cant(Agent, Action),
  160   \+ \+ cant(Agent, Action, _Reason, State),
  161  trace, rtrace(cant(Agent, Action, Reason, State)), !,
  162  reason2eng(Reason, Eng),
  163  queue_percept(Agent, [failure(Action, Reason), Eng], State, NewState).
  164
  165apply_act(Agent, Action, State, NewState):- act(Agent, Action, State, NewState), !.
  166apply_act(Agent, Act, State, NewState):- ((cmd_workarround(Act, NewAct) -> Act\==NewAct)), !, apply_act(Agent, NewAct, State, NewState).
  167apply_act(Agent, Action, _State, _NewState):- notrace((dbug(act(Agent, Action)), fail)).
  168
  169must_act(Agent, Action, State, NewState):- apply_act(Agent, Action, State, NewState) *-> ! ; fail.
  170% must_act(Agent, Action, S0, S1) :- rtrace(must_act(Agent, Action, S0, S1)), !.
  171must_act(Agent, Action, S0, S1) :-
  172  format(atom(Message), 'You can''t do that ~w. (unparsed (~p))', [Agent, Action]),
  173  queue_percept(Agent, [failure(Action), Message], S0, S1).
  174
  175
  176act(Agent, Action, State, NewState) :-
  177  act_verb_thing_model_sense(Action, Verb, _Thing, Spatial, Sense),
  178  sensory_verb(Sense, Verb),
  179  related(Spatial, How, Agent, Here, State),
  180  sensory_model_problem_solution(Sense, Spatial, _TooDark, _EmittingLight),
  181  findall(What,
  182          related(Spatial, child, What, Here, State),
  183          %(related(Spatial, descended, What, Here, State),
  184           %\+ (related(Spatial, inside, What, Container, State),
  185           %    related(Spatial, descended, Container, Here, State))),
  186          Nearby),
  187  findall(Direction, related(Spatial, exit(Direction), Here, _, State), Exits),
  188  !,
  189  queue_percept(Agent,
  190                [sense(Sense, [you_are(Spatial, How, Here), exits_are(Exits), here_are(Nearby)])],
  191                State, NewState).
  192
  193act(Agent, inventory, State, NewState) :- Spatial = spatial,
  194  findall(What, related(Spatial, child, What, Agent, State), Inventory),
  195  queue_percept(Agent, [carrying(Spatial, Inventory)], State, NewState).
  196
  197act(Agent, inventory(Spatial), State, NewState) :-
  198  findall(What, related(Spatial, child, What, Agent, State), Inventory),
  199  queue_percept(Agent, [carrying(Spatial, Inventory)], State, NewState).
  200
  201act(Agent, examine(Sense, Object), S0, S2) :-
  202  %declared(props(Object, PropList), S0),
  203  ((
  204  findall(P, (getprop(Object, P, S0), is_prop_public(Sense,P)), PropListL),
  205  list_to_set(PropListL,PropList),
  206  queue_percept(Agent, [sense_props(see, Object, PropList)], S0, S1),
  207  (has_rel(Spatial, How, Object, S1); How='<unrelatable>'),
  208  % Remember that Agent might be on the inside or outside of Object.
  209  findall(What,
  210          (related(Spatial, child, What, Object, S1),
  211           once(can_sense(Spatial, Sense, What, Agent, S1))),
  212          ChildrenL),
  213  list_to_set(ChildrenL,Children),
  214  queue_percept(Agent, [notice_children(Sense, Object, How, Children)], S1, S2))).
  215
  216
  217
  218act(Agent, goto(Spatial, _How, ExitName), S0, S9) :-         % go n/s/e/w/u/d/in/out
  219  related(Spatial, child, Agent, Here, S0),
  220  related(Spatial, exit(ExitName), Here, There, S0),
  221  %member(How, [*, to, at, through, thru]),
  222  has_rel(Spatial, HowThere, There, S0),
  223  moveto(Spatial, Agent, HowThere, There,
  224         [Here, There],
  225         [cap(subj(Agent)), person(go, goes), ExitName],
  226         S0, S1),
  227  must_act(Agent, look(Spatial), S1, S9).
  228
  229act(Agent, goto(Spatial, How, Room), S0, S9) :-              % go in (adjacent) room
  230  get_open_traverse(How, Spatial, OpenTraverse),
  231  has_rel(Spatial, How, Room, S0),
  232  related(Spatial, OpenTraverse, Agent, Here, S0),
  233  related(Spatial, exit(ExitName), Here, Room, S0),
  234  moveto(Spatial, Agent, How, Room, [Room, Here],
  235    [cap(subj(Agent)), person(go, goes), ExitName], S0, S1),
  236  must_act(Agent, look(Spatial), S1, S9).
  237
  238act(Agent, goto(Spatial, (*), Room), S0, S9) :-              % go to (adjacent) room
  239  has_rel(Spatial, How, Room, S0),
  240  get_open_traverse(goto, Spatial, OpenTraverse),
  241  related(Spatial, OpenTraverse, Agent, Here, S0),
  242  related(Spatial, exit(ExitName), Here, Room, S0),
  243  moveto(Spatial, Agent, How, Room, [Room, Here],
  244    [cap(subj(Agent)), person(go, goes), ExitName], S0, S1),
  245  must_act(Agent, look(Spatial), S1, S9).
  246act(Agent, goto(Spatial, How, Object), S0, S2) :-            % go in/on object
  247 get_open_traverse(goto(How), Spatial, OpenTraverse),
  248  has_rel(Spatial, How, Object, S0),
  249  related(Spatial, OpenTraverse, Agent, Here, S0),
  250  related(Spatial, OpenTraverse, Object, Here, S0),
  251  \+ is_state(Spatial, ~(open), Object, S0),
  252  moveto(Spatial, Agent, How, Object, [Here],
  253    [subj(Agent), person(get, gets), How, the, Object, .], S0, S1),
  254  must_act(Agent, look(Spatial), S1, S2).
  255act(Agent, goto(Spatial, How, Dest), S0, S1) :-
  256  queue_percept(Agent,
  257                [failure(goto(Spatial, How, Dest)), 'You can\'t go that way'],
  258                S0, S1).
  259
  260%  sim(verb(args...), preconds, effects)
  261%    Agent is substituted for $self.
  262%    preconds are in the implied context of a State.
  263%  In Inform, the following are implied context:
  264%    actor, action, noun, second
  265%  Need:
  266%    actor/agent, verb/action, direct-object/obj1, indirect-object/obj2,
  267%      preposition-introducing-obj2
  268%sim(put(Spatial, Obj1, Obj2),
  269%    ( related(Spatial, descended, Thing, $self),
  270%      has_sensory(Spatial, Sense, $self, Where),
  271%      has_rel(Spatial, Relation, Where),
  272%      related(Spatial, descended, $self, Here)),
  273%    moveto(Spatial, Thing, Relation, Where, [Here],
  274%      [cap(subj($self)), person('put the', 'puts a'),
  275%        Thing, Relation, the, Where, '.'])).
  276
  277act(Agent, take(Spatial, Thing), S0, S1) :-
  278  get_open_traverse(touch, Spatial, OpenTraverse),
  279  related(Spatial, OpenTraverse, Agent, Here, S0),     % Where is Agent now?
  280  moveto(Spatial, Thing, held_by, Agent, [Here],
  281    [silent(subj(Agent)), person('Taken.', [cap(Agent), 'grabs the', Thing, '.'])],
  282    S0, S1).
  283%act(Agent, get(Thing), State, NewState) :-
  284%  act(Agent, take(Spatial, Thing), State, NewState).
  285act(Agent, drop(Spatial, Thing), State, NewState) :-
  286  related(Spatial, How, Agent, Here, State),
  287  has_rel(Spatial, How, Here, State),
  288  moveto(Spatial, Thing, How, Here, [Here],
  289    [cap(subj(Agent)), person('drop the', 'drops a'), Thing, '.'], State, NewState).
  290act(Agent, put(Spatial, Thing1, Relation, Thing2), State, NewState) :-
  291  has_rel(Spatial, Relation, Thing2, State),
  292   get_open_traverse(Open, _See, _Traverse, Spatial, OpenTraverse),
  293  (Relation \= in ; \+ is_state(Spatial, ~(Open), Thing2, State)),
  294  reachable(Spatial, Thing2, Agent, State), % what if "under" an "untouchable" thing?
  295  % OK, put it
  296  related(Spatial, OpenTraverse, Agent, Here, State),
  297  moveto(Spatial, Thing1, Relation, Thing2, [Here],
  298      [cap(subj(Agent)), person('put the', 'puts a'), Thing1,
  299          Relation, the, Thing2, '.'],
  300      State, NewState).
  301act(Agent, give(Spatial, Thing, Recipient), S0, S9) :-
  302  has_rel(Spatial, held_by, Recipient, S0),
  303  reachable(Spatial, Recipient, Agent, S0),
  304  get_open_traverse(give, Spatial, OpenTraverse),
  305  % OK, give it
  306  related(Spatial, OpenTraverse, Agent, Here, S0),
  307  moveto(Spatial, Thing, held_by, Recipient, [Here],
  308    [cap(subj(Agent)), person([give, Recipient, the], 'gives you a'), Thing, '.'],
  309    S0, S9).
  310act(Agent, throw(Spatial, Thing, at, Target), S0, S9) :-
  311  equals_efffectly(sense, Sense, see),
  312  can_sense(Spatial, Sense, Target, Agent, S0),
  313  get_open_traverse(_Open, Sense, throw, Spatial, _OpenTraverse),
  314  % OK, throw it
  315  related(Spatial, How, Agent, Here, S0),
  316  thrown(Spatial, Thing, Target, How, Here, [Here], S0, S1),
  317  hit(Spatial, Target, Thing, [Here], S1, S9).
  318act(Agent, throw(Spatial, Thing, ExitName), S0, S9) :-
  319  related(Spatial, _How, Agent, Here, S0),
  320  related(Spatial, exit(ExitName), Here, There, S0),
  321  has_rel(Spatial, HowThere, There, S0),
  322  thrown(Spatial, Thing, There, HowThere, There, [Here, There], S0, S9).
  323
  324act(Agent, hit(Spatial, Thing), S0, S9) :-
  325  related(Spatial, _How, Agent, Here, S0),
  326  hit(Spatial, Thing, Agent, [Here], S0, S1),
  327  queue_percept(Agent, [true, 'OK.'], S1, S9).
  328
  329act(Agent, dig(Spatial, Hole, Where, Tool), S0, S9) :-
  330  memberchk(Hole, [hole, trench, pit, ditch]),
  331  memberchk(Where, [garden]),
  332  memberchk(Tool, [shovel, spade]),
  333  ((
  334  get_open_traverse(dig, Spatial, OpenTraverse),
  335  related(Spatial, OpenTraverse, Tool, Agent, S0),
  336  related(Spatial, in, Agent, Where, S0),
  337  \+ related(Spatial, _How, Hole, Where, S0),
  338  % OK, dig the hole.
  339  declare(h(Spatial, in, Hole, Where), S0, S1),
  340  setprop(Hole, has_rel(Spatial, in), S1, S2),
  341  setprop(Hole, can_be(Spatial, move, f), S2, S3),
  342  declare(h(Spatial, in, dirt, Where), S3, S8),
  343  queue_event(
  344    [ created(Hole, Where),
  345      [cap(subj(Agent)), person(dig, digs), 'a', Hole, 'in the', Where, '.']],
  346    S8, S9))).
  347
  348act(Agent, eat(Spatial, Thing), S0, S9) :-
  349  getprop(Thing, can_be(Spatial, eat, t), S0),
  350  undeclare(h(Spatial, _, Thing, _), S0, S1),
  351  queue_percept(Agent, [destroyed(Thing), 'Mmmm, good!'], S1, S9).
  352act(Agent, eat(Spatial, Thing), S0, S9) :-
  353  queue_percept(Agent, [failure(eat(Spatial, Thing)), 'It''s inedible!'], S0, S9).
  354
  355
  356act(Agent, switch(Spatial, OnOff, Thing), S0, S) :-
  357  reachable(Spatial, Thing, Agent, S0),
  358  getprop(Thing, can_be(Spatial, switch, t), S0),
  359  getprop(Thing, effect(switch(Spatial, OnOff), Term0), S0),
  360  subst(equivalent, $self, Thing, Term0, Term),
  361  call(Term, S0, S1),
  362  queue_percept(Agent, [true, 'OK'], S1, S).
  363
  364
  365act(Agent, open(Spatial, Thing), S0, S) :-
  366  reachable(Spatial, Thing, Agent, S0),
  367  %getprop(Thing, can_be(Spatial, open, S0),
  368  %\+ getprop(Thing, state(Spatial, open, t), S0),
  369  Open = open, get_open_traverse(Open, Spatial, OpenTraverse),
  370  delprop(Thing, state(Spatial, Open, f), S0, S1),
  371  %setprop(Thing, state(Spatial, open, t), S0, S1),
  372  setprop(Thing, state(Spatial, Open, t), S1, S2),
  373  related(Spatial, OpenTraverse, Agent, Here, S2),
  374  queue_local_event(Spatial, [setprop(Thing, state(Spatial, Open, t)), 'is now open'(Open)], [Here], S2, S).
  375
  376act(Agent, close(Spatial, Thing), S0, S) :-
  377  reachable(Spatial, Thing, Agent, S0),
  378  %getprop(Thing, can_be(Spatial, open, S0),
  379  %getprop(Thing, state(Spatial, open, t), S0),
  380  Open = open, get_open_traverse(Open, Spatial, OpenTraverse),
  381  delprop(Thing, state(Spatial, Open, t), S0, S1),
  382  %delprop(Thing, state(Spatial, open, t), S0, S1),
  383  setprop(Thing, state(Spatial, Open, f), S1, S2),
  384  related(Spatial, OpenTraverse, Agent, Here, S2),
  385  queue_local_event(Spatial, [setprop(Thing, state(Spatial, Open, f)), 'is now closed'(~(Open))], [Here], S2, S).
  386
  387act(Agent, emote(Spatial, SAYTO, Object, Message), S0, S1) :- !, % directed message
  388  dmust((
  389  action_sensory(SAYTO, Sense),
  390  sensory_model(Sense, Spatial),
  391  get_open_traverse(SAYTO, Spatial, OpenTraverse),
  392  can_sense(Spatial, Sense, Object, Agent, S0),
  393  related(Spatial, OpenTraverse, Agent, Here, S0),  
  394  queue_local_event(Spatial, [emoted(Spatial, SAYTO, Agent, Object, Message)], [Here,Object], S0, S1))).
  395%act(Agent, say(Message), S0, S1) :-          % undirected message
  396%  related(Spatial, OpenTraverse, Agent, Here, S0),
  397%  queue_local_event(Spatial, [emoted(Spatial, say, Agent, (*), Message)], [Here], S0, S1).
  398
  399%act(Agent, touch(Spatial, _Thing), S0, S9) :-
  400%  queue_percept(Agent, [true, 'OK.'], S0, S9).
  401act(Agent, Wait, State, NewState) :- Wait == wait,
  402  queue_percept(Agent, [time_passes], State, NewState).
  403act(Agent, print_(Msg), S0, S1) :-
  404  related(Spatial, descended, Agent, Here, S0),
  405   queue_local_event(Spatial, [true, Msg], [Here], S0, S1).
  406act(_Agent, true, S, S).
  407
  408
  409
  410
  411cmd_workarround(VerbObj, VerbObj2):-
  412  VerbObj=..VerbObjL,
  413  notrace(cmd_workarround_l(VerbObjL, VerbObjL2)),
  414  VerbObj2=..VerbObjL2.
  415
  416cmd_workarround_l([Verb|ObjS], [Verb|ObjS2]):-
  417   append(ObjS2, ['.'], ObjS).
  418cmd_workarround_l([Verb|ObjS], [Verb|ObjS2]):-
  419   append(Left, [L, R|More], ObjS), atom(L), atom(R),
  420   current_atom(Atom), atom_concat(L, RR, Atom), RR=R,
  421   append(Left, [Atom|More], ObjS2).
  422% look(Spatial) at screendoor
  423cmd_workarround_l([Verb, Prep|ObjS], [Verb|ObjS]):- is_ignorable(Prep), !.
  424% look(Spatial) at screen door
  425cmd_workarround_l([Verb1|ObjS], [Verb2|ObjS]):- verb_alias(Verb1, Verb2), !.
  426
  427is_ignorable(at). is_ignorable(in). is_ignorable(to). is_ignorable(the). is_ignorable(a). is_ignorable(spatial).
  428
  429verb_alias(look, examine) :- fail