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