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:- ensure_loaded(adv_axiom).
   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
   35cmd_workarround(VerbObj, VerbObj2):-
   36 VerbObj=..VerbObjL,
   37 notrace(cmd_workarround_l(VerbObjL, VerbObjL2)),
   38 VerbObj2=..VerbObjL2.
   39
   40cmd_workarround_l([Verb|ObjS], [Verb|ObjS2]):-
   41 append(ObjS2, ['.'], ObjS).
   42cmd_workarround_l([Verb|ObjS], [Verb|ObjS2]):- fail,
   43 append(Left, [L, R|More], ObjS), atom(L), atom(R),
   44 current_atom(Atom), atom_concat(L, RR, Atom), RR=R,
   45 append(Left, [Atom|More], ObjS2).
   46% look at screendoor
   47cmd_workarround_l([Verb, Relation|ObjS], [Verb|ObjS]):- is_ignorable(Relation), !.
   48% look(Agent, Spatial) at screen door
   49cmd_workarround_l([Verb1|ObjS], [Verb2|ObjS]):- verb_alias(Verb1, Verb2), !.
   50
   51is_ignorable(Var):- var(Var),!,fail.
   52is_ignorable(at). is_ignorable(in). is_ignorable(to). is_ignorable(the). is_ignorable(a). is_ignorable(spatial).
   53
   54verb_alias(look, examine) :- fail.
   55
   56
   57
   58% drop -> move -> touch
   59subsetof(touch, touch).
   60subsetof(move, touch).
   61subsetof(drop, move).
   62subsetof(eat, touch).
   63subsetof(hit, touch).
   64subsetof(put, drop).
   65subsetof(give, drop).
   66subsetof(take, move).
   67subsetof(throw, drop).
   68subsetof(open, touch).
   69subsetof(close, touch).
   70subsetof(lock, touch).
   71subsetof(unlock, touch).
   72subsetof(switch, touch).
   73
   74subsetof(walk, goto).
   75
   76% feel <- taste <- smell <- look <- listen (by distance)
   77subsetof(examine, examine).
   78subsetof(listen, examine).
   79subsetof(look, examine).
   80% in order to smell it you have to at least be in sight distance
   81subsetof(smell, look).
   82subsetof(eat, taste).
   83subsetof(taste, smell).
   84subsetof(taste, feel).
   85subsetof(feel, examine).
   86subsetof(feel, touch).
   87subsetof(X,Y):- ground(subsetof(X,Y)),X=Y.
   88
   89subsetof(SpatialVerb1, SpatialVerb2):- compound(SpatialVerb1), compound(SpatialVerb2), !,
   90 SpatialVerb1=..[Verb1,Arg1|_],
   91 SpatialVerb2=..[Verb2,Arg2|_],
   92 subsetof(Verb1, Verb2),
   93 subsetof(Arg1, Arg2).
   94
   95subsetof(SpatialVerb, Verb2):- compound(SpatialVerb), functor(SpatialVerb, Verb, _), !,
   96 subsetof(Verb, Verb2).
   97
   98subsetof(Verb, SpatialVerb2):- compound(SpatialVerb2), functor(SpatialVerb2, Verb2, _), !,
   99 subsetof(Verb, Verb2).
  100
  101% proper subset - C may not be a subset of itself.
  102psubsetof(A, B):- A==B, !, fail.
  103psubsetof(A, B) :- subsetof(A, B).
  104psubsetof(A, C) :-
  105 subsetof(A, B),
  106 subsetof(B, C).
  107
  108
  109maybe_pause(Agent):- stdio_player(CP),(Agent==CP -> wait_for_input([user_input],_,0) ; true).
  110
  111do_command(Agent, Action) -->
  112  {overwrote_prompt(Agent)},
  113  do_metacmd(Agent, Action),!.
  114do_command(Agent, Action) -->
  115  {set_last_action(Agent,Action)},
  116 do_action(Agent, Action), !.
  117do_command(Agent, Action) :-
  118 player_format(Agent, 'Failed or No Such Command: ~w~n', Action).
  119
  120% --------
  121
  122do_todo(Agent) -->
  123 sg(declared(memories(Agent, Mem0))),
  124 {member(todo([]),Mem0)},!.
  125do_todo(Agent, S0, S9) :- 
  126 undeclare(memories(Agent, Mem0), S0, S1),
  127 forget(todo(OldToDo), Mem0, Mem1),
  128 append([Action], NewToDo, OldToDo),
  129 memorize(todo(NewToDo), Mem1, Mem2),
  130 declare(memories(Agent, Mem2), S1, S2),
  131 set_last_action(Agent,Action),
  132 do_command(Agent, Action, S2, S9).
  133do_todo(_Agent, S0, S0).
  134
  135%do_todo_while(Agent, S0, S9) :-
  136% declared(memories(Agent, Mem0), S0),
  137% thought(todo(ToDo), Mem0),
  138% append([Action], NewToDo, OldToDo),
  139
  140
  141
  142% ---- apply_act( Action, S0, S9)
  143% where the states also contain Percepts.
  144% In Inform, actions work in the following order:
  145% game-wide preconditions
  146% Player preconditions
  147% objects-in-vicinity react_before conditions
  148% room before-conditions
  149% direct-object before-conditions
  150% verb
  151% objects-in-vicinity react_after conditions
  152% room after-conditions
  153% direct-object after-conditions
  154% game-wide after-conditions
  155% In TADS:
  156% "verification" methods perferm tests only
  157
  158
  159do_action(Agent, Action, S0, S3) :-
  160 quietly_must((
  161 undeclare(memories(Agent, Mem0), S0, S1),
  162 memorize_doing(Action, Mem0, Mem1),
  163 declare(memories(Agent, Mem1), S1, S2))),
  164 dmust_tracing(must_act( Action, S2, S3)), !.
  165
  166memorize_doing(Action, Mem0, Mem0):- has_depth(Action),!.
  167memorize_doing(Action, Mem0, Mem2):- 
  168  copy_term(Action,ActionG),
  169  numbervars(ActionG,999,_),
  170  ( has_depth(Action) 
  171    -> Mem0 = Mem1 ; 
  172    (thought(timestamp(T0,_OldNow), Mem0), T1 is T0 + 1,clock_time(Now), memorize(timestamp(T1,Now), Mem0, Mem1))), 
  173  memorize(attempting(ActionG), Mem1, Mem2).
  174
  175has_depth(Action):- compound(Action), functor(Action,_,A),arg(A,Action,E),compound(E),E=depth(_),!.
  176
  177trival_act(V):- \+ callable(V), !, fail.
  178trival_act(sub__examine(_,_,_,_,_)).
  179trival_act(Action):- has_depth(Action).
  180trival_act(V):- \+ compound(V), !, fail.
  181trival_act(_):- !, fail.
  182trival_act(look(_)).
  183trival_act(wait(_)).
  184
  185satisfy_each(_Ctxt,[]) --> [], !.
  186satisfy_each(Context,[Cond|CondList]) --> !,
  187  must_det(satisfy_each(Context,Cond)), !,
  188  ((sg(member(failed(_Why)))) ; satisfy_each(Context,CondList)),!.
  189satisfy_each(_Ctx,A \= B) --> {dif(A,B)},!.
  190
  191satisfy_each(Context, believe(Beliver, Cond)) --> !, 
  192   undeclare(memories(Beliver,Memory)), !, 
  193   {satisfy_each(Context,Cond,Memory,NewMemory)},  
  194   declare(memories(Beliver,NewMemory)).
  195
  196satisfy_each(postCond(_Action), event(Event), S0, S9) :-  must_act(Event, S0, S9).
  197   
  198satisfy_each(Context, foreach(Cond,Event), S0, S9) :- findall(Event, phrase(Cond,S0,_), TODO), satisfy_each(Context, TODO, S0, S9).
  199satisfy_each(_,precept_local(Where,Event)) --> !, queue_local_event([Event],[Where]).
  200satisfy_each(_,precept(Agent,Event)) --> !, send_precept(Agent,Event).
  201satisfy_each(postCond(_Action), ~(Cond)) --> !, undeclare_always(Cond).
  202satisfy_each(postCond(_Action),  Cond) --> !, declare(Cond).
  203satisfy_each(Context, ~(Cond)) --> !, (( \+ satisfy_each(Context, Cond)) ; [failed(Cond)] ).
  204satisfy_each(_, Cond) --> declared(Cond).
  205satisfy_each(_, Cond) --> [failed(Cond)].
  206
  207
  208oper_splitk(Agent,Action,Preconds,Postconds):-
  209  oper(Agent,Action,PrecondsK,PostcondsK),
  210  split_k(Agent,PrecondsK,Preconds),
  211  split_k(Agent,PostcondsK,Postconds).
  212
  213split_k(_Agent,[],[]) :- !.
  214
  215split_k(Agent,[b(P,[V|VS])|PrecondsK],Preconds):- !,
  216  split_k(Agent,[b(P,V),b(P,VS)|PrecondsK],Preconds).
  217
  218split_k(Agent,[~(k(P,X,Y))|PrecondsK],[believe(Agent,~(h(P,X,Y))),~(h(P,X,Y))|Preconds]):- !,
  219  split_k(Agent,PrecondsK,Preconds).
  220split_k(Agent,[k(P,X,Y)|PrecondsK],[believe(Agent,h(P,X,Y)),h(P,X,Y)|Preconds]):- !,
  221  split_k(Agent,PrecondsK,Preconds).
  222split_k(Agent,[~(b(P,X,Y))|PrecondsK],[believe(Agent,~(h(P,X,Y)))|Preconds]):- !, 
  223  split_k(Agent,PrecondsK,Preconds).
  224split_k(Agent,[b(P,X,Y)|PrecondsK],[believe(Agent,h(P,X,Y))|Preconds]):- !, 
  225  split_k(Agent,PrecondsK,Preconds).
  226split_k(Agent,[isa(X,Y)|PrecondsK],[getprop(X,inherited(Y))|Preconds]):- 
  227  split_k(Agent,PrecondsK,Preconds).
  228split_k(Agent,[in(X,Y)|PrecondsK],[h(in,X,Y)|Preconds]):- 
  229  split_k(Agent,PrecondsK,Preconds).
  230split_k(Agent,[Cond|PrecondsK],[Cond|Preconds]):- 
  231  split_k(Agent,PrecondsK,Preconds).
  232
  233
  234apply_act( Action) --> 
  235 action_doer(Action, Agent), 
  236 do_introspect(Agent,Action, Answer),
  237 send_precept(Agent, [answer(Answer), Answer]), !.
  238
  239apply_act(print_(Agent, Msg)) -->
  240  h(descended, Agent, Here),
  241  queue_local_event(msg_from(Agent, Msg), [Here]).
  242
  243apply_act(wait(Agent)) -->
  244 from_loc(Agent, Here),
  245 queue_local_event(time_passes(Agent),Here).
  246
  247apply_act(Action) --> 
  248 {implications(_DoesEvent,(Action), Preconds, Postconds), action_doer(Action,Agent) },
  249 must_det(satisfy_each(preCond(_),Preconds)),
  250 (((sg(member(failed(Why))),send_precept(Agent, failed(Action,Why))))
  251    ; (satisfy_each(postCond(_),Postconds),send_precept(Agent, (Action)))),!.
  252
  253apply_act( Action) --> 
  254 {oper_splitk(Agent,Action,Preconds,Postconds)}, !, 
  255 must_det(satisfy_each(preCond(_),Preconds)),
  256 (((sg(member(failed(Why))),send_precept(Agent, failed(Action,Why))))
  257    ; (satisfy_each(postCond(_),Postconds),send_precept(Agent, success(Action)))),!.
  258
  259apply_act( Action) --> aXiom(Action), !.
  260
  261/*
  262apply_act( Action) --> fail, 
  263  action_doer(Action, Agent),
  264  copy_term(Action,ActionG),
  265  from_loc(Agent, Here, S0),  
  266  % queue_local_event(spatial, [attempting(Agent, Action)], [Here], S0, S1),
  267  act( Action), !,
  268  queue_local_event([emoted(Agent, aXiom, '*'(Here), ActionG)], [Here], S0, S9).
  269*/
  270
  271apply_act( Act, S0, S9) :- ((cmd_workarround(Act, NewAct) -> Act\==NewAct)), !, apply_act( NewAct, S0, S9).
  272apply_act( Action, S0, S0):- notrace((bugout3(failed_act( Action), general))),!, \+ tracing.
  273
  274must_act( Action , S0, S9) :- dmust_tracing(apply_act( Action, S0, S9)) *-> ! ; fail.
  275% must_act( Action) --> rtrace(apply_act( Action, S0, S1)), !.
  276must_act( Action) --> 
  277 action_doer(Action,Agent), 
  278 send_precept(Agent, [failure(Action, unknown_to(Agent,Action))]).
  279
  280
  281act_required_posses('lock','key',$agent).
  282act_required_posses('unlock','key',$agent).
  283
  284act_change_opposite('lock','unlock').
  285act_change_opposite('open','close').
  286
  287act_change_state('lock','locked',t).
  288act_change_state('open','opened',t).
  289act_change_state(Unlock,Locked,f):- act_change_state(Lock,Locked,t),act_change_opposite(Lock,Unlock).
  290act_change_state(switch(on),'powered',t).
  291act_change_state(switch(off),'powered',f).
  292
  293act_change_state(switch(Open),Opened,TF):- nonvar(Open), act_change_state(Open,Opened,TF).
  294
  295% act_prevented_by(Open,Opened,TF):- act_change_state(Open,Opened,TF).
  296act_prevented_by('open','locked',t).
  297act_prevented_by('close','locked',t).
  298
  299
  300:- meta_predicate maybe_when(0,0).  301maybe_when(If,Then):- If -> Then ; true.
  302
  303:- meta_predicate unless_reason(*,'//',*,?,?).  304unless_reason(_Agent, Then,_Msg) --> Then,!.
  305unless_reason(Agent,_Then,Msg) --> {player_format(Agent,'~N~p~n',[Msg])},!,{fail}.
  306
  307:- meta_predicate unless(*,'//','//',?,?). 
  308unless(_Agent, Required, Then) --> Required,!, Then.
  309unless(Agent, Required, _Then) --> {simplify_reason(Required,CUZ), player_format(Agent,'~N~p~n',cant( cuz(\+ CUZ)))},!.
  310
  311:- meta_predicate required_reason(*,0).  312required_reason(_Agent, Required):- Required,!.
  313required_reason(Agent, Required):- simplify_reason(Required,CUZ), player_format(Agent,'~N~p~n',cant( cuz(CUZ))),!,fail.
  314
  315simplify_reason(_:Required, CUZ):- !, simplify_dbug(Required, CUZ).
  316simplify_reason(Required, CUZ):- simplify_dbug(Required, CUZ).
  317
  318reverse_dir(north,south,_).
  319reverse_dir(reverse(ExitName), ExitName,_) :- nonvar(ExitName),!.
  320reverse_dir(Dir,RDir,S0):-
  321 h(exit(Dir), Here, There, S0),
  322 h(exit(RDir), There, Here, S0),!.
  323reverse_dir(Dir,RDir,S0):- 
  324 h(Dir, Here, There, S0),
  325 h(RDir, There, Here, S0),!.
  326reverse_dir(Dir,reverse(Dir),_).
  327
  328add_agent_todo(Agent, Action, S0, S9) :- 
  329  undeclare(memories(Agent, Mem0), S0, S1),
  330  add_todo(Action, Mem0, Mem1),
  331  declare(memories(Agent, Mem1), S1, S9).
  332
  333add_agent_goal(Agent, Action, S0, S9) :- 
  334  undeclare(memories(Agent, Mem0), S0, S1),
  335  add_goal(Action, Mem0, Mem1),
  336  declare(memories(Agent, Mem1), S1, S9).
  337
  338add_look(Agent) -->
  339  h(inside, Agent, _Somewhere),
  340  add_agent_todo(Agent, look(Agent)).
  341
  342
  343:- defn_state_none(action_doer(action,-agent)).  344action_doer(Action,Agent):- \+ compound(Action),!, must_det(current_agent(Agent)),!.
  345action_doer(Action,Agent):- functor(Action,Verb,_),verbatum_anon(Verb),current_agent(Agent),!.
  346action_doer(Action,Agent):- arg(1,Action,Agent), nonvar(Agent), \+ preposition(_,Agent),!.
  347action_doer(Action,Agent):- trace,throw(missing(action_doer(Action,Agent))).
  348
  349action_verb_agent_thing(Action, Verb, Agent, Thing):-
  350  notrace((compound(Action),Action=..[Verb,Agent|Args], \+ verbatum_anon(Verb))), !,
  351  (Args=[Thing]->true;Thing=_),!