3:- discontiguous aXiom//1.    4:- discontiguous eVent//2.    5 
    6will_touch(Agent,Thing, S0, S2):- 
    7  h(touchable, Agent,Thing, S0),S0=S2.
    8
    9eVent(Agent,Event) -->
   10 send_precept(Agent, Event),
   11 aXiom(Event).
   12
   13
   14aXiom(Action, _S0, _S9):- notrace(( \+ trival_act(Action),bugout1(aXiom(Action)))),notrace(fail).
   15
   16aXiom(talk(Agent, Object, Message)) -->  % directed message
   17  can_sense(Agent, audio, Object),
   18  from_loc(Agent, Here),
   19  queue_local_event([talk(Agent, Here, Object, Message)], [Here]).
   20
   21aXiom(say(Agent, Message)) -->          % undirected message
   22  from_loc(Agent, Here),                              
   23  queue_local_event([talk(Agent, Here, *, Message)], [Here]).
   24
   25/*
   26aXiom(emote(Agent, EmoteType, Object, Message)) --> !, % directed message
   27 must_det((
   28 action_sensory(EmoteType, Sense),
   29 can_sense(Agent, Sense, Object),
   30 % get_open_traverse(EmoteType, Sense), h(Sense, Agent, Here), 
   31 queue_local_event([emoted(Agent, EmoteType, Object, Message)], [Here,Object]))).
   32
   33*/
   34
   35
   36
   37% ==============
   38%  WALK WEST
   39% ==============
   40aXiom(status_msg(_Begin,_End)) --> [].
   41
   42
   43% ==============
   44%  WALK TABLE
   45% ==============
   46aXiom(goto_obj(Agent, Walk, Object)) --> 
   47  has_rel(At, Object), 
   48  eVent(Agent,goto_prep_obj(Agent, Walk, At, Object)).
   49
   50
   51% ==============
   52%  WALK ON TABLE
   53% ==============
   54aXiom(goto_prep_obj(Agent, Walk, At, Object)) --> 
   55  will_touch(Agent, Object),
   56  has_rel(At, Object),  
   57  \+ is_closed(At, Object), 
   58  eVent(Agent,arriving(Agent, Walk, Object, At)).
   59
   60aXiom(arriving(Agent, Walk, Object, At)) -->
   61  from_loc(Object, Here),
   62  moveto(Agent, Walk, Agent, At, Object, [Here],
   63    [subj(Agent), person(Walk, es(Walk)), At, the, Object, .]),
   64  add_look(Agent).
   65
   66% ==============
   67%  GOTO PANTRY
   68% ==============
   69aXiom(goto_loc(Agent, _Walk, There)) -->           % go some room
   70  has_rel(exit(_), There),
   71  eVent(Agent,make_true(Agent, h(in, Agent, There))).
   72
   73aXiom(make_true(Agent, FACT)) --> 
   74  add_agent_goal(Agent, FACT).    
   75
   76aXiom(make_true(Doer, h(in, Agent, There))) -->  
   77  {Doer==Agent},
   78  has_rel(exit(_), There),
   79  from_loc(Agent, Here),
   80  agent_thought_model(Agent, ModelData),
   81  {find_path(Here, There, Route, ModelData)}, !,
   82  eVent(Agent,follow_plan(Agent, goto_loc(Agent, walk, There), Route)).
   83
   84aXiom(follow_plan(Agent, Name, [Step|Route])) -->
   85  eVent(Agent,follow_step(Agent, Name, Step)),
   86  eVent(Agent,follow_plan(Agent, Name, Route)).
   87
   88aXiom(follow_step(Agent, Name, Step)) -->
   89  {bugout1(follow_step(Agent, Name, Step))},
   90  must_act(Step).
   91
   92
   93%  sim(verb(args...), preconds, effects)
   94%    Agent is substituted for Agent.
   95%    preconds are in the implied context of a State.
   96%  In Inform, the following are implied context:
   97%    actor, action, noun, second
   98%  Need:
   99%    actor/agent, verb/action, direct-object/obj1, indirect-object/obj2,
  100%      preposition-introducing-obj2
  101%sim(put(Obj1, Obj2),
  102%    (  h(descended, Thing, Agent),
  103%      can_sense(Agent, Sense, Agent, Where),
  104%      has_rel(Relation, Where),
  105%      h(descended, Agent, Here)),
  106%    moveto(Agent, Put, Thing, Relation, Where, [Here],
  107%      [cap(subj(Agent)), person('put the', 'puts a'),
  108%        Thing, Relation, the, Where, '.'])).
  109aXiom(does_put(Agent, Put, Thing1, At, Thing2)) --> 
  110  from_loc(Agent, Here),
  111  % moveto(Agent, Put, Thing1, held_by, Recipient, [Here], [cap(subj(Agent)), person([give, Recipient, the], 'gives you a'), Thing, '.'],
  112  moveto(Agent, Put, Thing1, At, Thing2, [Here], 
  113    [cap(subj(Agent)), person(Put, es(Put)), Thing1, At, Thing2, '.']).
  114  
  115aXiom(take(Agent, Thing)) --> !,
  116  % [silent(subj(Agent)), person('Taken.', [cap(Doer), 'grabs the', Thing, '.'])]
  117  will_touch(Agent, Thing),
  118  eVent(Agent,does_put(Agent, take, Thing, held_by, Agent)).
  119
  120aXiom(drop(Agent, Thing)) --> !,
  121  will_touch(Agent, Thing), 
  122  h(At, Agent, Here),
  123  % has_rel(At, Here),
  124  eVent(Agent,does_put(Agent, drop, Thing, At, Here)).
  125
  126aXiom(put(Agent, Thing1, Prep, Thing2)) -->
  127  has_rel(At, Thing2),
  128  prep_to_rel(Thing2, Prep, At),
  129  (At \= in ; \+ is_closed(At, Thing2)),
  130  will_touch(Agent, Thing2), % what if "under" an "untouchable" thing?
  131  % OK, put it
  132  must_act( does_put(Agent, put, Thing1, At, Thing2)).
  133
  134aXiom(give(Agent, Thing, Recipient)) -->
  135  has_rel(held_by, Recipient),
  136  will_touch(Agent, Thing),
  137  will_touch(Recipient, Agent),
  138  % OK, give it                     
  139  must_act( does_put(Agent, give, Thing, held_by, Recipient)).
  140
  141% throw ball up
  142aXiom(throw_dir(Agent, Thing, ExitName)) --> 
  143  from_loc(Agent, Here),
  144  eVent(Agent,throw_prep_obj(Agent, Thing, ExitName, Here)).
  145
  146% throw ball at catcher
  147aXiom(throw_at(Agent, Thing, Target)) -->
  148  eVent(Agent,throw_prep_obj(Agent, Thing, at, Target)).
  149
  150% throw ball over homeplate
  151aXiom(throw_prep_obj(Agent, Thing, Prep, Target)) -->
  152  prep_to_rel(Target, Prep, Rel),
  153  eVent(Agent,throwing(Agent, Thing, Rel, Target)).
  154
  155% is throwing the ball...
  156aXiom(throwing(Agent, Thing, At, Target)) -->
  157  will_touch(Agent, Thing),
  158  can_sense(Agent, see, Target),
  159  eVent(Agent,thrown(Agent, Thing, At, Target)).
  160
  161% has thrown the ball...
  162aXiom(thrown(Agent, Thing, AtTarget, Target)) -->
  163  ignore((getprop(Thing, breaks_into(Broken)),
  164  bugout3('object ~p is breaks_into~n', [Thing], general),
  165  eVent(Agent,thing_transforms(Thing,Broken)))),
  166  eVent(Agent,disgorge(Agent, throw, Target, AtTarget, Target, [Target], 'Something falls out.')).
  167
  168aXiom(thing_transforms(Thing,Broken))  --> 
  169  undeclare(h(At, Thing, Here)),
  170  declare(h(At, Broken, Here)),
  171  queue_local_event([transformed(Thing, Broken)], Here).
  172  
  173
  174aXiom(hit_with(Agent, Thing, With)) -->
  175  from_loc(Agent, Here),
  176  hit(Agent, Thing, With, [Here]),
  177  send_precept(Agent, [true, 'OK.']).
  178
  179aXiom(hit(Agent, Thing)) -->
  180  from_loc(Agent, Here),
  181  hit(Agent, Thing, Agent, [Here]),
  182  send_precept(Agent, [true, 'OK.']).
  183
  184hit(Doer, Target, _With, Vicinity) -->
  185 ignore(( % Only brittle items use this
  186  getprop(Target, breaks_into(Broken)),
  187  bugout3('target ~p is breaks_into~n', [Target], general),
  188  undeclare(h(Prep, Target, Here)),
  189  queue_local_event([transformed(Target, Broken)], Vicinity),
  190  declare(h(Prep, Broken, Here)),
  191  disgorge(Doer, hit, Target, Prep, Here, Vicinity, 'Something falls out.'))).
  192
  193
  194aXiom(dig(Agent, Hole, Where, Tool)) -->
  195  {memberchk(Hole, [hole, trench, pit, ditch]),
  196  memberchk(Where, [garden]),
  197  memberchk(Tool, [shovel, spade])},
  198  open_traverse(Tool, Agent),
  199  h(in, Agent, Where),
  200  \+  h(_At, Hole, Where),
  201  % OK, dig the hole.
  202  declare(h(in, Hole, Where)),
  203  setprop(Hole, default_rel(in)),
  204  setprop(Hole, can_be(move, f)),
  205  setprop(Hole, can_be(take, f)),
  206  declare(h(in, dirt, Where)),
  207  queue_event(
  208    [ created(Hole, Where),
  209      [cap(subj(Agent)), person(dig, digs), 'a', Hole, 'in the', Where, '.']]).
  210
  211aXiom(eat(Agent, Thing)) -->
  212  (getprop(Thing, can_be(eat,t)) -> 
  213  (undeclare(h(_, Thing, _)),send_precept(Agent, [destroyed(Thing), 'Mmmm, good!'])) ;
  214  send_precept(Agent, [failure(eat(Thing)), 'It''s inedible!'])).
  215
  216
  217aXiom(switch(Agent, OnOff, Thing)) -->
  218  will_touch(Agent, Thing),
  219  getprop(Thing, can_be(switched(OnOff), t)),
  220  getprop(Thing, effect(switch(OnOff), Term0)),
  221  {adv_subst(equivalent, ($(self)), Thing, Term0, Term)},
  222  call(Term),
  223  send_precept(Agent, [true, 'OK']).
  224
  225aXiom(inventory(Agent)) -->
  226  can_sense(Agent, see, Agent),
  227  must_act( does_inventory(Agent)).
  228
  229aXiom(does_inventory(Agent)) -->
  230  eVent(Agent,examine(Agent, Agent)).
  231  %findall(What, h(child, What, Agent), Inventory),
  232  %send_precept(Agent, [rel_to(held_by, Inventory)]).
  233
  234
  235
  236
  237% Agent looks
  238aXiom(look(Agent)) --> 
  239  % Agent is At Here
  240  h(At, Agent, Here),
  241  % Agent looks At Here
  242  eVent(Agent,sub__examine(Agent, see, At, Here, 3)).
  243
  244aXiom(examine(Agent, Sense)) --> {is_sense(Sense)}, !, 
  245   from_loc(Agent, Place),
  246   eVent(Agent,sub__examine(Agent, see, in, Place, 3)).
  247
  248aXiom(examine(Agent, Object)) --> eVent(Agent,sub__examine(Agent, see, at, Object, 3)). 
  249aXiom(examine(Agent, Sense, Object)) --> eVent(Agent,sub__examine(Agent, Sense, at, Object, 3)), !.
  250aXiom(examine(Agent, Sense, Prep, Object)) --> eVent(Agent,sub__examine(Agent, Sense, Prep, Object, 3)), !.
  251
  252% listen, smell ...
  253aXiom(Action) -->
  254 {notrace((Action=..[Verb,Agent|Args], 
  255 sensory_verb(Sense, Verb)))}, !,
  256 {NewAction=..[examine,Agent,Sense|Args]},
  257 eVent(Agent,NewAction).
  258
  259% Here does not allow Sense?
  260aXiom(sub__examine(Agent, Sense, Prep, Object, Depth)) -->
  261  \+ sg(can_sense_here(Agent, Sense)), !,
  262  must_act( failed(examine(Agent, Sense, Prep, Object, Depth), \+ can_sense_here(Agent, Sense))).
  263aXiom(sub__examine(Agent, Sense, Prep, Object, Depth)) -->
  264  \+ can_sense(Agent, Sense, Object), !,
  265  must_act( failed(examine(Agent, Sense, Prep, Object, Depth), \+ can_sense(Agent, Sense, Object))).
  266aXiom(sub__examine(Agent, Sense, Prep, Object, Depth)) --> must_det(act_examine(Agent, Sense, Prep, Object, Depth)),!.
  267
  268
  269% used mainly to debug if things are locally accessable
  270aXiom(touch(Agent, Thing)) --> !,
  271 unless_reason(Agent, will_touch(Agent, Thing),
  272   cant( reach(Agent, Thing))),
  273 send_precept(Agent, [success(touch(Agent, Thing),'Ok.')]).
  274
  275
  276aXiom(change_state(Agent, Open, Thing, Opened, TF)) --> !, 
  277  change_state(Agent, Open, Thing, Opened, TF).
  278
  279aXiom(Action, S0, S9) :-  
  280 notrace((action_verb_agent_thing(Action, Open, Agent, Thing),
  281 nonvar(Open), nonvar(Thing), nonvar(Agent))),
  282 act_change_state(Open, Opened, TF),!,
  283 eVent(Agent,change_state(Agent, Open, Thing, Opened, TF), S0, S9),!.
  284
  285
  286aXiom(true) --> [].
  287
  288
  289
  290/*
  291
  292aXiom(switch(Open, Thing)) -->
  293 act_prevented_by(Open, TF),
  294 will_touch(Agent, Thing),
  295 %getprop(Thing, can_be(open),
  296 %\+ getprop(Thing, =(open, t)),
  297 Open = open, traverses(Sense, Open)
  298 %delprop(Thing, =(Open, f)),
  299 %setprop(Thing, =(open, t)),
  300 setprop(Thing, =(Open, TF)),
  301 h(Sense, Agent, Here),
  302 queue_local_event([setprop(Thing, =(Open, TF)),[Open,is,TF]], [Here, Thing]).
  303
  304aXiom(switch(OnOff, Thing)) -->
  305 will_touch(Agent, Thing),
  306 getprop(Thing, can_be(switch, t)),
  307 getprop(Thing, effect(switch(OnOff), Term0)),
  308 adv_subst(equivalent, $self, Thing, Term0, Term),
  309 call(Term),
  310 send_precept(Agent, [true, 'OK']).
  311*/
  312% todo
  313
  314/*
  315disgorge(Doer, How, Container, At, Here, Vicinity, Msg) :-
  316  findall(Inner, h(child, Inner, Container), Contents),
  317  bugout3('~p contained ~p~n', [Container, Contents], general),
  318  moveto(Doer, How, Contents, At, Here, Vicinity, Msg).
  319disgorge(Doer, How, _Container, _At, _Here, _Vicinity, _Msg).
  320*/
  321disgorge(Doer, How, Container, Prep, Here, Vicinity, Msg) -->
  322  findall(Inner, h(child, Inner, Container), Contents),
  323   {bugout3('~p contained ~p~n', [Container, Contents], general)},
  324  moveto(Doer, How, Contents, Prep, Here, Vicinity, Msg).
  325
  326:- defn_state_setter(moveto(agent,verb,listof(inst),domrel,dest,list(dest),msg)).  327moveto(Doer, Verb, List, At, Dest, Vicinity, Msg) --> {is_list(List)},!,
  328 apply_mapl_rest_state(moveto(Doer, Verb), List, [At, Dest, Vicinity, Msg]).
  329moveto(Doer, Verb, Object, At, Dest, Vicinity, Msg) -->
  330  undeclare(h(_, Object, From)),
  331  declare(h(At, Object, Dest)),
  332  queue_local_event([moved(Doer, Verb, Object, From, At, Dest), Msg], Vicinity).
  333
  334
  335event_props(thrown(Agent,  Thing, _Target, Prep, Here, Vicinity),
  336 [getprop(Thing, breaks_into(NewBrokenType)),
  337 bugout3('object ~p is breaks_into~n', [Thing], general),
  338 undeclare(h(_, Thing, _)),
  339 declare(h(Prep, NewBrokenType, Here)),
  340 queue_local_event([transformed(Thing, NewBrokenType)], Vicinity),
  341 disgorge(Agent, throw, Thing, Prep, Here, Vicinity, 'Something falls out.')]).
  342
  343                                      
  344setloc_silent(Prep, Object, Dest) --> 
  345 undeclare(h(_, Object, _)),
  346 declare(h(Prep, Object, Dest)).
  347
  348
  349change_state(Agent, Open, Thing, Opened, TF,  S0, S):- 
  350 % must_det
  351 ((
  352 maybe_when(psubsetof(Open, touch),
  353   required_reason(Agent, will_touch(Agent, Thing, S0, _))),
  354
  355 %getprop(Thing, can_be(open, S0),
  356 %\+ getprop(Thing, =(open, t), S0),
  357
  358 required_reason(Agent, \+ getprop(Thing, can_be(Open, f), S0)),
  359
  360 ignore(dshow_fail(getprop(Thing, can_be(Open, t), S0))),
  361
  362 forall(act_prevented_by(Open,Locked,Prevented),
  363   required_reason(Agent, \+ getprop(Thing, =(Locked, Prevented), S0))),
  364
  365 %delprop(Thing, =(Open, f), S0, S1),
  366 %setprop(Thing, =(Open, t), S0, S1),
  367
  368  open_traverse(Agent, Here, S0),
  369
  370 apply_forall(
  371  (getprop(Thing, effect(Open, Term0), S0),
  372  adv_subst(equivalent,$self, Thing, Term0, Term1),
  373  adv_subst(equivalent,$agent, Agent, Term1, Term2),
  374  adv_subst(equivalent,$here, Here, Term2, Term)),
  375  call(Term),S0,S1),
  376
  377 setprop(Thing, =(Opened, TF), S1, S2))),
  378
  379 queue_local_event([setprop(Thing, =(Opened, TF)),msg([Thing,is,TF,Opened])], [Here, Thing], S2, S),!