1% Marty's Prolog Adventure Prototype
    2% Copyright (C) 2004 Marty White under the GNU GPL
    3% Main file.
    4
    5admin :- true.  % Potential security hazzard.
    6wizard :- true. % Potential to really muck up game.
    7
    8:- include('readlist.pro').    9:- include('scanner.pro').   10:- include('adv_util.pro').   11
   12:- dynamic(bugs/1). % Types of logging output.
   13%bugs([general, printer, planner, autonomous]).
   14bugs([general, autonomous]).
   15
   16bug(B) :-
   17  bugs(L),
   18  member(B,L).
   19
   20bugout(A,B) :-
   21  bug(B),
   22  !,
   23  format(A).
   24bugout(_,_).
   25
   26bugout(A,L,B) :-
   27  bug(B),
   28  !,
   29  format(A,L).
   30bugout(_,_,_).
   31
   32pprint(Term,B) :-
   33  bug(B),
   34  !,
   35  prolog_pretty_print:print_term(Term,[]),
   36  nl.
   37pprint(_,_).
   38
   39% Entire state of simulation & agents is held in one list, so it can be easy
   40% to roll back.  The state of the simulation consists of:
   41%   object properties
   42%   object relations
   43%   percept queues for agents
   44%   memories for agents (actually logically distinct from the simulation)
   45% Note that the simulation does not maintain any history.
   46% TODO: change state into a term:
   47%   ss(Objects, Relationships, PerceptQueues, AgentMinds)
   48% TODO:
   49%   store initial state as clauses which are collected up and put into a list,
   50%     like the operators are, to provide proper prolog variable management.
   51
   52:- op(900, xfx, props).   53
   54istate([
   55  % Relationships
   56
   57  related(exit(south),pantry,kitchen),  % pantry exits south to kitchen
   58  related(exit(north),kitchen,pantry),
   59  related(exit(down),pantry,basement),
   60  related(exit(up),basement,pantry),
   61  related(exit(south), kitchen, garden),
   62  related(exit(north), garden, kitchen),
   63  related(exit(east), kitchen, dining_room),
   64  related(exit(west), dining_room, kitchen),
   65  related(exit(north), dining_room, living_room),
   66  related(exit(east), living_room, dining_room),
   67  related(exit(south), living_room, kitchen),
   68  related(exit(west), kitchen, living_room),
   69
   70  related(in, shelf, pantry),   % shelf is in pantry
   71  related(on, lamp, table),
   72  related(in, floyd, pantry),
   73  related(held_by, wrench, floyd),
   74  related(in, rock, garden),
   75  related(in, mushroom, garden),
   76  related(in, player, kitchen),
   77  related(worn_by, watch, player),
   78  related(held_by, bag, player),
   79  related(in, coins, bag),
   80  related(in, table, kitchen),
   81  related(on, box, table),
   82  related(in, bowl, box),
   83  related(in, flour, bowl),
   84  related(in, shovel, basement),
   85  related(in, videocamera, living_room),
   86  related(in, screendoor, kitchen),
   87  related(in, screendoor, garden),
   88
   89  % People
   90
   91  character props [relatable(held_by), relatable(worn_by)],
   92
   93  props(floyd, [
   94    inherit(character),
   95    agent_type(autonomous),
   96    emits_light,
   97    volume(50), mass(200), % density(4) % kilograms per liter
   98    name('Floyd the robot'),
   99    nouns(robot),
  100    adjs(metallic),
  101    desc('Your classic robot: metallic with glowing red eyes, enthusiastic but not very clever.'),
  102    switchable,
  103    on,
  104    % TODO: floyd should `look` when turned back on.
  105    effect(switch(on),  setprop($self, on)),
  106    effect(switch(off), delprop($self, on)),
  107    end_of_list
  108  ]),
  109  props(player, [
  110    inherit(character),
  111    agent_type(console),
  112    volume(50), % liters     (water is 1 kilogram per liter)
  113    mass(50),   % kilograms
  114    can_eat
  115  ]),
  116
  117  % Places
  118
  119  place props [immovable, relatable(in)],
  120
  121  props(basement, [
  122    inherit(place),
  123    desc('This is a very dark basement.'),
  124    dark
  125  ]),
  126  props(dining_room, [inherit(place)]),
  127  props(garden,      [
  128    inherit(place),
  129    % go(dir,result) provides special handling for going in a direction.
  130    go(up,'You lack the ability to fly.'),
  131    effect(go(_,north), getprop(screendoor,open)),
  132    oper(/*garden,*/ go(_,north),
  133         % precond(Test, FailureMessage)
  134         precond(getprop(screendoor, open), ['you must open the door first']),
  135         % body(clause)
  136         body(inherited)
  137    ),
  138    % cant_go provides last-ditch special handling for Go.
  139    cant_go('The fence surrounding the garden is too tall and solid to pass.')
  140  ]),
  141  props(kitchen,     [inherit(place)]),
  142  props(living_room, [inherit(place)]),
  143  props(pantry, [
  144    inherit(place),
  145    nouns(closet),
  146    nominals(kitchen),
  147    desc('You\'re in a dark pantry.'),
  148    dark
  149  ]),
  150
  151  % Things
  152
  153  props(bag, [
  154    relatable(in),
  155    volume_capacity(10),
  156    dark
  157  ]),
  158  props(bowl, [
  159    relatable(in),
  160    volume_capacity(2),
  161    fragile(shards),
  162    name('porcelain bowl'),
  163    desc('This is a modest glass cooking bowl with a yellow flower motif glazed into the outside surface.')
  164  ]),
  165  props(box, [
  166    relatable(in),
  167    volume_capacity(15),
  168    fragile(splinters),
  169    %openable,
  170    closed(true),
  171    %lockable,
  172    locked(fail),
  173    dark
  174  ]),
  175  coins props [shiny],
  176  flour props [edible],
  177  props(lamp, [
  178    name('shiny brass lamp'),
  179    nouns(light),
  180    nominals(brass),
  181    adjs(shiny),
  182    shiny,
  183    switchable,
  184    on,
  185    emits_light,
  186    effect(switch(on), setprop($self, emits_light)),
  187    effect(switch(off), delprop($self, emits_light)),
  188    fragile(broken_lamp)
  189  ]),
  190  broken_lamp props [
  191    name('dented brass lamp'),
  192    % TODO: prevent user from referring to 'broken_lamp'
  193    nouns(light),
  194    nominals(brass),
  195    adjs(dented),
  196    switchable
  197    %effect(switch(on), true),
  198    %effect(switch(off), true) % calls true(S0,S1) !
  199  ],
  200  mushroom props [
  201    % See DM4
  202    name('speckled mushroom'),
  203    singular,
  204    nouns([mushroom,fungus,toadstool]),
  205    adjs([speckled]),
  206    % initial(description used until initial state changes)
  207    initial('A speckled mushroom grows out of the sodden earth, on a long stalk.'),
  208    % description(examination description)
  209    desc('The mushroom is capped with blotches, and you aren\'t at all sure it\'s not a toadstool.'),
  210    edible,
  211    % before(VERB,CODE) -- Call CODE before default code for VERB.
  212    %                      If CODE succeeds, don't call VERB.
  213    before(eat, (random(100) =< 30, die('It was poisoned!'); 'yuck!')),
  214    after(take,
  215          (initial, 'You pick the mushroom, neatly cleaving its thin stalk.'))
  216  ],
  217  screendoor props [
  218    immovable,
  219    % see DM4
  220    door_to(garden),
  221    %openable
  222    closed(true)
  223  ],
  224  props(shelf , [relatable(on),immovable]),
  225  props(table , [relatable(on),relatable(under)]),
  226  wrench props [shiny],
  227  videocamera props [
  228    agent_type(recorder),
  229    switchable,
  230    effect(switch(on),  setprop($self, on)),
  231    effect(switch(off), delprop($self, on)),
  232    fragile(broken_videocam)
  233  ],
  234  broken_videocam props [switchable],
  235
  236  end_of_list
  237]).
  238
  239% Some Inform properties:
  240%   light - rooms that have light in them
  241%   edible - can be eaten
  242%   static - can't be taken or moved
  243%   scenery - assumed to be in the room description (implies static)
  244%   concealed - obscured, not listed, not part of 'all', but there
  245%   found_in - lists places where scenery objects are seen
  246%   absent - hides object entirely
  247%   clothing - can be worn
  248%   worn - is being worn
  249%   container
  250%   open - container is open (must be open to be used. there is no "closed").
  251%   openable - can be opened and closed
  252%   capacity - number of objects a container or supporter can hold
  253%   locked - cannot be opened
  254%   lockable, with_key
  255%   enterable
  256%   supporter
  257%   article - specifies indefinite article ('a', 'le') 
  258%   cant_go
  259%   daemon - called each turn, if it is enabled for this object
  260%   description
  261%   inside_description
  262%   invent - code for inventory listing of that object
  263%   list_together - way to handle "5 fish"
  264%   plural - pluralized-name if different from singular
  265%   when_closed - description when closed
  266%   when_open - description when open
  267%   when_on, when_off - like when_closed, etc.
  268% Some TADS properties:
  269%   thedesc
  270%   pluraldesc
  271%   is_indistinguishable
  272%   is_visible(vantage)
  273%   is_reachable(actor)
  274%   valid(verb) - is object visible, reachable, etc.
  275%   verification(verb) - is verb logical for this object
  276% Parser disambiguation:
  277%   eliminate objs not visible, reachable, etc.
  278%   check preconditions for acting on a candidate object
  279
  280% TODO: change agent storage into a term:
  281%   mind(AgentName, AgentType, History, Model, Goals /*, ToDo*/)
  282create_agent(Agent, AgentType, S0, S2) :-
  283  % As events happen, percepts are entered in the percept queue of each agent.
  284  % Each agent empties their percept queue as they see fit.
  285  declare(perceptq(Agent, []), S0, S1),
  286  % Most agents store memories of percepts, world model, goals, etc.
  287  declare(memories(Agent, [
  288    timestamp(0),
  289    model([]),
  290    goals([]),
  291    todo([]),
  292    agent(Agent),
  293    agent_type(AgentType)
  294  ]), S1, S2).
  295
  296% -----------------------------------------------------------------------------
  297% State may be implemented differently in the future (as a binary tree or
  298% hash table, etc.), but for now is a List.  These (backtrackable) predicates
  299% hide the implementation:
  300% assert/record/declare/memorize/think/associate/know/retain/affirm/avow/
  301%   insist/maintain/swear/posit/postulate/allege/assure/claim/proclaim
  302% retract/erase/forget/un-declare/unthink/repress/supress
  303% retrieve/remember/recall/ask/thought/think-of/reminisc/recognize/review/
  304%   recollect/remind/look-up/research/establish/testify/sustain/attest/certify/
  305%   verify/prove
  306% simulation: declare/undeclare/declared
  307% perception:
  308% memory: memorize/forget/thought
  309
  310% Like select, but always succeeds, for use in deleting.
  311select_always(Item, List, ListWithoutItem) :-
  312  select(Item, List, ListWithoutItem),
  313  !.
  314select_always(_Item, ListWithoutItem, ListWithoutItem).
  315
  316% Like select, but with a default value if not found in List..
  317%select_default(Item, _DefaultItem, List, ListWithoutItem) :-
  318%  select(Item, List, ListWithoutItem).
  319%select_default(DefaultItem, DefaultItem, ListWithoutItem, ListWithoutItem).
  320
  321% Manipulate simulation state
  322declare(Fact, State, NewState) :- append([Fact], State, NewState).
  323undeclare(Fact, State, NewState)   :- select(Fact, State, NewState).
  324undeclare_always(Fact, State, NewState) :- select_always(Fact, State, NewState).
  325declared(Fact, State) :- member(Fact, State).
  326
  327% Retrieve Prop.
  328getprop(Object, Prop, State) :-
  329  declared(props(Object, PropList), State),
  330  member(Prop, PropList).
  331getprop(Object, Prop, State) :-
  332  declared(props(Object, PropList), State),
  333  member(inherit(Delegate), PropList),
  334  getprop(Delegate, Prop, State).
  335
  336% Replace or create Prop.
  337setprop(Object, Prop, S0, S2) :-
  338  undeclare(props(Object, PropList), S0, S1),
  339  select_always(Prop, PropList, PropList2),
  340  append([Prop],PropList2,PropList3),
  341  declare(props(Object,PropList3), S1, S2).
  342setprop(Object, Prop, S0, S2) :-
  343  declare(props(Object,[Prop]), S0, S2).
  344
  345% Remove Prop.
  346delprop(Object, Prop, S0, S2) :-
  347  undeclare(props(Object, PropList), S0, S1),
  348  select(Prop, PropList, NewPropList),
  349  declare(props(Object, NewPropList), S1, S2).
  350
  351% Manipulate simulation percepts
  352queue_percept(Agent, Event, S0, S2) :-
  353  select(perceptq(Agent,Queue), S0, S1),
  354  append(Queue, [Event], NewQueue),
  355  append([perceptq(Agent, NewQueue)], S1, S2).
  356
  357queue_event(Event, S0, S2) :-
  358  queue_percept(player, Event, S0, S1),
  359  queue_percept(floyd,  Event, S1, S2).
  360
  361queue_local_percept(Agent, Event, Places, S0, S1) :-
  362  member(Where, Places),
  363  related(open_traverse, Agent, Where, S0),
  364  queue_percept(Agent, Event, S0, S1).
  365queue_local_percept(_Agent, _Event, _Places, S0, S0).
  366
  367queue_local_event(Event, Places, S0, S2) :-
  368  queue_local_percept(player, Event, Places, S0, S1),
  369  queue_local_percept(floyd , Event, Places, S1, S2).
  370
  371% A percept or event:
  372%   - is a logical description of what happened
  373%   - includes English or other translations
  374%   - may be queued for zero, one, many, or all agents.
  375%   - may have a timestamp
  376% queue_percpt(Agent, [Logical,English|_], S0, S9).
  377%   where Logical is always first, and other versions are optional.
  378%   Logical should be a term, like sees(Thing).
  379%   English should be a list.
  380
  381% Inform notation
  382%   'c'        character)
  383%   "string"   string
  384%   "~"        quotation mark
  385%   "^"        newline
  386%   @          accent composition, variables 00 thru 31
  387%   \          line continuation
  388% Engish messages need to be printable from various perspectives:
  389%   person (1st/2nd/3rd), tense(past/present)
  390%   "You go south." / "Floyd wanders south."
  391%       {'$agent $go $1', ExitName }
  392%       { person(Agent), tense(go,Time), ExitName, period }
  393%       {'$p $t $w',Agent,go,ExitName}
  394%   "You take the lamp." / "Floyd greedily grabs the lamp."
  395%       Agent=floyd, {'%p quickly grab/T %n', Agent, grab, Thing }
  396%               else {'%p take/T %n', Agent, take, Thing }
  397%   %p  Substitute parameter as 1st/2nd/3rd person ("I"/"you"/"Floyd").
  398%         Implicit in who is viewing the message.
  399%         Pronouns: gender, reflexive, relative, nominative, demonstratve...?
  400%   %n  Substitute name/description of parameter ("the brass lamp").
  401%   /T  Modify previous word according to tense ("take"/"took").
  402%         Implicit in who is viewing the message?  Context when printed?
  403%   /N  Modify previous word according to number ("coin"/"coins").
  404%         What number?
  405%   %a  Article - A or An (indefinite) or The (definite) ?
  406%
  407%  I go/grab/eat/take
  408%  you go/grab/eat/take
  409%  she goes/grabs/eats/takes
  410%  floyd goes/grabs/eats/takes
  411%
  412%  eng(subject(Agent),'quickly',verb(grab,grabs),the(Thing))
  413%  [s(Agent),'quickly',v(grab,grabs),the(Thing)]
  414
  415capitalize([First|Rest], [Capped|Rest]) :-
  416  capitalize(First, Capped).
  417capitalize(Atom, Capitalized) :-
  418  atom(Atom), % [] is an atom
  419  downcase_atom(Atom, Lower),
  420  atom_chars(Lower, [First|Rest]),
  421  upcase_atom(First, Upper),
  422  atom_chars(Capitalized, [Upper|Rest]).
  423
  424% compile_eng(Context, Atom/Term/List, TextAtom).
  425%  Compile Eng terms to ensure subject/verb agreement:
  426%  If subject is agent, convert to 2nd person, else use 3rd person.
  427%  Context specifies agent, and (if found) subject of sentence.
  428compile_eng(Context, subj(Agent), Person) :-
  429  member(agent(Agent), Context),
  430  member(person(Person), Context).
  431compile_eng(Context, subj(Other), Compiled) :-
  432  compile_eng(Context, Other, Compiled).
  433compile_eng(Context, Agent, Person) :-
  434  member(agent(Agent), Context),
  435  member(person(Person), Context).
  436compile_eng(Context, person(Second,_Third), Compiled) :-
  437  member(subj(Agent), Context),
  438  member(agent(Agent), Context),
  439  compile_eng(Context, Second, Compiled).
  440compile_eng(Context, person(_Second,Third), Compiled) :-
  441  compile_eng(Context, Third, Compiled).
  442compile_eng(Context, cap(Eng), Compiled) :-
  443  compile_eng(Context, Eng, Lowercase),
  444  capitalize(Lowercase, Compiled).
  445compile_eng(_Context, silent(_Eng), '').
  446compile_eng(_Context, [], '').
  447compile_eng(Context, [First|Rest], [First2|Rest2]) :-
  448  compile_eng(Context, First, First2),
  449  compile_eng(Context, Rest, Rest2).
  450compile_eng(_Context, Atom, Atom).
  451
  452nospace(_, ',').
  453nospace(_, ';').
  454nospace(_, ':').
  455nospace(_, '.').
  456nospace(_, '?').
  457nospace(_, '!').
  458nospace(_, '\'').
  459nospace('\'', _).
  460nospace(_, '"').
  461nospace('"', _).
  462nospace(_, Letter) :- char_type(Letter, space).
  463nospace(Letter, _) :- char_type(Letter, space).
  464
  465no_space_words('',_).
  466no_space_words(_,'').
  467no_space_words(W1, W2) :-
  468  atomic(W1),
  469  atomic(W2),
  470  atom_chars(W1,List),
  471  last(List, C1),
  472  atom_chars(W2,[C2|_]),
  473  nospace(C1,C2).
  474
  475insert_spaces([W], [W]).
  476insert_spaces([W1,W2|Tail1], [W1,W2|Tail2]) :-
  477  no_space_words(W1,W2),
  478  !,
  479  insert_spaces([W2|Tail1], [W2|Tail2]).
  480insert_spaces([W1,W2|Tail1], [W1,' ',W3|Tail2]) :-
  481  insert_spaces([W2|Tail1], [W3|Tail2]).
  482insert_spaces([], []).
  483
  484make_atomic(Atom, Atom) :-
  485  atomic(Atom), !.
  486make_atomic(Term, Atom) :-
  487  term_to_atom(Term, Atom).
  488
  489eng2txt(Agent, Person, Eng, Text) :-
  490  % Find subject, if any.
  491  findall(subj(Subject), findterm(subj(Subject),Eng), Context),
  492  % Compile recognized structures.
  493  maplist(compile_eng([agent(Agent),person(Person)|Context]), Eng, Compiled),
  494  % Flatten any sub-lists.
  495  flatten(Compiled, FlatList),
  496  % Convert terms to atom-strings.
  497  findall(Atom, (member(Term,FlatList), make_atomic(Term, Atom)), AtomList),
  498  findall(Atom2, (member(Atom2,AtomList), Atom2\=''), AtomList2),
  499  % Add spaces.
  500  bugout('insert_spaces(~w)~n', [AtomList2], printer),
  501  insert_spaces(AtomList2, SpacedList),
  502  % Return concatenated atoms.
  503  concat_atom(SpacedList, Text).
  504eng2txt(_Agent, _Person, Text, Text).
  505
  506%portray(ItemToPrint) :- print_item_list(ItemToPrint).  % called by print.
  507
  508list2eng([], ['<nothing>']).
  509list2eng([Single], [Single]).
  510list2eng([Last2, Last1], [Last2, 'and', Last1]).
  511list2eng([Item|Items], [Item,','|Tail]) :-
  512  list2eng(Items,Tail).
  513
  514prop2eng( Obj, emits_light,  ['The',Obj,'is glowing.']).
  515prop2eng(_Obj, edible,       ['It looks tasty!']).
  516prop2eng(_Obj, fragile(_),   ['It looks fragile.']).
  517prop2eng(_Obj, closed(true), ['It is closed.']).
  518prop2eng(_Obj, closed(fail), ['It is open.']).
  519prop2eng(_Obj, open(fail),   ['It is closed.']).
  520prop2eng(_Obj, open(true),   ['It is open.']).
  521prop2eng(_Obj, open,         ['It is open.']).
  522prop2eng(_Obj, closed,       ['It is closed.']).
  523prop2eng(_Obj, locked,       ['It is locked.']).
  524prop2eng(_Obj, shiny,        ['It\'s shiny!']).
  525prop2eng(_Obj, _Prop,        []).
  526
  527proplist2eng(_Obj, [], []).
  528proplist2eng(Obj, [Prop|Tail], Text) :-
  529  prop2eng(Obj, Prop, Text1),
  530  proplist2eng(Obj, Tail, Text2),
  531  append(Text1,Text2,Text).
  532
  533%print_percept(Agent, see(you_are(How, Here),
  534%                         exits_are(Exits),
  535%                         here_are(Nearby))) :-
  536%  findall(X, (member(X,Nearby),X\=Agent), OtherNearby),
  537%  format('You are ~p the ~p.  Exits are ~p.~nYou see: ~p.~n',
  538%         [How,Here, Exits, OtherNearby]).
  539
  540logical2eng(Agent,
  541            see(you_are(How, Here),
  542                exits_are(Exits),
  543                here_are(Nearby)),
  544            [cap(subj(Agent)),person(are,is),How,'the',Here,'.',
  545             'Exits are',ExitText,'.','\n',
  546             cap(subj(Agent)),person(see,sees),':',SeeText,'.']) :-
  547  list2eng(Exits,ExitText),
  548  findall(X, (member(X,Nearby),X\=Agent), OtherNearby),
  549  list2eng(OtherNearby, SeeText).
  550logical2eng(Agent, carrying(Items),
  551            [cap(subj(Agent)),person(are,is),'carrying:'|Text]) :-
  552  list2eng(Items,Text).
  553logical2eng(_Agent, see_children(_Parent,_How,[]), []).
  554logical2eng(Agent, see_children(Parent,How,List),
  555            [cap(How),'the',Parent,subj(Agent),person(see,sees),':'|Text]) :-
  556  list2eng(List,Text).
  557logical2eng(_Agent, moved(What,From,How,To),
  558            [cap(subj(What)), 'moves from', From, 'to', How, To]).
  559logical2eng(_Agent, transformed(Before,After), [Before,'turns into',After,.]).
  560logical2eng(_Agent, destroyed(Thing), [Thing, 'is destroyed.']).
  561logical2eng(Agent, see_props(Object,PropList),
  562            [cap(subj(Agent)),person(see,sees),Desc,'.'|PropDesc] ) :-
  563  member(name(Desc), PropList),
  564  proplist2eng(Object,PropList,PropDesc).
  565logical2eng(Agent, see_props(Object,PropList),
  566            [cap(subj(Agent)),person(see,sees),'a',Object,'.'|PropDesc] ) :-
  567  proplist2eng(Object,PropList,PropDesc).
  568logical2eng(_Agent, say(Speaker, Eng), [cap(subj(Speaker)),': "',Text,'"']) :-
  569  eng2txt(Speaker, 'I', Eng, Text).
  570logical2eng(_Agent, talk(Speaker, Audience, Eng),
  571    [cap(subj(Speaker)),'says to',Audience,', "',Text,'"']) :-
  572  eng2txt(Speaker, 'I', Eng, Text).
  573logical2eng(_Agent, time_passes, ['Time passes.']).
  574logical2eng(_Agent, failure(Action), ['Action failed:',Action]).
  575logical2eng(_Agent, Logical, ['percept:',Logical]).
  576
  577percept2txt(Agent, [_Logical,English|_], Text) :-
  578  eng2txt(Agent, you, English, Text).
  579percept2txt(Agent, [Logical|_], Text) :-
  580  logical2eng(Agent, Logical, Eng),
  581  eng2txt(Agent, you, Eng, Text).
  582
  583the(State, Object, Text) :-
  584  getprop(Object, name(D), State),
  585  atom_concat('the ',D,Text).
  586
  587an(State, Object, Text) :-
  588  getprop(Object, name(D), State),
  589  atom_concat('a ',D,Text).
  590
  591num(_Singular, Plural, [], Plural).
  592num(Singular, _Plural, [_One], Singular).
  593num(_Singular, Plural, [_One,_Two|_Or_More], Plural).
  594
  595expand_english(State, the(Object), Text) :-
  596  the(State, Object, Text).
  597expand_english(State, an(Object), Text) :-
  598  an(State, Object, Text).
  599expand_english(_State, num(Sing,Plur,List), Text) :-
  600  num(Sing,Plur,List,Text).
  601expand_english(_State, [], '').
  602expand_english(State, [Term|Tail], [NewTerm|NewTail]) :-
  603  expand_english(State, Term, NewTerm),
  604  expand_english(State, Tail, NewTail).
  605expand_english(_State, Term, Term).
  606
  607% -----------------------------------------------------------------------------
  608
  609subrelation(in, child).
  610subrelation(on, child).
  611subrelation(worn_by, child).
  612subrelation(held_by, child).
  613
  614relatable(How, X, State) :-
  615  getprop(X, relatable(How), State).
  616relatable(How, X, State) :-
  617  getprop(X, relatable(Specific), State),
  618  subrelation(Specific, How).
  619
  620related(How, X, Y, State) :- declared(related(How,X,Y), State).
  621related(child, X, Y, State) :- subrelation(How, child), related(How,X,Y,State).
  622related(descended, X, Z, State) :-
  623  related(child, X, Z, State).
  624related(descended, X, Z, State) :-
  625  related(child, Y, Z, State),
  626  related(descended, X, Y, State).
  627related(open_traverse, X, Z, State) :-
  628  related(child, X, Z, State).
  629related(open_traverse, X, Z, State) :-
  630  related(child, Y, Z, State),
  631  \+ is_closed(Y, State),
  632  related(open_traverse, X, Y, State).
  633related(inside, X, Z, State) :- related(in, X, Z, State).
  634related(inside, X, Z, State) :- related(in, Y, Z, State),
  635                                related(descended, X, Y, State).
  636related(exit(out),Inner,Outer,State) :-
  637  related(child, Inner, Outer, State),
  638  relatable(in, Inner, State),
  639  relatable(child, Outer, State),
  640  \+ is_closed(Inner, State).
  641related(exit(off),Inner,Outer,State) :-
  642  related(child, Inner, Outer, State),
  643  relatable(on, Inner, State),
  644  relatable(child, Outer, State).
  645related(exit(escape),Inner,Outer,State) :-
  646  related(child, Inner, Outer, State),
  647  relatable(child, Inner, State),
  648  relatable(child, Outer, State).
  649
  650is_prop_public(P) :-
  651  member(P, [relatable(_),emits_light,edible,name(_),desc(_),fragile(_),
  652             immovable, openable, open, closed(_), lockable, locked, locked(_),
  653             shiny]).
  654
  655related_with_prop(How, Object, Place, Prop, State) :-
  656  related(How, Object, Place, State),
  657  getprop(Object, Prop, State).
  658
  659is_closed(Object, State) :-
  660  getprop(Object, closed(true), State).
  661%  getprop(Object, openable, State),
  662%  \+ getprop(Object, open, State).
  663
  664can_see(Agent, State) :-
  665  related(open_traverse, Agent, Here, State),
  666  (getprop(Here, dark, State) ->
  667    related_with_prop(open_traverse, _Obj, Here, emits_light, State);
  668    true).
  669
  670in_scope(Thing, Agent, State) :-
  671  related(open_traverse, Agent, Here, State),
  672  (Thing=Here; related(open_traverse, Thing, Here, State)).
  673
  674visible(Thing, Agent, State) :-
  675  can_see(Agent, State),
  676  related(open_traverse, Agent, Here, State),
  677  (Thing=Here; related(open_traverse, Thing, Here, State)).
  678
  679touchable(Thing, Agent, State) :-
  680  related(child, Agent, Here, State), % can't reach out of boxes, etc.
  681  (Thing=Here; related(open_traverse, Thing, Here, State)).
  682
  683moveto(Object, How, Dest, Vicinity, Msg, State, S9) :-
  684  undeclare(related(_,Object,Here), State, VoidState),
  685  declare(related(How,Object,Dest), VoidState, S2),
  686  queue_local_event([moved(Object, Here, How, Dest), Msg], Vicinity, S2, S9).
  687
  688moveallto([],_R,_D,_V,_M,S,S).
  689moveallto([Object|Tail], Relation, Destination, Vicinity, Msg, S0, S2) :-
  690  moveto(Object, Relation, Destination, Vicinity, Msg, S0, S1),
  691  moveallto(Tail, Relation, Destination, Vicinity, Msg, S1, S2).
  692
  693disgorge(Container, How, Here, Vicinity, Msg, S0, S9) :-
  694  findall(Inner, related(child, Inner, Container, S0), Contents),
  695  bugout('~p contained ~p~n', [Container,Contents],general),
  696  moveallto(Contents, How, Here, Vicinity, Msg, S0, S9).
  697disgorge(_Container, _How, _Here, _Vicinity, _Msg, S0, S0).
  698
  699thrown(Thing, _Target, How, Here, Vicinity, S0, S9) :-
  700  getprop(Thing, fragile(Broken), S0),
  701  bugout('object ~p is fragile~n',[Thing],general),
  702  undeclare(related(_,Thing,_), S0, S1),
  703  declare(related(How,Broken,Here), S1, S2),
  704  queue_local_event([transformed(Thing, Broken)], Vicinity, S2, S3),
  705  disgorge(Thing, How, Here, Vicinity, 'Something falls out.', S3, S9).
  706thrown(Thing, _Target, How, Here, Vicinity, S0, S9) :-
  707  moveto(Thing, How, Here, Vicinity, 'Thrown.', S0, S9).
  708
  709hit(Target, _Thing, Vicinity, S0, S9) :-
  710  getprop(Target, fragile(Broken), S0),
  711  bugout('target ~p is fragile~n',[Target],general),
  712  undeclare(related(How,Target,Here), S0, S1),
  713  queue_local_event([transformed(Target, Broken)], Vicinity, S1, S2),
  714  declare(related(How,Broken,Here), S2, S3),
  715  disgorge(Target,How,Here,Vicinity,'Something falls out.', S3, S9).
  716hit(_Target, _Thing, _Vicinity, S0, S0).
  717
  718% drop -> move -> touch
  719subsetof(touch,  touch).
  720subsetof(move,   touch).
  721subsetof(drop,   move).
  722subsetof(eat,    touch).
  723subsetof(hit,    touch).
  724subsetof(put,    drop).
  725subsetof(give,   drop).
  726subsetof(take,   move).
  727subsetof(throw,  drop).
  728subsetof(open,   touch).
  729subsetof(close,  touch).
  730subsetof(lock,   touch).
  731subsetof(unlock, touch).
  732
  733subsetof(examine, examine).
  734
  735% proper subset - C may not be a subset of itself.
  736psubsetof(A, B) :- subsetof(A,B).
  737psubsetof(A, C) :-
  738  subsetof(A, B),
  739  subsetof(B, C).
  740
  741reason2eng(cant(see(_It)),        'You can''t see that here.').
  742reason2eng(cant(reach(_It)),      'You can''t reach it.').
  743reason2eng(cant(manipulate(self)),'You can''t manipulate yourself like that.').
  744reason2eng(alreadyhave(It),       ['You already have the',It,'.']).
  745reason2eng(mustgetout(_It),       'You must get out/off it first.').
  746reason2eng(self_relation(_It),    'Can\'t put thing inside itself!').
  747reason2eng(moibeus_relation(_,_), 'Topological error!').
  748reason2eng(toodark,               'It''s too dark to see!').
  749reason2eng(mustdrop(_It),         'You will have to drop it first.').
  750reason2eng(immovable(_It),        'Sorry, it\'s immovable.').
  751reason2eng(cantdothat,            'Sorry, you can\'t do that.').
  752reason2eng(R, R).
  753
  754cant(Agent, Action, cant(see(Thing)), State) :-
  755  Action =.. [Verb, Thing |_],
  756  psubsetof(Verb, _),
  757  \+ in_scope(Thing, Agent, State).
  758cant(Agent, Action, cant(see(Thing)), State) :-
  759  Action =.. [Verb, Thing |_],
  760  psubsetof(Verb, examine),
  761  \+ visible(Thing, Agent, State).
  762cant(Agent, Action, cant(reach(Thing)), State) :-
  763  Action =.. [Verb, Thing |_],
  764  psubsetof(Verb, touch),
  765  \+ touchable(Thing, Agent, State).
  766cant(_Agent, Action, immovable(Thing), State) :-
  767  Action =.. [Verb, Thing |_],
  768  psubsetof(Verb, move),
  769  getprop(Thing, immovable, State).
  770cant(Agent, Action, musthave(Thing), State) :-
  771  Action =.. [Verb, Thing |_],
  772  psubsetof(Verb, drop),
  773  \+ related(open_traverse, Thing, Agent, State).
  774cant(Agent, Action, cant(manipulate(self)), _) :-
  775  Action =.. [Verb, Agent |_],
  776  psubsetof(Verb, touch).
  777cant(Agent, take(Thing), alreadyhave(Thing), State) :-
  778  related(descended, Thing, Agent, State).
  779cant(Agent, take(Thing), mustgetout(Thing), State) :-
  780  related(descended, Agent, Thing, State).
  781cant(_Agent, put(Thing1,_How,Thing1), self_relation(Thing1), _S0).
  782cant(_Agent, put(Thing1,_How,Thing2), moibeus_relation(Thing1,Thing2), S0) :-
  783  related(descended,Thing2,Thing1,S0).
  784cant(_Agent, throw(Thing1,_How,Thing1), self_relation(Thing1), _S0).
  785cant(_Agent, throw(Thing1,_How,Thing2), moibeus_relation(Thing1,Thing2), S0) :-
  786  related(descended,Thing2,Thing1,S0).
  787cant(Agent, look, toodark, State) :-
  788  % Perhaps this should return a logical description along the lines of
  789  %   failure(look,requisite(look, getprop(SomethingNearby, emits_light)))
  790  \+ can_see(Agent, State).
  791cant(Agent, inventory, toodark, State) :-
  792  \+ can_see(Agent, State).
  793cant(Agent, examine(_), toodark, State) :-
  794  \+ can_see(Agent, State).
  795cant(Agent, examine(Thing), cant(see(Thing)), State) :-
  796  \+ visible(Thing, Agent, State).
  797cant(Agent, go(_Relation,Object), mustdrop(Object), State) :-
  798  related(descended, Object, Agent, State).
  799cant(Agent, eat(_), cantdothat, State) :-
  800  \+ getprop(Agent, can_eat, State).
  801
  802% ---- act(Agent, Action, State, NewState)
  803%  where the states also contain Percepts.
  804% In Inform, actions work in the following order:
  805%   game-wide preconditions
  806%   player preconditions
  807%   objects-in-vicinity react_before conditions
  808%   room before-conditions
  809%   direct-object before-conditions
  810%   verb
  811%   objects-in-vicinity react_after conditions
  812%   room after-conditions
  813%   direct-object after-conditions
  814%   game-wide after-conditions
  815% In TADS:
  816%   "verification" methods perferm tests only
  817
  818act(Agent, Action, State, NewState):-
  819  format('~Ncall ~p.~n',[act(Agent, Action, State, NewState)]),fail.
  820
  821act(Agent, Action, State, NewState) :-
  822  cant(Agent, Action, Reason, State),
  823  reason2eng(Reason, Eng),
  824  queue_percept(Agent, [failure(Action, Reason), Eng], State, NewState).
  825
  826act(Agent, look, State, NewState) :-
  827  related(How, Agent, Here, State),
  828  findall(What,
  829          related(child, What, Here, State),
  830          %(related(descended, What, Here, State),
  831           %\+ (related(inside, What, Container, State),
  832           %    related(descended, Container, Here, State))),
  833          Nearby),
  834  findall(Direction, related(exit(Direction),Here,_,State), Exits),
  835  !,
  836  queue_percept(Agent,
  837                [see(you_are(How, Here), exits_are(Exits), here_are(Nearby))],
  838                State, NewState).
  839
  840act(Agent, inventory, State, NewState) :-
  841  findall(What, related(child, What, Agent, State), Inventory),
  842  queue_percept(Agent, [carrying(Inventory)], State, NewState).
  843
  844act(Agent, examine(Object), S0, S2) :-
  845  %declared(props(Object, PropList), S0),
  846  findall(P, (getprop(Object, P, S0), is_prop_public(P)), PropList),
  847  queue_percept(Agent, [see_props(Object, PropList)], S0, S1),
  848  (relatable(How, Object, S1); How='<unrelatable>'),
  849  % Remember that Agent might be on the inside or outside of Object.
  850  findall(What,
  851          (related(child, What, Object, S1), once(visible(What, Agent, S1))),
  852          Children),
  853  queue_percept(Agent, [see_children(Object, How, Children)], S1, S2).
  854
  855
  856
  857act(Agent, go(_How, ExitName), S0, S9) :-         % go n/s/e/w/u/d/in/out
  858  related(child, Agent, Here, S0),
  859  related(exit(ExitName), Here, There, S0),
  860  %member(How, [*,to,at,through,thru]),
  861  relatable(HowThere, There, S0),
  862  moveto(Agent, HowThere, There,
  863         [Here,There],
  864         [cap(subj(Agent)),person(go,goes),ExitName],
  865         S0, S1),
  866  act(Agent, look, S1, S9).
  867act(Agent, go(How, Room), S0, S9) :-              % go in (adjacent) room
  868  relatable(How, Room, S0),
  869  related(open_traverse, Agent, Here, S0),
  870  related(exit(ExitName), Here, Room, S0),
  871  moveto(Agent, How, Room, [Room,Here], 
  872    [cap(subj(Agent)),person(go,goes),ExitName], S0, S1),
  873  act(Agent, look, S1, S9).
  874act(Agent, go(*, Room), S0, S9) :-              % go to (adjacent) room
  875  relatable(How, Room, S0),
  876  related(open_traverse, Agent, Here, S0),
  877  related(exit(ExitName), Here, Room, S0),
  878  moveto(Agent, How, Room, [Room,Here],
  879    [cap(subj(Agent)),person(go,goes),ExitName], S0, S1),
  880  act(Agent, look, S1, S9).
  881act(Agent, go(How, Object), S0, S2) :-            % go in/on object
  882  relatable(How, Object, S0),
  883  related(open_traverse, Agent, Here, S0),
  884  related(open_traverse, Object, Here, S0),
  885  \+ is_closed(Object, S0),
  886  moveto(Agent, How, Object, [Here],
  887    [subj(Agent),person(get,gets),How,the,Object,.], S0, S1),
  888  act(Agent, look, S1, S2).
  889act(Agent, go(How,Dest), S0, S1) :-
  890  queue_percept(Agent,
  891                [failure(go(How,Dest)), 'You can\'t go that way'],
  892                S0, S1).
  893
  894%  sim(verb(args...), preconds, effects)
  895%    Agent is substituted for $self.
  896%    preconds are in the implied context of a State.
  897%  In Inform, the following are implied context:
  898%    actor, action, noun, second
  899%  Need:
  900%    actor/agent, verb/action, direct-object/obj1, indirect-object/obj2,
  901%      preposition-introducing-obj2
  902%sim(put(Obj1,Obj2),
  903%    ( related(descended, Thing, $self),
  904%      can_see($self, Where),
  905%      relatable(Relation, Where),
  906%      related(descended, $self, Here)),
  907%    moveto(Thing, Relation, Where, [Here], 
  908%      [cap(subj($self)),person('put the','puts a'),
  909%        Thing,Relation,the,Where,'.'])).
  910
  911act(Agent, take(Thing), S0, S1) :-
  912  related(open_traverse, Agent, Here, S0),            % Where is Agent now?
  913  moveto(Thing, held_by, Agent, [Here],
  914    [silent(subj(Agent)),person('Taken.',[cap(Agent),'grabs the',Thing,'.'])],
  915    S0, S1).
  916%act(Agent, get(Thing), State, NewState) :-
  917%  act(Agent, take(Thing), State, NewState).
  918act(Agent, drop(Thing), State, NewState) :-
  919  related(How, Agent, Here, State),
  920  relatable(How, Here, State),
  921  moveto(Thing, How, Here, [Here],
  922    [cap(subj(Agent)),person('drop the','drops a'),Thing,'.'], State, NewState).
  923act(Agent, put(Thing1,Relation,Thing2), State, NewState) :-
  924  relatable(Relation, Thing2, State),
  925  (Relation \= in ; \+ is_closed(Thing2, State)),
  926  touchable(Thing2, Agent, State), % what if "under" an "untouchable" thing?
  927  % OK, put it
  928  related(open_traverse, Agent, Here, State),
  929  moveto(Thing1, Relation, Thing2, [Here], 
  930      [cap(subj(Agent)),person('put the','puts a'),Thing1,
  931          Relation,the,Thing2,'.'],
  932      State, NewState).
  933act(Agent, give(Thing,Recipient), S0, S9) :-
  934  relatable(held_by, Recipient, S0),
  935  touchable(Recipient, Agent, S0),
  936  % OK, give it
  937  related(open_traverse, Agent, Here, S0),
  938  moveto(Thing, held_by, Recipient, [Here],
  939    [cap(subj(Agent)),person([give,Recipient,the],'gives you a'),Thing,'.'],
  940    S0, S9).
  941act(Agent, throw(Thing,at,Target), S0, S9) :-
  942  visible(Target, Agent, S0),
  943  % OK, throw it
  944  related(How, Agent, Here, S0),
  945  thrown(Thing, Target, How, Here, [Here], S0, S1),
  946  hit(Target, Thing, [Here], S1, S9).
  947act(Agent, throw(Thing,ExitName), S0, S9) :-
  948  related(_How, Agent, Here, S0),
  949  related(exit(ExitName), Here, There, S0),
  950  relatable(HowThere, There, S0),
  951  thrown(Thing, There, HowThere, There, [Here,There], S0, S9).
  952act(Agent, hit(Thing), S0, S9) :-
  953  related(_How, Agent, Here, S0),
  954  hit(Thing, Agent, [Here], S0, S1),
  955  queue_percept(Agent, [true, 'OK.'], S1, S9).
  956act(Agent, dig(Hole,Where,Tool), S0, S9) :-
  957  memberchk(Hole,[hole,trench,pit,ditch]),
  958  memberchk(Where,[garden]),
  959  memberchk(Tool,[shovel,spade]),
  960  related(open_traverse, Tool, Agent, S0),
  961  related(in, Agent, Where, S0),
  962  \+ related(_How, Hole, Where, S0),
  963  % OK, dig the hole.
  964  declare(related(in, Hole, Where), S0, S1),
  965  setprop(Hole, relatable(in), S1, S2),
  966  setprop(Hole, immovable, S2, S3),
  967  declare(related(in, dirt, Where), S3, S8),
  968  queue_event(
  969    [ created(Hole,Where),
  970      [cap(subj(Agent)),person(dig,digs),'a',Hole,'in the',Where,'.']],
  971    S8, S9).
  972act(Agent, eat(Thing), S0, S9) :-
  973  getprop(Thing, edible, S0),
  974  undeclare(related(_,Thing,_), S0, S1),
  975  queue_percept(Agent, [destroyed(Thing), 'Mmmm, good!'], S1, S9).
  976act(Agent, eat(Thing), S0, S9) :-
  977  queue_percept(Agent, [failure(eat(Thing)), 'It''s inedible!'], S0, S9).
  978
  979act(Agent, switch(OnOff, Thing), S0, S) :-
  980  touchable(Thing, Agent, S0),
  981  getprop(Thing, switchable, S0),
  982  getprop(Thing, effect(switch(OnOff), Term0), S0),
  983  subst(equivalent,$self, Thing, Term0, Term),
  984  call(Term, S0, S1),
  985  queue_percept(Agent, [true, 'OK'], S1, S).
  986act(Agent, open(Thing), S0, S) :-
  987  touchable(Thing, Agent, S0),
  988  %getprop(Thing, openable, S0),
  989  %\+ getprop(Thing, open, S0),
  990  delprop(Thing, closed(true), S0, S1),
  991  %setprop(Thing, open, S0, S1),
  992  setprop(Thing, closed(fail), S1, S2),
  993  related(open_traverse, Agent, Here, S2),
  994  queue_local_event([setprop(Thing,closed(fail)), 'Opened.'], [Here], S2, S).
  995act(Agent, close(Thing), S0, S) :-
  996  touchable(Thing, Agent, S0),
  997  %getprop(Thing, openable, S0),
  998  %getprop(Thing, open, S0),
  999  delprop(Thing, closed(fail), S0, S1),
 1000  %delprop(Thing, open, S0, S1),
 1001  setprop(Thing, closed(true), S1, S2),
 1002  related(open_traverse, Agent, Here, S2),
 1003  queue_local_event([setprop(Thing,closed(true)), 'Closed.'], [Here], S2, S).
 1004
 1005act(Agent, talk(Object,Message), S0, S1) :-  % directed message
 1006  visible(Object, Agent, S0),
 1007  related(open_traverse, Agent, Here, S0),
 1008  queue_local_event([talk(Agent,Object,Message)], [Here], S0, S1).
 1009act(Agent, say(Message), S0, S1) :-          % undirected message
 1010  related(open_traverse, Agent, Here, S0),
 1011  queue_local_event([say(Agent, Message)], [Here], S0, S1).
 1012
 1013act(Agent, touch(_Thing), S0, S9) :-
 1014  queue_percept(Agent, [true,'OK.'], S0, S9).
 1015act(Agent, wait, State, NewState) :-
 1016  queue_percept(Agent, [time_passes], State, NewState).
 1017act(Agent, print_(Msg), S0, S1) :-
 1018  related(descended, Agent, Here, S0),
 1019  queue_local_event([true,Msg], [Here], S0, S1).
 1020act(_Agent, true, S, S).
 1021act(Agent, Action, S0, S1) :-
 1022  queue_percept(Agent, [failure(Action), 'You can''t do that.'], S0, S1).
 1023
 1024% Protocol:
 1025%   Agent: request(Action, Action_Id)
 1026%   Simulation: respond(Action_Id, LogicalResponse/Percept, EnglishResponse)
 1027%   Action(Verb, ...)
 1028%   failure(Reason)
 1029%   moved(obj, from, how, to)
 1030
 1031% -----------------------------------------------------------------------------
 1032% The state of an Agent is stored in its memory.
 1033% Agent memory is stored as a list in reverse chronological order, implicitly
 1034%   ordering and timestamping everything.
 1035% Types of memories:
 1036%   agent(A)        - identity of agent (?)
 1037%   timestamp(T)    - agent may add a new timestamp whenever a sequence point
 1038%                     is desired.
 1039%   [percept]       - received perceptions.
 1040%   model([...])    - Agent's internal model of the world.
 1041%                     Model is a collection of timestampped relations.
 1042%   goals([...])    - states the agent would like to achieve, or
 1043%                     acts the agent would like to be able to do.
 1044%   plan(S,O,B,L)   - plans for achieving goals.
 1045%   affect(...)     - Agent's current affect.
 1046% Multiple plans, goals, models, affects, etc. may be stored, for introspection
 1047%   about previous internal states.
 1048
 1049% Manipulate memories (M stands for Memories)
 1050memorize(Figment, M0, M1) :- append([Figment], M0, M1).
 1051memorize_list(FigmentList, M0, M1) :- append(FigmentList, M0, M1).
 1052forget(Figment, M0, M1) :- select(Figment, M0, M1).
 1053forget_always(Figment, M0, M1) :- select_always(Figment, M0, M1).
 1054%forget_default(Figment, Default, M0, M1) :-
 1055%  select_default(Figment, Default, M0, M1).
 1056thought(Figment, M) :- member(Figment, M).
 1057
 1058% -------- Model updating predicates (here M stands for Model)
 1059
 1060% Fundamental predicate that actually modifies the list:
 1061update_relation(NewHow, Item, NewParent, Timestamp, M0, M2) :-
 1062  select_always(related(_How,Item,_Where,_T), M0, M1),
 1063  append([related(NewHow,Item,NewParent,Timestamp)],M1,M2).
 1064
 1065% Batch-update relations.
 1066update_relations(_NewHow,[],_NewParent,_Timestamp,M,M).
 1067update_relations(NewHow, [Item|Tail], NewParent, Timestamp, M0, M2) :-
 1068  update_relation(NewHow, Item, NewParent, Timestamp, M0, M1),
 1069  update_relations(NewHow, Tail, NewParent, Timestamp, M1, M2).
 1070
 1071% If dynamic topology needs remembering, use
 1072%      related(exit(E),Here,[There1|ThereTail],Timestamp)
 1073update_exit(How, From, Timestamp, M0, M2) :-
 1074  select(related(How,From,To,_T), M0, M1),
 1075  append([related(How,From,To,Timestamp)], M1, M2).
 1076update_exit(How, From, Timestamp, M0, M1) :-
 1077  append([related(How,From,'<unexplored>',Timestamp)], M0, M1).
 1078
 1079update_exit(How, From, To, Timestamp, M0, M2) :-
 1080  select_always(related(How,From,_To,_T), M0, M1),
 1081  append([related(How,From,To,Timestamp)], M1, M2).
 1082
 1083update_exits([],_From,_T,M,M).
 1084update_exits([Exit|Tail], From, Timestamp, M0, M2) :-
 1085  update_exit(Exit, From, Timestamp, M0, M1),
 1086  update_exits(Tail, From, Timestamp, M1, M2).
 1087
 1088%butlast(List, ListButLast) :-
 1089%  %last(List, Item),
 1090%  append(ListButLast, [_Item], List).
 1091
 1092% Match only the most recent Figment in Memory.
 1093%last_thought(Figment, Memory) :-  % or member1(F,M), or memberchk(Term,List)
 1094%  copy_term(Figment, FreshFigment),
 1095%  append(RecentMemory, [Figment|_Tail], Memory),
 1096%  \+ member(FreshFigment, RecentMemory).
 1097
 1098update_model(Agent, carrying(Objects), Timestamp, _Memory, M0, M1) :-
 1099  update_relations(held_by, Objects, Agent, Timestamp, M0, M1).
 1100update_model(_Agent, see_children(Object,How,Children),Timestamp,_Mem,M0,M1) :-
 1101  update_relations(How, Children, Object, Timestamp, M0, M1).
 1102update_model(_Agent, see_props(Object,PropList), Stamp,_Mem,M0,M2) :-
 1103  select_always(props(Object,_,_),M0,M1),
 1104  append([props(Object,PropList, Stamp)],M1,M2).
 1105update_model(_Agent,
 1106             see(you_are(How,Here), exits_are(Exits), here_are(Objects)),
 1107             Timestamp, _Mem, M0, M4) :-
 1108  % Don't update map here, it's better done in the moved() clause.
 1109  update_relations(How,Objects,Here,Timestamp,M0,M3),  % Model objects seen Here
 1110  findall(exit(E), member(E,Exits), ExitRelations),
 1111  update_exits(ExitRelations, Here, Timestamp, M3, M4).% Model exits from Here.
 1112update_model(Agent, moved(Agent,There,How,Here), Timestamp, Mem, M0, M2) :-
 1113  % According to model, where was I?
 1114  member(related(_,Agent,There,_T0), M0),
 1115  % TODO: Handle go(on,table)
 1116  % How did I get Here?
 1117  append(RecentMem,[did(go(_HowGo,ExitName))|OlderMem], Mem), % find figment
 1118  \+ member(did(go(_,_)), RecentMem),                 % guarrantee recentness
 1119  memberchk(timestamp(_T1), OlderMem),                 % get associated stamp
 1120  %format('~p moved: go(~p,~p) from ~p leads to ~p~n',
 1121  %       [Agent, HowGo, Dest, There, Here]),
 1122  update_exit(exit(ExitName),There,Here,Timestamp,M0,M1), % Model the path.
 1123  update_relation(How, Agent, Here, Timestamp, M1, M2). % And update location.
 1124update_model(_Agent, moved(Object,_From,How,To), Timestamp, _Mem,M0,M1) :-
 1125  update_relation(How, Object, To, Timestamp, M0, M1).
 1126update_model(_Agent, _Percept, _Timestamp, _Memory, M, M).
 1127
 1128% update_model_all(Agent, PerceptsList, Stamp, ROMemory, OldModel, NewModel)
 1129update_model_all(_Agent, [], _Timestamp, _Memory, M, M).
 1130update_model_all(Agent, [Percept|Tail], Timestamp, Memory, M0, M2) :-
 1131  update_model(Agent, Percept, Timestamp, Memory, M0, M1),
 1132  update_model_all(Agent, Tail, Timestamp, Memory, M1, M2).
 1133
 1134path2directions([Here,There], [go(*,ExitName)], Model) :-
 1135  member(related(exit(ExitName),Here,There,_),Model).
 1136path2directions([Here,There], [go(in,There)], Model) :-
 1137  member(related(descended,Here,There,_),Model).
 1138path2directions([Here,Next|Trail], [go(*,ExitName)|Tail], Model) :-
 1139  member(related(exit(ExitName),Here,Next,_),Model),
 1140  path2directions([Next|Trail], Tail, Model).
 1141path2directions([Here,Next|Trail], [go(in,Next)|Tail], Model) :-
 1142  member(related(descended,Here,Next,_),Model),
 1143  path2directions([Next|Trail], Tail, Model).
 1144
 1145find_path1([First|_Rest],Dest,First,_Model) :-
 1146  First = [Dest|_].
 1147find_path1([[Last|Trail]|Others],Dest,Route,Model) :-
 1148  findall([Z,Last|Trail],
 1149          (member(related(_How,Last,Z,_),Model), \+ member(Z, Trail)),
 1150          List),
 1151  append(Others,List,NewRoutes),
 1152  find_path1(NewRoutes, Dest, Route, Model).
 1153find_path(Start, Dest, Route, Model) :-
 1154  find_path1([[Start]],Dest,R,Model),
 1155  reverse(R,RR),
 1156  path2directions(RR,Route,Model).
 1157
 1158% --------
 1159
 1160% TODO: rewrite/debug findterm.
 1161
 1162findterm(Term, Term).
 1163findterm(Term, [Head|_]) :-
 1164  findterm(Term, Head).
 1165findterm(Term, [_|Tail]) :-
 1166  findterm(Term, Tail).
 1167findterm(Term, T) :-
 1168  compound(T),
 1169  \+ is_list(T),
 1170  T =.. List,
 1171  findterm(Term, List).
 1172
 1173% Substitute 'Replace' for 'Find' in T0, yielding T.
 1174% TODO: add ^ handling like with bagof/setof.
 1175%   bagof(Template,X^Goal,List) means to never instantiate X
 1176% Current behavior:
 1177%   subst(copy_term,macro(Code),expanded(Code,X),macro(foo),expanded(foo,Y))
 1178%     leaving X unbound. Suppose I wanted X left bound?
 1179%   subst(equivalent,macro(Code),expanded(Code,X),macro(foo),macro(foo))
 1180%     This won't match Code.
 1181%   subst(unify,macro(Code),expanded(Code,X),macro(foo),expanded(foo,X))
 1182%     This only matches all occurrences of the same first Code!
 1183subst(unify,Find,Replace,Find,Replace) :-
 1184  % The first unification of Find sticks!  Doesn't seem too useful to me.
 1185  % TODO: consider somehow allowing a solution for each match.
 1186  %   ground(Find) -> T0=Find, ! ; T0=Find.  sort of does it
 1187  !.
 1188subst(equivalent,Find,Replace,T0,Replace) :-
 1189  % Don't unify any variables.  Safe and simple.
 1190  T0 == Find,
 1191  !.
 1192subst(copy_term,Find,Replace,FindCopy,ReplaceCopy) :-
 1193  % Unify with new instantiations at each replacement.
 1194  % Allows sensible behavior like:
 1195  %   subst(my_macro(Code),
 1196  %         expanded(Code),
 1197  %         (this,my_macro(that),other,my_macro(another)),
 1198  %         (this,expanded(that),other,expanded(another)) )
 1199  % ...but unfortunately will break any free-variable associations.
 1200  % TODO: think about how bagof works; apply here.
 1201  copy_term(Find-Replace, FindCopy-ReplaceCopy),
 1202  !.
 1203subst(BindType,Find,Replace,List,[T|Rest]) :-
 1204  is_list(List),
 1205  List = [T0|Rest0],  % fails when List = []
 1206  !,
 1207  subst(BindType,Find,Replace,T0,T),
 1208  subst(BindType,Find,Replace,Rest0,Rest).
 1209subst(BindType,Find,Replace,T0,T) :-
 1210  compound(T0),
 1211  % \+ is_list(T0),
 1212  !,
 1213  T0 =.. [Functor0|Args0],
 1214  subst(BindType,Find,Replace,Functor0,Functor1),
 1215  subst(BindType,Find,Replace,Args0,Args1),
 1216  % If Replacement would cause invalid functor, don't subst.
 1217  ( atom(Functor1) -> T =.. [Functor1|Args1] ; T =.. [Functor0|Args1]).
 1218subst(_BindType,_Find,_Replace,T,T).
 1219
 1220% Call subst on T for each Find-Replace pair in the given list.
 1221% Order of substitution may matter to you!
 1222subst_dict(_BindType,[],T,T).
 1223subst_dict(BindType,[Find-Replace|Rest],T0,T) :-
 1224  subst(BindType,Find,Replace,T0,T1),
 1225  subst_dict(BindType,Rest,T1,T).
 1226
 1227precond_matches_effect(Cond, Cond).
 1228
 1229precond_matches_effects(path(Here,There), StartEffects) :-
 1230  find_path(Here,There,_Route, StartEffects).
 1231precond_matches_effects(exists(Object), StartEffects) :-
 1232  member(related(_, Object, _, _), StartEffects)
 1233  ;
 1234  member(related(_, _, Object, _), StartEffects).
 1235precond_matches_effects(Cond, Effects) :-
 1236  member(E, Effects),
 1237  precond_matches_effect(Cond, E).
 1238
 1239oper(go(*,ExitName),
 1240     [ Here \= $self, There \= $self,
 1241       related(in,$self,Here,_),
 1242       related(exit(ExitName),Here,There,_)], % path(Here,There)
 1243     [ related(in,$self,There,_),
 1244       not related(in,$self,Here,_)]).
 1245oper(take(Thing), % from same room
 1246     [ Thing \= $self, exists(Thing),
 1247       There \= $self,
 1248       related(At,Thing,There,_),
 1249       related(At,$self,There,_)],
 1250     [ related(held_by,Thing,$self,_),
 1251       not related(At,Thing,There,_)]).
 1252%oper(take(Thing), % from something else
 1253%     [ Thing \= $self, exists(Thing),
 1254%       related(How,Thing,What,_),
 1255%       related(At,What,There,_),
 1256%       related(At,$self,There,_) ],
 1257%     [ related(held_by,Thing,$self,_),
 1258%       not related(How,Thing,There,_)]).
 1259oper(drop(Thing),
 1260     [ Thing \= $self, exists(Thing),
 1261       related(held_by, Thing, $self, _)],
 1262     [ not related(held_by, Thing, $self, _)] ).
 1263%oper(talk(Player, [please, give, me, the, Thing]),
 1264%     [ Thing \= $self, exists(Thing),
 1265%       related(held_by, Thing, Player, _),
 1266%       related(How,Player,Where,_),
 1267%       related(How,$self,Where,_) ],
 1268%     [ related(held_by, Thing, $self, _),
 1269%       not related(held_by, Thing, Player, _)] ).
 1270oper(give(Thing,Recipient),
 1271     [ Thing \= $self, Recipient \= $self,
 1272       exists(Thing), exists(Recipient),
 1273       Where \= $self,
 1274       related(held_by, Thing, $self, _),
 1275       related(in,Recipient,Where,_), exists(Where),
 1276       related(in,$self,Where,_)],
 1277     [ related(held_by,Thing,Recipient,_),
 1278       not related(held_by,Thing,$self,_)
 1279     ] ).
 1280oper(put(Thing,Relation,What), % in something else
 1281     [ Thing \= $self, What \= $self, Where \= $self,
 1282       Thing\=What, What\=Where, Thing\=Where,
 1283       related(held_by,Thing,$self,_), exists(Thing),
 1284       related(in,What,Where,_), exists(What), exists(Where),
 1285       related(in,$self,Where,_)],
 1286     [ related(Relation,Thing,What,_),
 1287       not related(held_by,Thing,$self,_)] ).
 1288%oper(put(Thing,Relation,Where), % in room
 1289%     [ Thing \= $self, exists(Thing),
 1290%       related(held_by,Thing,$self,_),
 1291%       related(Relation,$self,Where,_)],
 1292%     [ related(Relation,Thing,Where,_),
 1293%       not related(held_by,Thing,$self,_)] ).
 1294
 1295% Return an operator after substituting Agent for $self.
 1296operagent(Agent,Action,Conds,Effects) :-
 1297  oper(Action,Conds0,Effects0),
 1298  subst(equivalent,$self, Agent, Conds0, Conds),
 1299  subst(equivalent,$self, Agent, Effects0, Effects).
 1300
 1301% Return the initial list of operators.
 1302initial_operators(Agent, Operators) :-
 1303  findall(oper(Action,Conds,Effects),
 1304          operagent(Agent,Action,Conds,Effects),
 1305          Operators).
 1306
 1307precondition_matches_effect(Cond, Effect) :-
 1308  % format('      Comparing cond ~w with effect ~w: ',[Cond,Effect]),
 1309  Cond = Effect. %, format('match~n',[]).
 1310%precondition_matches_effect(not not Cond, Effect) :-
 1311%  precondition_matches_effect(Cond, Effect).
 1312%precondition_matches_effect(Cond, not not Effect) :-
 1313%  precondition_matches_effect(Cond, Effect).
 1314precondition_matches_effects(Cond, Effects) :-
 1315  member(E, Effects),
 1316  precondition_matches_effect(Cond, E).
 1317preconditions_match_effects([Cond|Tail], Effects) :-
 1318  precondition_matches_effects(Cond, Effects),
 1319  preconditions_match_effects(Tail, Effects).
 1320
 1321% plan(steps, orderings, bindings, links)
 1322% step(id, operation)
 1323new_plan(_Agent, CurrentState, GoalState, Plan) :-
 1324  Plan = plan([step(start ,oper(true, [], CurrentState)),
 1325               step(finish,oper(true, GoalState, []))],
 1326              [before(start,finish)],
 1327              [],
 1328              []).
 1329
 1330isbefore(I, J, Orderings) :-
 1331  member(before(I,J), Orderings).
 1332%isbefore(I, K, Orderings) :-
 1333%  select(before(I,J), Orderings, Remaining),
 1334%  isbefore(J, K, Remaining).
 1335
 1336% These will fail to create inconsistent orderings.
 1337%add_ordering(B, Orderings, Orderings) :-
 1338%  member(B, Orderings), !.
 1339%add_ordering(before(I,K), Orderings, [before(I,K)|Orderings]) :-
 1340%  I \= K,
 1341%  \+ isbefore(K,I,Orderings),
 1342%  bugout('    ADDED ~w to orderings.~n',[before(I,K)],planner).
 1343%add_ordering(B, O, O) :-
 1344%  bugout('    FAILED to add ~w to orderings.~n',[B],planner),
 1345%  fail.
 1346
 1347add_ordering(B, Orderings, Orderings) :-
 1348  member(B, Orderings), !.
 1349add_ordering(before(I,J), Order0, Order1) :-
 1350  I \= J,
 1351  \+ isbefore(J,I,Order0),
 1352  add_ordering3(before(I,J),Order0,Order0,Order1).
 1353add_ordering(B, Order0, Order0) :-
 1354  once(pick_ordering(Order0, List)),
 1355  bugout('  FAILED add_ordering ~w to ~w~n',[B,List],planner),
 1356  fail.
 1357
 1358% add_ordering3(NewOrder, ToCheck, OldOrderings, NewOrderings)
 1359add_ordering3(before(I,J), [], OldOrderings, NewOrderings) :-
 1360  union([before(I,J)], OldOrderings, NewOrderings).
 1361add_ordering3(before(I,J), [before(J,K)|Rest], OldOrderings, NewOrderings) :-
 1362  I \= K,
 1363  union([before(J,K)], OldOrderings, Orderings1),
 1364  add_ordering3(before(I,J), Rest, Orderings1, NewOrderings).
 1365add_ordering3(before(I,J), [before(H,I)|Rest], OldOrderings, NewOrderings) :-
 1366  H \= J,
 1367  union([before(H,J)], OldOrderings, Orderings1),
 1368  add_ordering3(before(I,J), Rest, Orderings1, NewOrderings).
 1369add_ordering3(before(I,J), [before(H,K)|Rest], OldOrderings, NewOrderings) :-
 1370  I \= K,
 1371  H \= J,
 1372  add_ordering3(before(I,J), Rest, OldOrderings, NewOrderings).
 1373
 1374% insert(E,L,L1) inserts E into L producing L1
 1375% E is not added it is already there.
 1376insert(X,[],[X]).
 1377insert(A,[A|R],[A|R]).
 1378insert(A,[B|R],[B|R1]) :-
 1379   A \== B,
 1380   insert(A,R,R1).
 1381
 1382add_orderings([], Orderings, Orderings).
 1383add_orderings([B|Tail], Orderings, NewOrderings) :-
 1384  add_ordering(B,Orderings,Orderings2),
 1385  add_orderings(Tail,Orderings2,NewOrderings).
 1386
 1387del_ordering_node(I, [before(I,_)|Tail], Orderings) :-
 1388  del_ordering_node(I, Tail, Orderings).
 1389del_ordering_node(I, [before(_,I)|Tail], Orderings) :-
 1390  del_ordering_node(I, Tail, Orderings).
 1391del_ordering_node(I, [before(X,Y)|Tail], [before(X,Y)|Orderings]) :-
 1392  X \= I,
 1393  Y \= I,
 1394  del_ordering_node(I, Tail, Orderings).
 1395del_ordering_node(_I, [], []).
 1396
 1397ordering_nodes(Orderings, Nodes) :-
 1398  setof(Node,
 1399        Other^(isbefore(Node,Other,Orderings);isbefore(Other,Node,Orderings)),
 1400        Nodes).
 1401
 1402pick_ordering(Orderings, List) :-
 1403  ordering_nodes(Orderings, Nodes),
 1404  pick_ordering(Orderings, Nodes, List).
 1405
 1406pick_ordering(Orderings, Nodes, [I|After]) :-
 1407  select(I, Nodes, RemainingNodes),
 1408  forall(member(J,RemainingNodes), \+ isbefore(J,I,Orderings) ),
 1409  pick_ordering(Orderings, RemainingNodes, After).
 1410pick_ordering(_Orderings, [], []).
 1411
 1412test_ordering :-
 1413  bugout('ORDERING TEST:~n', planner),
 1414  once(add_orderings(
 1415   [ before(start,finish),
 1416     before(start,x),
 1417     before(start,y),before(y,finish),
 1418     before(x,z),
 1419     before(z,finish)
 1420   ],
 1421   [],
 1422   Orderings)),
 1423  bugout('  ordering is ~w~n',[Orderings],planner),
 1424  pick_ordering(Orderings, List),
 1425  bugout('  picked ~w~n',[List],planner),
 1426  fail.
 1427test_ordering :- bugout('  END ORDERING TEST~n',planner).
 1428
 1429cond_is_achieved(step(J,_Oper), C, plan(Steps,Orderings,_,_)) :-
 1430  member(step(I, oper(_, _, Effects)), Steps),
 1431  precondition_matches_effects(C, Effects),
 1432  isbefore(I, J, Orderings),
 1433  bugout('      Cond ~w of step ~w is achieved!~n',[C,J],planner).
 1434cond_is_achieved(step(J,_Oper), C, plan(_Steps,_Orderings,_,_)) :-
 1435  bugout('      Cond ~w of step ~w is NOT achieved.~n',[C,J],planner),
 1436  !,fail.
 1437
 1438% Are the preconditions of a given step achieved by the effects of other
 1439% steps, or are already true?
 1440step_is_achieved(step(_J, oper(_, [], _)), _Plan).  % No conditions, OK.
 1441step_is_achieved(step(J, oper(_, [C|Tail], _)), plan(Steps,Orderings,_,_)) :-
 1442  cond_is_achieved(step(J,_), C, plan(Steps,Orderings,_,_)),
 1443  step_is_achieved(step(J, oper(_, Tail, _)), plan(Steps,Orderings,_,_)).
 1444  
 1445all_steps_are_achieved([Step|Tail],Plan) :-
 1446  step_is_achieved(Step, Plan),
 1447  all_steps_are_achieved(Tail, Plan).
 1448all_steps_are_achieved([],_Plan).
 1449
 1450is_solution(plan(Steps,O,B,L)) :-
 1451  all_steps_are_achieved(Steps, plan(Steps,O,B,L)).
 1452
 1453% Create a new step given an operator.
 1454operator_as_step(oper(Act,Cond,Effect), step(Id, oper(Act,Cond,Effect))) :-
 1455  Act =.. [Functor|_],
 1456  atom_concat(Functor,'_step_',Prefix),
 1457  gensym(Prefix, Id).
 1458
 1459% Create a list of new steps given a list of operators.
 1460operators_as_steps([],[]).
 1461operators_as_steps([Oper | OpTail], [Step | StepTail]) :-
 1462  copy_term(Oper, FreshOper), % Avoid instantiating operator database.
 1463  operator_as_step(FreshOper, Step),
 1464  operators_as_steps(OpTail, StepTail).
 1465
 1466cond_as_goal(ID, Cond, goal(ID, Cond)).
 1467conds_as_goals(_, [],[]).
 1468conds_as_goals(ID, [C|R],[G|T]) :-
 1469  cond_as_goal(ID,C,G),
 1470  conds_as_goals(ID,R,T).
 1471
 1472cond_equates(Cond0, Cond1) :- Cond0 = Cond1.
 1473cond_equates(related(X,Y,Z,_), related(X,Y,Z,_)).
 1474cond_equates(not not Cond0, Cond1) :- cond_equates(Cond0, Cond1).
 1475cond_equates(Cond0, not not Cond1) :- cond_equates(Cond0, Cond1).
 1476
 1477cond_negates(not Cond0, Cond1) :- cond_equates(Cond0, Cond1).
 1478cond_negates(Cond0, not Cond1) :- cond_equates(Cond0, Cond1).
 1479
 1480% Protect 1 link from 1 condition
 1481% protect(link_to_protect, threatening_step, threatening_cond, ...)
 1482protect(causes(StepI,_Cond0,_StepJ), StepI, _Cond1, Order0, Order0) :-
 1483  !. % Step does not threaten itself.
 1484protect(causes(_StepI,_Cond0,StepJ), StepJ, _Cond1, Order0, Order0) :-
 1485  !. % Step does not threaten itself.
 1486%protect(causes(_StepI,Cond,_StepJ), _StepK, Cond, Order0, Order0) :-
 1487%  !. % Cond does not threaten itself.
 1488protect(causes(_StepI,Cond0,_StepJ), _StepK, Cond1, Order0, Order0) :-
 1489  \+ cond_negates(Cond0, Cond1),
 1490  !.
 1491protect(causes(StepI,Cond0,StepJ), StepK, _Cond1, Order0, Order0) :-
 1492  bugout('  THREAT: ~w <> causes(~w,~w,~w)~n',
 1493         [StepK,StepI,Cond0,StepJ],planner),
 1494  fail.
 1495protect(causes(StepI,_Cond0,StepJ), StepK, _Cond1, Order0, Order1) :-
 1496  % Protect by moving threatening step before or after this link.
 1497  add_ordering(before(StepK,StepI), Order0, Order1),
 1498  bugout('    RESOLVED with ~w~n',[before(StepK,StepI)],planner)
 1499  ;
 1500  add_ordering(before(StepJ,StepK), Order0, Order1),
 1501  bugout('    RESOLVED with ~w~n',[before(StepJ,StepK)],planner).
 1502protect(causes(StepI,Cond0,StepJ), StepK, _Cond1, Order0, Order0) :-
 1503  bugout('  FAILED to resolve THREAT ~w <> causes(~w,~w,~w)~n',
 1504         [StepK,StepI,Cond0,StepJ],planner),
 1505  once(pick_ordering(Order0, Serial)),
 1506  bugout('    ORDERING is ~w~n', [Serial], planner),
 1507  fail.
 1508
 1509% Protect 1 link from 1 step's multiple effects
 1510protect_link(_Link, _StepID, [], Order0, Order0).
 1511protect_link(Link, StepID, [Cond|Effects], Order0,Order2):-
 1512  protect(Link, StepID, Cond, Order0, Order1),
 1513  protect_link(Link, StepID, Effects, Order1, Order2).
 1514
 1515% Protect all links from 1 step's multiple effects
 1516% protect_links(links_to_protect, threatening_step, threatening_cond, ...)
 1517protect_links([], _StepID, _Effects, Order0, Order0).
 1518protect_links([Link|Tail], StepID, Effects, Order0, Order2) :-
 1519  protect_link(Link, StepID, Effects, Order0, Order1),
 1520  protect_links(Tail, StepID, Effects, Order1, Order2).
 1521
 1522% Protect 1 link from all steps' multiple effects
 1523protect_link_all(_Link, [], Order0, Order0).
 1524protect_link_all(Link, [step(StepID,oper(_,_,Effects))|Steps], Order0,Order2) :-
 1525  protect_link(Link, StepID, Effects, Order0, Order1),
 1526  protect_link_all(Link, Steps, Order1, Order2).
 1527
 1528%add_binding((X\=Y), Bindings0, Bindings) :-
 1529%  X \= Y,  % if they can't bind, don't bother to add them.
 1530add_binding((X\=Y), Bindings, [(X\=Y)|Bindings]) :-
 1531  X \== Y,   % if they're distinct,
 1532  % \+ \+ X=Y, % but could bind
 1533  bindings_valid(Bindings).
 1534
 1535bindings_valid([]).
 1536bindings_valid([(X\=Y)|Bindings]) :-
 1537  X \== Y,
 1538  bindings_valid(Bindings).
 1539%bindings_valid(B) :-
 1540%  bugout('  BINDINGS are *INVALID*: ~w~n', [B], planner),
 1541%  fail.
 1542
 1543bindings_safe([]) :- bugout('  BINDINGS are SAFE~n',planner).
 1544bindings_safe([(X\=Y)|Bindings]) :-
 1545  X \= Y,
 1546  bindings_safe(Bindings).
 1547%bindings_safe(B) :-
 1548%  bugout('  BINDINGS are *UNSAFE*: ~w~n', [B], planner),
 1549%  fail.
 1550
 1551choose_operator([goal(GoalID,GoalCond)|Goals0], Goals0,
 1552                 _Operators,
 1553                 plan(Steps,Order0,Bindings,OldLinks),
 1554                 plan(Steps,Order9,Bindings,NewLinks),
 1555                 Depth, Depth ) :-
 1556  % Achieved by existing step?
 1557  member(step(StepID,oper(_Action,_Preconds,Effects)), Steps),
 1558  precondition_matches_effects(GoalCond,Effects),
 1559  add_ordering(before(StepID,GoalID), Order0, Order1),
 1560  % Need to protect new link from all existing steps
 1561  protect_link_all(causes(StepID,GoalCond,GoalID),Steps,Order1,Order9),
 1562  union([causes(StepID,GoalCond,GoalID)], OldLinks, NewLinks),
 1563  bindings_valid(Bindings),
 1564  bugout('  EXISTING step ~w satisfies ~w~n', [StepID,GoalCond], planner).
 1565choose_operator([goal(_GoalID, X \= Y)|Goals0], Goals0,
 1566                 _Operators,
 1567                 plan(Steps,Order,Bindings,Links),
 1568                 plan(Steps,Order,NewBindings,Links),
 1569                 Depth, Depth ) :-
 1570  add_binding((X\=Y), Bindings, NewBindings),
 1571  bugout('  BINDING ADDED: ~w~n',[X\=Y],planner).
 1572choose_operator([goal(GoalID, not GoalCond)|Goals0], Goals0,
 1573                 _Operators,
 1574                 plan(Steps,Order0,Bindings,OldLinks),
 1575                 plan(Steps,Order9,Bindings,NewLinks),
 1576                 Depth, Depth ) :-
 1577  % Negative condition achieved by start step?
 1578  memberchk(step(start,oper(_Action,_Preconds,Effects)), Steps),
 1579  \+ precondition_matches_effects(GoalCond,Effects),
 1580  add_ordering(before(start,GoalID), Order0, Order1),
 1581  % Need to protect new link from all existing steps
 1582  protect_link_all(causes(start,GoalCond,GoalID),Steps,Order1,Order9),
 1583  union([causes(start,not GoalCond,GoalID)], OldLinks, NewLinks),
 1584  bindings_valid(Bindings),
 1585  bugout('  START SATISFIES NOT ~w~n', [GoalCond], planner).
 1586choose_operator([goal(GoalID, exists(GoalCond))|Goals0], Goals0,
 1587                 _Operators,
 1588                 plan(Steps,Order0,Bindings,OldLinks),
 1589                 plan(Steps,Order9,Bindings,NewLinks),
 1590                 Depth, Depth ) :-
 1591  memberchk(step(start,oper(_Action,_Preconds,Effects)), Steps),
 1592  ( member(related(_How,GoalCond,_Where,_), Effects);
 1593    member(related(_How,_What,GoalCond,_), Effects)),
 1594  add_ordering(before(start,GoalID), Order0, Order1),
 1595  % Need to protect new link from all existing steps
 1596  protect_link_all(causes(start,GoalCond,GoalID),Steps,Order1,Order9),
 1597  union([causes(start,exists(GoalCond),GoalID)], OldLinks, NewLinks),
 1598  bindings_valid(Bindings),
 1599  bugout('  START SATISFIES exists(~w)~n', [GoalCond], planner).
 1600choose_operator([goal(GoalID,GoalCond)|Goals0], Goals2,
 1601                 Operators,
 1602                 plan(OldSteps,Order0,Bindings,OldLinks),
 1603                 plan(NewSteps,Order9,Bindings,NewLinks),
 1604                 Depth0, Depth ) :-
 1605  % Condition achieved by new step?
 1606  Depth0 > 0,
 1607  Depth is Depth0 - 1,
 1608  %operators_as_steps(Operators, FreshSteps),
 1609  copy_term(Operators, FreshOperators),
 1610  % Find a new operator.
 1611  %member(step(StepID,oper(Action,Preconds,Effects)), FreshSteps),
 1612  member(oper(Action,Preconds,Effects), FreshOperators),
 1613  precondition_matches_effects(GoalCond,Effects),
 1614  operator_as_step(oper(Action,Preconds,Effects),
 1615                   step(StepID,oper(Action,Preconds,Effects)) ),
 1616  % Add ordering constraints.
 1617  add_orderings([before(start, StepID),
 1618                 before(StepID,GoalID),
 1619                 before(StepID,finish)],
 1620                Order0, Order1),
 1621  % Need to protect existing links from new step.
 1622  protect_links(OldLinks, StepID, Effects, Order1, Order2),
 1623  % Need to protect new link from all existing steps
 1624  protect_link_all(causes(StepID,GoalCond,GoalID),OldSteps,Order2,Order9),
 1625  % Add the step.
 1626  append(OldSteps, [step(StepID,oper(Action,Preconds,Effects))], NewSteps),
 1627  % Add causal constraint.
 1628  union([causes(StepID, GoalCond, GoalID)], OldLinks, NewLinks),
 1629  % Add consequent goals.
 1630  conds_as_goals(StepID,Preconds,NewGoals),
 1631  append(Goals0, NewGoals, Goals2),
 1632  bindings_valid(Bindings),
 1633  bugout('  ~w CREATED ~w to satisfy ~w~n',
 1634         [Depth,StepID,GoalCond],autonomous),
 1635  pprint(oper(Action,Preconds,Effects), planner),
 1636  once(pick_ordering(Order9,List)),
 1637  bugout('    Orderings are ~w~n', [List], planner).
 1638choose_operator([goal(GoalID,GoalCond)|_G0], _G2, _Op, _P0, _P2, D, D) :-
 1639  bugout('  CHOOSE_OPERATOR FAILED on goal:~n    goal(~w,~w)~n',
 1640         [GoalID,GoalCond],planner),
 1641  !, fail.
 1642choose_operator(G0, _G2, _Op, _P0, _P2, D, D) :-
 1643  bugout('  !!! CHOOSE_OPERATOR FAILED: G0 = ~w~n', [G0], planner), !, fail.
 1644
 1645planning_loop([], _Operators, plan(S,O,B,L), plan(S,O,B,L), _Depth, _TO ) :-
 1646  bugout('FOUND SOLUTION?~n',planner),
 1647  bindings_safe(B).
 1648planning_loop(Goals0, Operators, Plan0, Plan2, Depth0, Timeout) :-
 1649  %Limit > 0,
 1650  get_time(Now),
 1651  (Now > Timeout -> throw(timeout(planner)); true),
 1652  bugout('GOALS ARE: ~w~n',[Goals0],planner),
 1653  choose_operator(Goals0, Goals1, Operators, Plan0, Plan1, Depth0, Depth),
 1654  %Limit2 is Limit - 1,
 1655  planning_loop(Goals1, Operators, Plan1, Plan2, Depth, Timeout).
 1656%planning_loop(_Goals0, _Operators, Plan0, Plan0, _Limit) :-
 1657%  Limit < 1,
 1658%  bugout('Search limit reached!~n',planner),
 1659%  fail.
 1660
 1661serialize_plan(plan([],_Orderings,_B,_L), []) :- !.
 1662
 1663serialize_plan(plan(Steps,Orderings,B,L), Tail) :-
 1664  select(step(_,oper(true,_,_)), Steps, RemainingSteps),
 1665  !,
 1666  serialize_plan(plan(RemainingSteps,Orderings,B,L), Tail).
 1667
 1668serialize_plan(plan(Steps,Orderings,B,L), [Action|Tail]) :-
 1669  select(step(StepI,oper(Action,_,_)), Steps, RemainingSteps),
 1670  \+ (member(step(StepJ,_Oper), RemainingSteps),
 1671      isbefore(StepJ, StepI, Orderings)),
 1672  serialize_plan(plan(RemainingSteps,Orderings,B,L), Tail).
 1673
 1674serialize_plan(plan(_Steps,Orderings,_B,_L), _) :-
 1675  bugout('serialize_plan FAILED!~n', planner),
 1676  pick_ordering(Orderings,List),
 1677  bugout('  Orderings are ~w~n', [List], planner),
 1678  fail.
 1679
 1680select_unsatisfied_conditions([], [], _Model) :- !.
 1681select_unsatisfied_conditions([Cond|Tail], Unsatisfied, Model) :-
 1682  precondition_matches_effects(Cond, Model),
 1683  !,
 1684  select_unsatisfied_conditions(Tail, Unsatisfied, Model).
 1685select_unsatisfied_conditions([not Cond|Tail], Unsatisfied, Model) :-
 1686  \+ precondition_matches_effects(Cond, Model),
 1687  !,
 1688  select_unsatisfied_conditions(Tail, Unsatisfied, Model).
 1689select_unsatisfied_conditions([Cond|Tail], [Cond|Unsatisfied], Model) :-
 1690  !,
 1691  select_unsatisfied_conditions(Tail, Unsatisfied, Model).
 1692
 1693depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
 1694                    Depth, Timeout) :-
 1695  bugout('PLANNING DEPTH is ~w~n',[Depth],autonomous),
 1696  planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan, Depth, Timeout),
 1697  !.
 1698depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
 1699                    Depth0, Timeout) :-
 1700  Depth0 =< 7,
 1701  Depth is Depth0 + 1,
 1702  depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
 1703                      Depth, Timeout).
 1704
 1705generate_plan(FullPlan, Mem0) :-
 1706  thought(agent(Agent), Mem0),
 1707  initial_operators(Agent, Operators),
 1708  bugout('OPERATORS are:~n',planner), pprint(Operators,planner),
 1709  thought(model(Model0), Mem0),
 1710  %bugout('CURRENT STATE is ~w~n',[Model0],planner),
 1711  thought(goals(Goals), Mem0),
 1712  new_plan(Agent, Model0, Goals, SeedPlan),
 1713  bugout('SEED PLAN is:~n', planner), pprint(SeedPlan,planner),
 1714  !,
 1715  %planning_loop(Operators, SeedPlan, FullPlan),
 1716  conds_as_goals(finish, Goals, PlannerGoals),
 1717  get_time(Now),
 1718  Timeout is Now + 60, % seconds
 1719  catch(
 1720    depth_planning_loop(PlannerGoals, Operators, SeedPlan, FullPlan,
 1721                        1, Timeout),
 1722    timeout(planner),
 1723    (bugout('PLANNER TIMEOUT~n',autonomous), fail)
 1724  ),
 1725  bugout('FULL PLAN is:~n', planner), pprint(FullPlan,planner).
 1726
 1727% ---- 
 1728
 1729add_goal(Goal, Mem0, Mem2) :-
 1730  bugout('adding goal ~w~n',[Goal],planner),
 1731  forget(goals(OldGoals), Mem0, Mem1),
 1732  append([Goal],OldGoals,NewGoals),
 1733  memorize(goals(NewGoals), Mem1, Mem2).
 1734
 1735add_goals(Goals, Mem0, Mem2) :-
 1736  forget(goals(OldGoals), Mem0, Mem1),
 1737  append(Goals,OldGoals,NewGoals),
 1738  memorize(goals(NewGoals), Mem1, Mem2).
 1739
 1740add_todo(Action, Mem0, Mem2) :-
 1741  forget(todo(OldToDo), Mem0, Mem1),
 1742  append(OldToDo,[Action],NewToDo),
 1743  memorize(todo(NewToDo), Mem1, Mem2).
 1744
 1745add_todo_all([], Mem0, Mem0).
 1746add_todo_all([Action|Rest], Mem0, Mem2) :-
 1747  add_todo(Action, Mem0, Mem1),
 1748  add_todo_all(Rest, Mem1, Mem2).
 1749
 1750% For now, agents will attempt to satisfy all commands.
 1751%consider_request(_Speaker, Agent, take(Object), M0, M1) :-
 1752%  add_goal(related(held_by,Object,Agent,_), M0, M1).
 1753consider_request(_Speaker, Agent, Action, M0, M0) :-
 1754  bugout('~w: considering request: ~w.~n',[Agent,Action],autonomous),
 1755  fail.
 1756consider_request(Requester, _Agent, Query, M0, M1) :-
 1757  do_introspect(Query, Answer, M0),
 1758  %add_todo(print_(Answer), M0, M1).
 1759  add_todo(talk(Requester, Answer), M0, M1).
 1760consider_request(_Speaker, Agent, forget(goals), M0, M2) :-
 1761  bugout('~w: forgetting goals.~n',[Agent],autonomous),
 1762  forget_always(goals(_),M0,M1),
 1763  memorize(goals([]),M1,M2).
 1764consider_request(_Speaker, _Agent, go(*,ExitName), M0, M1) :-
 1765  bugout('Queueing action ~w~n',go(*,ExitName),autonomous),
 1766  add_todo(go(*,ExitName), M0, M1).
 1767consider_request(Speaker, _Agent, fetch(Object), M0, M1) :-
 1768  % Bring object back to Speaker.
 1769  add_goal(related(held_by,Object,Speaker,_), M0, M1).
 1770consider_request(_Speaker, _Agent, put(Thing,Relation,Where), M0,M) :-
 1771  add_goal(related(Relation,Thing,Where,_), M0, M).
 1772consider_request(_Speaker, Agent, take(Thing), M0,M) :-
 1773  add_goal(related(held_by,Thing,Agent,_), M0, M).
 1774consider_request(_Speaker, Agent, Action, M0, M1) :-
 1775  bugout('Finding goals for action: ~w~n',[Action],autonomous),
 1776  initial_operators(Agent, Operators),
 1777  findall(Effects,
 1778          member(oper(Action,_Conds,Effects), Operators),
 1779          [UnambiguousGoals]),
 1780  bugout('Request: ~w --> goals ~w.~n',[Action,UnambiguousGoals],autonomous),
 1781  add_goals(UnambiguousGoals, M0, M1).
 1782consider_request(_Speaker, _Agent, Action, M0, M1) :-
 1783  bugout('Queueing action: ~w~n', [Action], autonomous),
 1784  add_todo(Action, M0, M1).
 1785consider_request(_Speaker, Agent, Action, M0, M0) :-
 1786  bugout('~w: did not understand request: ~w~n', [Agent,Action], autonomous).
 1787
 1788% Autonomous logical percept processing.
 1789process_percept_auto(Agent, [say(Agent,_)|_], _Stamp, Mem0, Mem0).
 1790process_percept_auto(Agent, [talk(Agent,_,_)|_], _Stamp, Mem0, Mem0).
 1791process_percept_auto(Agent, talk(Speaker,Agent,Words), _Stamp, Mem0, Mem1) :-
 1792  parse(Words, Action, Mem0),
 1793  consider_request(Speaker, Agent, Action, Mem0, Mem1).
 1794process_percept_auto(Agent, say(Speaker,[Agent|Words]), _Stamp, Mem0, Mem1) :-
 1795  parse(Words, Action, Mem0),
 1796  consider_request(Speaker, Agent, Action, Mem0, Mem1).
 1797process_percept_auto(Agent, Percept, _Stamp, Mem0, Mem0) :-
 1798  Percept =.. [Functor|_],
 1799  member(Functor, [talk,say]),
 1800  bugout('~w: Ignoring ~w~n',[Agent,Percept],autonomous).
 1801process_percept_auto(Agent, see_props(Object,PropList), _Stamp, Mem0, Mem2) :-
 1802  bugout('~w: ~w~n', [Agent,see_props(Object,PropList)], autonomous),
 1803  member(shiny, PropList),
 1804  member(model(Model), Mem0),
 1805  \+ related(descended, Object, Agent, Model), % Not holding it?
 1806  add_todo_all([take(Object), print_('My shiny precious!')], Mem0, Mem2).
 1807process_percept_auto(_Agent,
 1808    see(you_are(_How,_Here), exits_are(_Exits), here_are(Objects)),
 1809    _Stamp, Mem0, Mem2) :-
 1810  member(model(Model), Mem0),
 1811  findall(examine(Obj),
 1812          ( member(Obj, Objects),
 1813            \+ member(props(Obj,_,_),Model)),
 1814          ExamineNewObjects),
 1815  add_todo_all(ExamineNewObjects, Mem0, Mem2).
 1816process_percept_auto(_Agent, _Percept, _Stamp, Mem0, Mem0).
 1817
 1818process_percept_player(Agent, [say(Agent,_)|_], _Stamp, Mem0, Mem0).
 1819process_percept_player(Agent, [talk(Agent,_,_)|_], _Stamp, Mem0, Mem0).
 1820  % Ignore own speech.
 1821process_percept_player(Agent, Percept, _Stamp, Mem0, Mem0) :-
 1822  percept2txt(Agent, Percept, Text),
 1823  format('~w~n', [Text]).
 1824
 1825process_percept(Agent, [LogicalPercept|_], Stamp, Mem0, Mem1) :-
 1826  thought(agent_type(autonomous), Mem0),
 1827  process_percept_auto(Agent, LogicalPercept, Stamp, Mem0, Mem1).
 1828process_percept(Agent, Percept, Stamp, Mem0, Mem1) :-
 1829  thought(agent_type(console), Mem0),
 1830  process_percept_player(Agent, Percept, Stamp, Mem0, Mem1).
 1831process_percept(_Agent, _Percept, _Stamp, Mem0, Mem0).
 1832
 1833process_percept_main(Agent, Percept, Stamp, Mem0, Mem3) :-
 1834  forget(model(Model0), Mem0, Mem1),
 1835  Percept = [LogicalPercept|_],
 1836  update_model(Agent, LogicalPercept, Stamp, Mem1, Model0, Model1),
 1837  memorize(model(Model1),Mem1,Mem2),
 1838  process_percept(Agent, Percept, Stamp, Mem2, Mem3).
 1839process_percept_main(_Agent, Percept, _Stamp, Mem0, Mem0) :-
 1840  bugout('process_percept_main(~w) FAILED!~n',[Percept],general), !.
 1841
 1842% caller memorizes PerceptList
 1843process_percept_list(_Agent, _, _Stamp, Mem, Mem) :-
 1844  thought(agent_type(recorder), Mem),
 1845  !.
 1846process_percept_list(Agent, [Percept|Tail], Stamp, Mem0, Mem4) :-
 1847  %bugout('process_percept_list([~w|_])~n',[Percept],autonomous),
 1848  %!,
 1849  process_percept_main(Agent, Percept, Stamp, Mem0, Mem1),
 1850  process_percept_list(Agent, Tail, Stamp, Mem1, Mem4).
 1851process_percept_list(_Agent, [], _Stamp, Mem0, Mem0).
 1852process_percept_list(_Agent, _, _Stamp, Mem0, Mem0) :-
 1853  bugout('process_percept_list FAILED!~n',general).
 1854
 1855% -----------------------------------------------------------------------------
 1856:- dynamic(useragent/1). 1857useragent(player).
 1858
 1859cmdalias(d, down).
 1860cmdalias(e, east).
 1861cmdalias(i, inventory).
 1862cmdalias(l, look).
 1863cmdalias(n, north).
 1864cmdalias(s, south).
 1865cmdalias(u, up).
 1866cmdalias(w, west).
 1867cmdalias(x, examine).
 1868cmdalias(z, wait).
 1869
 1870preposition(P) :-
 1871  member(P, [at,down,in,inside,into,of,off,on,onto,out,over,to,under,up,with]).
 1872compass_direction(D) :-
 1873  member(D, [north,south,east,west]).
 1874
 1875reflexive(W) :- member(W, [self,me,myself]). % 'i' inteferes with inventory
 1876
 1877strip_noise_words(Tokens, NewTokens) :-
 1878  findall(Token,
 1879          ( member(Token, Tokens),
 1880            \+ member(Token, ['please','the','a','an'])),
 1881          NewTokens).
 1882
 1883convert_reflexive(Agent, Words, NewWords) :-
 1884  % Substitute Agent for 'self'.
 1885  findall(Token,
 1886          ( member(Word, Words),
 1887            ( reflexive(Word), Token = Agent;
 1888              Token = Word )),
 1889          NewWords).
 1890
 1891% -- parse(WordList, ActionOrQuery, Memory)
 1892parse(Tokens, Action, Memory) :-
 1893  strip_noise_words(Tokens, Tokens2),
 1894  parse2logical(Tokens2, Action, Memory).
 1895
 1896parse2logical([ask, Object | Msg], talk(Object,Msg), _M).
 1897parse2logical([request, Object | Msg], talk(Object,Msg), _M).
 1898parse2logical([tell, Object | Msg], talk(Object,Msg), _M).
 1899parse2logical([talk, Object | Msg], talk(Object,Msg), _M).
 1900parse2logical([say|Msg], say(Msg), _M).
 1901parse2logical([Object, ',' | Msg], talk(Object, Msg), Mem) :-
 1902  thought(model(Model), Mem),
 1903  member(related(_,Object,_,_), Model).
 1904parse2logical(Words, Action, Mem) :-
 1905  % If not talking to someone else, substitute Agent for 'self'.
 1906  append(Before,[Self|After],Words),
 1907  reflexive(Self),
 1908  thought(agent(Agent), Mem),
 1909  append(Before,[Agent|After],NewWords),
 1910  parse2logical(NewWords,Action,Mem).
 1911parse2logical([dig, Hole], dig(Hole,Where,Tool), Mem) :-
 1912  thought(model(Model),Mem),
 1913  thought(agent(Agent), Mem),
 1914  member(related(_,Agent,Where,_), Model),
 1915  Tool=shovel.
 1916parse2logical([get, Prep], go(*,Prep), _Mem) :-
 1917  preposition(Prep).
 1918parse2logical([get, Prep, Object], go(Prep, Object), _Mem) :-
 1919  preposition(Prep).
 1920parse2logical([get, Object], take(Object), _Mem).
 1921parse2logical([give, Object, to, Recipient], give(Object,Recipient), _Mem).
 1922parse2logical([go, escape], go(*,escape), _Mem).
 1923parse2logical([go, Dir], go(*, Dir), _Mem) :-
 1924  compass_direction(Dir).
 1925parse2logical([go, Prep], go(*,Prep), _Mem) :-
 1926  preposition(Prep).
 1927parse2logical([go, ExitName], go(*,ExitName), Mem) :-
 1928  thought(model(Model),Mem),
 1929  member(related(exit(ExitName),_,_,_), Model).
 1930parse2logical([go, Dest], go(*,Dest), Mem) :-
 1931  thought(model(Model),Mem),
 1932  member(related(_,_,Dest,_), Model).
 1933  % getprop(Dest, relatable(How), Model).
 1934parse2logical([light,Thing], switch(on, Thing), _Mem).
 1935parse2logical([switch, Thing, OnOff], switch(OnOff, Thing), _Mem) :-
 1936  preposition(OnOff).
 1937parse2logical([switch, OnOff, Thing], switch(OnOff, Thing), _Mem) :-
 1938  preposition(OnOff).
 1939parse2logical([turn, Thing, OnOff], switch(OnOff, Thing), _Mem) :-
 1940  preposition(OnOff).
 1941parse2logical([turn, OnOff, Thing], switch(OnOff, Thing), _Mem) :-
 1942  preposition(OnOff).
 1943parse2logical([what, is, Thing], whatis(Thing), _M).
 1944parse2logical([whereami], whereis(Agent), Mem) :-
 1945  thought(agent(Agent), Mem).
 1946parse2logical([where,am,i], whereis(Agent), Mem) :-
 1947  thought(agent(Agent), Mem).
 1948parse2logical([where, is, Thing], whereis(Thing), _M).
 1949parse2logical([whoami], whois(Agent), Mem) :-
 1950  thought(agent(Agent), Mem).
 1951parse2logical([who,am,i], whois(Agent), Mem) :-
 1952  thought(agent(Agent), Mem).
 1953parse2logical([model], model(Agent), Mem) :-
 1954  thought(agent(Agent), Mem).
 1955parse2logical([memory], memory(Agent), Mem) :-
 1956  thought(agent(Agent), Mem).
 1957parse2logical([CmdAlias|Tail], Action, Mem) :-
 1958  cmdalias(CmdAlias, Verb),
 1959  parse2logical([Verb|Tail], Action, Mem).
 1960parse2logical([escape], go(*,escape), _Mem).
 1961parse2logical([Dir], go(*,Dir), _Mem) :-
 1962  compass_direction(Dir).
 1963parse2logical([Prep], go(*,Prep), _Mem) :-
 1964  preposition(Prep).
 1965parse2logical([ExitName], go(*,ExitName), Mem) :-
 1966  thought(model(Model),Mem),
 1967  member(related(exit(ExitName),_,_,_), Model).
 1968parse2logical([Verb|Args], Action, _M) :-
 1969  %member(Verb,[agent,create,delprop,destroy,echo,quit,memory,model,path,properties,setprop,state,trace,notrace,whereami,whereis,whoami]),
 1970  Action =.. [Verb|Args].
 1971
 1972% do_introspect(Query, Answer, Memory)
 1973do_introspect(path(There), Answer, Memory) :-
 1974  thought(agent(Agent), Memory),
 1975  thought(model(Model), Memory),
 1976  member(related(_How, Agent, Here, _T), Model),
 1977  find_path(Here,There,Route,Model),
 1978  Answer = ['Model is',Model,'\nShortest path is',Route].
 1979do_introspect(whereis(Thing), Answer, Memory) :-
 1980  thought(agent(Agent), Memory),
 1981  thought(model(Model), Memory),
 1982  member(related(How, Thing, Where, T), Model),
 1983  How \= exit(_),
 1984  Answer = ['At time',T,subj(Agent),'saw the',Thing,How,the,Where,.].
 1985do_introspect(whereis(Here), Answer, Memory) :-
 1986  thought(agent(Agent), Memory),
 1987  thought(model(Model), Memory),
 1988  member(related(_How, Agent, Here, _T), Model),
 1989  Answer = 'Right here.'.
 1990do_introspect(whereis(There), Answer, Memory) :-
 1991  thought(agent(Agent), Memory),
 1992  thought(model(Model), Memory),
 1993  member(related(_How, Agent, Here, _T), Model),
 1994  find_path(Here,There,Route,Model),
 1995  Answer = ['To get to the',There,',',Route].
 1996do_introspect(whereis(There), Answer, Memory) :-
 1997  thought(model(Model), Memory),
 1998  ( member(related(exit(_), _, There, _T), Model);
 1999    member(related(exit(_), There, _, _T), Model)),
 2000  Answer = 'Can''t get there from here.'.
 2001do_introspect(whereis(X), Answer, Memory) :-
 2002  thought(agent(Agent), Memory),
 2003  Answer = [subj(Agent),person('don\'t','doesn\'t'),
 2004            'recall ever seeing a "',X,'".'].
 2005do_introspect(whois(X), Answer, Memory) :-
 2006  do_introspect(whereis(X), Answer, Memory).
 2007do_introspect(whois(X), [X,is,X,.], _Memory).
 2008do_introspect(whatis(X), Answer, Memory) :-
 2009  do_introspect(whereis(X), Answer, Memory).
 2010do_introspect(whatis(X), [X,is,X,.], _Memory).
 2011
 2012save_term(Filename, Term) :-
 2013  \+ access_file(Filename, exist),
 2014  open(Filename,write,FH),
 2015  write(FH, Term),
 2016  close(FH),
 2017  format('Saved to file "~w".~n',[Filename]).
 2018save_term(Filename, _) :-
 2019  access_file(Filename, exist),
 2020  format('Save FAILED! Does file "~w" already exist?~n',[Filename]).
 2021save_term(Filename, _) :-
 2022  format('Failed to open file "~w" for saving.~n',[Filename]).
 2023
 2024% do_metacmd(Action, S0, S1)
 2025do_metacmd(quit, S0, S1) :-
 2026  declare(quit, S0, S1),
 2027  format('Bye!~n', []).
 2028do_metacmd(trace, S0, S0) :- admin, trace.
 2029do_metacmd(notrace, S0, S0) :- admin, notrace.
 2030do_metacmd(spy(Pred), S0, S0) :- admin, spy(Pred).
 2031do_metacmd(nospy(Pred), S0, S0) :- admin, nospy(Pred).
 2032do_metacmd(agent(NewAgent), S0, S0) :-
 2033  wizard,
 2034  retract(useragent(_Agent)),
 2035  asserta(useragent(NewAgent)).
 2036do_metacmd(Echo, S0, S0) :-
 2037  admin,
 2038  Echo =.. [echo|Args],
 2039  format('~w~n',[Args]).
 2040do_metacmd(state, S0, S0) :-
 2041  wizard,
 2042  pprint(S0,general).
 2043do_metacmd(memory(Agent), S0, S0) :-
 2044  wizard,
 2045  declared(memories(Agent,Memory), S0),
 2046  pprint(Memory,general).
 2047do_metacmd(model(Agent), S0, S0) :-
 2048  wizard,
 2049  declared(memories(Agent,Memory), S0),
 2050  thought(model(Model), Memory),
 2051  pprint(Model,general).
 2052do_metacmd(create(Object), S0, S1) :-
 2053  wizard,
 2054  useragent(Agent),
 2055  related(How, Agent, Here, S0),
 2056  declare(related(How, Object, Here), S0, S1),
 2057  format('You now see a ~w.~n',[Object]).
 2058do_metacmd(destroy(Object), S0, S1) :-
 2059  wizard,
 2060  undeclare(related(_, Object, _), S0, S1),
 2061  format('It vanishes instantly.~n',[]).
 2062do_metacmd(AddProp, S0, S1) :-
 2063  wizard,
 2064  AddProp =.. [setprop, Object | Args],
 2065  Args \= [],
 2066  Prop =.. Args,
 2067  setprop(Object, Prop, S0, S1),
 2068  format('Properties of ~p now include ~w~n', [Object,Prop]).
 2069do_metacmd(DelProp, S0, S1) :-
 2070  wizard,
 2071  DelProp =.. [delprop, Object | Args],
 2072  Args \= [],
 2073  Prop =.. Args,
 2074  delprop(Object, Prop, S0, S1),
 2075  format('Deleted.~n', []).
 2076do_metacmd(properties(Object), S0, S0) :-
 2077  wizard,
 2078  declared(props(Object, PropList), S0),
 2079  format('Properties of ~p are now ~w~n', [Object,PropList]).
 2080do_metacmd(undo, S0, S1) :-
 2081  declare(undo, S0, S1),
 2082  format('undo...OK~nKO...odnu~n',[]).
 2083do_metacmd(save(Basename), S0, S0) :-
 2084  atom_concat(Basename, '.adv', Filename),
 2085  save_term(Filename, S0).
 2086
 2087do_command(_Agent, Action, S0, S1) :-
 2088  do_metacmd(Action, S0, S1).
 2089do_command(Agent, Action, S0, S1) :-
 2090  declared(memories(Agent,Mem), S0),
 2091  do_introspect(Action, Answer, Mem),
 2092  queue_percept(Agent, [answer(Answer), Answer], S0, S1).
 2093  %format('~w~n', [Answer]).
 2094do_command(Agent, Action, S0, S3) :-
 2095  undeclare(memories(Agent,Mem0), S0, S1),
 2096  memorize(did(Action), Mem0, Mem1),
 2097  declare(memories(Agent,Mem1), S1, S2),
 2098  act(Agent, Action, S2, S3).
 2099do_command(_Agent, Action, S0, S0) :-
 2100  format('Failed or No Such Command: ~w~n', Action), !.
 2101
 2102% --------
 2103
 2104do_todo(Agent, S0, S9) :-
 2105  undeclare(memories(Agent, Mem0), S0, S1),
 2106  forget(todo(OldToDo), Mem0, Mem1),
 2107  append([Action],NewToDo,OldToDo),
 2108  memorize(todo(NewToDo), Mem1, Mem2),
 2109  declare(memories(Agent, Mem2), S1, S2),
 2110  do_command(Agent, Action, S2, S9).
 2111do_todo(_Agent, S0, S0).
 2112
 2113%do_todo_while(Agent, S0, S9) :-
 2114%  declared(memories(Agent, Mem0), S0),
 2115%  thought(todo(ToDo), Mem0),
 2116%  append([Action],NewToDo,OldToDo),
 2117
 2118extra_look_around(Agent, S0, S9) :-
 2119  undeclare(memories(Agent, Mem0), S0, S1),
 2120  memorize_list([did(look),did(inventory)], Mem0, Mem1),
 2121  declare(memories(Agent, Mem1), S1, S2),
 2122  act(Agent, look,      S2, S3),
 2123  act(Agent, inventory, S3, S9).
 2124
 2125random_noise(Agent, [cap(subj(Agent)),Msg]) :-
 2126  random_member([
 2127    'hums quietly to himself.',
 2128    'checks his inspection cover.',
 2129    'buffs his chestplate.',
 2130    'fidgets uncomfortably.'
 2131    ], Msg).
 2132
 2133autonomous_decide_action(Agent, Mem0, Mem0) :-
 2134  % If actions are queued, no further thinking required.
 2135  thought(todo([Action|_]), Mem0),
 2136  bugout('~w: about to: ~w~n',[Agent,Action],autonomous).
 2137autonomous_decide_action(Agent, Mem0, Mem1) :-
 2138  % If goals exist, try to solve them.
 2139  thought(goals([_|_]), Mem0),
 2140  bugout('~w: goals exist: generating a plan...~n', [Agent], autonomous),
 2141  generate_plan(NewPlan, Mem0), !,
 2142  serialize_plan(NewPlan, Actions), !,
 2143  bugout('Planned actions are ~w~n', [Actions], autonomous),
 2144  Actions = [Action|_],
 2145  add_todo(Action, Mem0, Mem1).
 2146autonomous_decide_action(Agent, Mem0, Mem2) :-
 2147  forget(goals([_|_]), Mem0, Mem1),
 2148  memorize(goals([]), Mem1, Mem2),
 2149  bugout('~w: Can\'t solve goals.  Forgetting them.~n', [Agent], autonomous).
 2150autonomous_decide_action(Agent, Mem0, Mem1) :-
 2151  % If no actions or goals, but there's an unexplored exit here, go that way.
 2152  thought(model(Model), Mem0),
 2153  member(related(_How, Agent, Here, _), Model),
 2154  member(related(exit(ExitName), Here, '<unexplored>', _), Model),
 2155  add_todo(go(*,ExitName), Mem0, Mem1).
 2156autonomous_decide_action(Agent, Mem0, Mem1) :-
 2157  % Follow player to adjacent rooms.
 2158  thought(model(Model), Mem0),
 2159  member(related(_, Agent, Here, _), Model),
 2160  member(related(_, player, There, _), Model),
 2161  member(related(exit(ExitName), Here, There, _), Model),
 2162  add_todo(go(*,ExitName), Mem0, Mem1).
 2163autonomous_decide_action(Agent, Mem0, Mem1) :-
 2164  0 is random(5),
 2165  random_noise(Agent, Msg),
 2166  add_todo(print_(Msg), Mem0, Mem1).
 2167autonomous_decide_action(Agent, Mem0, Mem0) :-
 2168  bugout('~w: Can\'t think of anything to do.~n', [Agent], autonomous).% trace.
 2169
 2170decide_action(Agent, Mem0, Mem1) :-
 2171  thought(agent_type(console), Mem0),
 2172  thought(timestamp(T0), Mem0),
 2173  repeat,
 2174    format('[~p: ~p] ==> ', [T0, Agent]),
 2175    readtokens(Words),
 2176    parse(Words, Action, Mem0),
 2177    !,
 2178  (Action =.. Words; format('~w~n',[Action])),
 2179  add_todo(Action, Mem0, Mem1).
 2180decide_action(Agent, Mem0, Mem3) :-
 2181  thought(agent_type(autonomous), Mem0),
 2182  forget(goals(Goals), Mem0, Mem1),
 2183  thought(model(Model), Mem1),
 2184  select_unsatisfied_conditions(Goals, Unsatisfied, Model),
 2185  memorize(goals(Unsatisfied), Mem1, Mem2),
 2186  autonomous_decide_action(Agent, Mem2, Mem3).
 2187decide_action(_Agent, Mem, Mem) :-
 2188  thought(agent_type(recorder), Mem).  % recorders don't decide much.
 2189decide_action(Agent, Mem0, Mem0) :-
 2190  bugout('decide_action(~w) FAILED!~n',[Agent],general).
 2191
 2192run_agent(Agent, S0, S) :-
 2193  undeclare(memories(Agent, Mem0), S0, S1),
 2194  undeclare(perceptq(Agent, PerceptQ), S1, S2),
 2195  thought(timestamp(T0), Mem0),
 2196  T1 is T0 + 1,
 2197  memorize(timestamp(T1), Mem0, Mem1),
 2198  process_percept_list(Agent, PerceptQ, T1, Mem1, Mem2),
 2199  memorize_list(PerceptQ, Mem2, Mem3),
 2200  decide_action(Agent, Mem3, Mem4),
 2201  declare(memories(Agent, Mem4), S2, S3),
 2202  declare(perceptq(Agent, []), S3, S4),
 2203  do_todo(Agent, S4, S).
 2204run_agent(Agent, S0, S0) :-
 2205  bugout('run_agent(~w) FAILED!~n',[Agent],general).
 2206
 2207check4bugs(_S0) :-
 2208  !, true.
 2209check4bugs(S0) :-
 2210  % TODO: emergency save of S0, either here or better yet, in a catch().
 2211  throw(check4bugs_failed(S0)).
 2212
 2213% --------
 2214
 2215:- dynamic(undo/1). 2216undo([u,u,u,u,u,u,u,u]).
 2217:- dynamic(advstate/1). 2218%advstate([]).
 2219
 2220run_all_agents([], S0, S0).
 2221run_all_agents([Agent|AgentTail], S0, S2) :-
 2222  run_agent(Agent, S0, S1),
 2223  !, % Don't allow future failure to redo successful agents.
 2224  run_all_agents(AgentTail, S1, S2).
 2225
 2226create_agents([], S0, S0).
 2227create_agents([agentspec(Agent,Type)|Tail], S0, S2) :-
 2228  create_agent(Agent, Type, S0, S1),
 2229  create_agents(Tail, S1, S2).
 2230
 2231init_agents(S0, S2) :-
 2232  findall(agentspec(Agent,Type),
 2233          getprop(Agent, agent_type(Type), S0),
 2234          AgentList),
 2235  create_agents(AgentList, S0, S2).
 2236
 2237main(S0, S2) :-
 2238  findall(Agent1, getprop(Agent1, agent_type(console), S0), AgentList1),
 2239  findall(Agent2, 
 2240          ( getprop(Agent2, agent_type(autonomous), S0),
 2241            ( getprop(Agent2,switchable,S0) -> getprop(Agent2,on,S0) ; true )
 2242          ), AgentList2),
 2243  append(AgentList1, AgentList2, AllAgents),
 2244  run_all_agents(AllAgents, S0, S2),
 2245  !. % Don't allow future failure to redo main.
 2246main(S0, S0) :-
 2247  bugout('main FAILED~n', general).
 2248
 2249mainloop :-
 2250  repeat,
 2251    retract(advstate(S0)),
 2252    main(S0,S1),
 2253    asserta(advstate(S1)),
 2254    check4bugs(S1),
 2255    declared(quit, S1),
 2256  !. % Don't allow future failure to redo mainloop.
 2257
 2258% TODO: try converting this to a true "repeat" loop.
 2259main_loop(State) :-
 2260  declared(quit, State).
 2261main_loop(State) :-
 2262  declared(undo, State),
 2263  retract(undo([_,Prev|Tail])),
 2264  assertz(undo(Tail)),
 2265  !,
 2266  main_loop(Prev).
 2267main_loop(S0) :-
 2268  %repeat,
 2269  retract(undo([U1,U2,U3,U4,U5,U6|_])),
 2270  assertz(undo([S0,U1,U2,U3,U4,U5,U6])),
 2271  run_agent(player, S0, S4),
 2272  run_agent(floyd, S4, S5),
 2273  %user_interact(S3, S4), !,
 2274  %automate_agent(floyd, S4, S5),
 2275  !,
 2276  main_loop(S5).
 2277main_loop(_) :-
 2278  bugout('main_loop() FAILED!~n',general).
 2279
 2280init_logging :-
 2281  get_time(StartTime),
 2282  convert_time(StartTime, StartTimeString),
 2283  open('input.log',append,FH),
 2284  format(FH, '\n==== ADVENTURE INPUT, ~w\n', [StartTimeString]),
 2285  asserta(input_log(FH)).
 2286
 2287adventure :-
 2288  guitracer,
 2289  test_ordering,
 2290  init_logging,
 2291  (retractall(advstate(_));true),
 2292  istate(S0),
 2293  init_agents(S0, S1),
 2294  act(player,look,S1,S2),
 2295  act(floyd,look,S2,S3),
 2296  asserta(advstate(S3)),
 2297  format('=============================================~n',[]),
 2298  format('Welcome to Marty\'s Prolog Adventure Prototype~n', []),
 2299  format('=============================================~n',[]),
 2300  mainloop,
 2301  %main_loop(S3),
 2302  input_log(FH),
 2303  close(FH),
 2304  notrace.
 2305adventure :-
 2306  input_log(FH),
 2307  close(FH),
 2308  format('adventure FAILED~n',[]),
 2309  !, fail.
 2310
 2311:- debug. 2312:- initialization(adventure).