2
3
4
8
9security_of(_Agent, admin) :- true. 10security_of(_Agent, wizard) :- true. 11
.
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
31
32:- op(900, xfx, props). 33:- op(300, fx, ~). 34
35
36istate([
37 38
39 related(exit(south), pantry, 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), 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 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), 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 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), 95 mass(50), 96 can_eat
97 ]),
98
99 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 112 goto(Agent, walk, up, 'You lack the ability to fly.'),
113 effect(goto(Agent, walk, _, north), getprop(screendoor, open)),
114 oper(goto(Agent, walk, _, north),
115 116 precond(getprop(screendoor, open), ['you must open the door first']),
117 118 body(inherited)
119 ),
120 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 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 152 closed(true),
153 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 175 nouns(light),
176 nominals(brass),
177 adjs(dented),
178 can_be(switched(OnOff), t)
179 180 181 ],
182 mushroom props [
183 184 name('speckled mushroom'),
185 singular,
186 nouns([mushroom, fungus, toadstool]),
187 adjs([speckled]),
188 189 initial('A speckled mushroom grows out of the sodden earth, on a long stalk.'),
190 191 desc('The mushroom is capped with blotches, and you aren\'t at all sure it\'s not a toadstool.'),
192 edible,
193 194 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 202 door_to(garden),
203 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
261
264create_agent(Agent, AgentType, S0, S2) :-
265 266 267 declare(perceptq(Agent, []), S0, S1),
268 269 declare(memories(Agent, [
270 timestamp(0),
271 model([]),
272 goals([]),
273 todo([]),
274 agent(Agent),
275 agent_type(AgentType)
276 ]), S1, S2).
277
291
293select_always(Item, List, ListWithoutItem) :-
294 select(Item, List, ListWithoutItem),
295 !.
296select_always(_Item, ListWithoutItem, ListWithoutItem).
297
302
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
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
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
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
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
362
396
397capitalize([First|Rest], [Capped|Rest]) :-
398 capitalize(First, Capped).
399capitalize(Atom, Capitalized) :-
400 atom(Atom), 401 downcase_atom(Atom, Lower),
402 atom_chars(Lower, [First|Rest]),
403 upcase_atom(First, Upper),
404 atom_chars(Capitalized, [Upper|Rest]).
405
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 473 findall(subj(Subject), call(findterm(subj(Subject), Eng)), Context),
474 475 maplist(compile_eng([agent(Agent), person(Person)|Context]), Eng, Compiled),
476 477 flatten(Compiled, FlatList),
478 479 findall(Atom, (member(Term, FlatList), make_atomic(Term, Atom)), AtomList),
480 findall(Atom2, (member(Atom2, AtomList), Atom2\=''), AtomList2),
481 482 bugout('insert_spaces(~w)~n', [AtomList2], printer),
483 insert_spaces(AtomList2, SpacedList),
484 485 concat_atom(SpacedList, Text).
486eng2txt(_Agent, _Person, Text, Text).
487
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
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).
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), 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
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
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 788 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
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 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 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 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.
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).
874cmd_workarround_l([Verb, Relation|ObjS], [Verb|ObjS]):- is_ignorable(Relation), !.
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 900 901 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 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 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) :- 927 related(child, Agent, Here, S0),
928 related(exit(ExitName), Here, There, S0),
929 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) :- 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) :- 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) :- 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
979
980act( take(Agent, Thing), S0, S1) :-
981 open_traverse(Agent, Here, S0), 982 moveto(Thing, held_by, Agent, [Here],
983 [silent(subj(Agent)), person('Taken.', [cap(Agent), 'grabs the', Thing, '.'])],
984 S0, S1).
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), 996 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 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 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 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 1058 1059 delprop(Thing, closed(true), S0, S1),
1060 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 1067 1068 delprop(Thing, closed(fail), S0, S1),
1069 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) :- 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) :- 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
1100
1118
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).
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
1133
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
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
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
1165
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 1181 findall(exit(E), member(E, Exits), ExitRelations),
1182 update_exits(ExitRelations, Here, Timestamp, M0, M4). 1183update_model(Agent, moved(Agent, There, At, Here), Timestamp, Mem, M0, M2) :-
1184 1185 in_model(holds_at(t(_, Agent, There), _T0), M0),
1186 1187 1188 append(RecentMem, [did(goto(Agent, walk, _AtGo, ExitName))|OlderMem], Mem), 1189 \+ member(did(goto(Agent, walk, _, _)), RecentMem), 1190 memberchk(timestamp(_T1), OlderMem), 1191 1192 1193 update_exit(exit(ExitName), There, Here, Timestamp, M0, M1), 1194 update_relation(At, Agent, Here, Timestamp, M1, M2). 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
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
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
1244oper_act( goto(Agent, walk, *, ExitName),
1245 [ Here \= Agent, There \= Agent,
1246 related(in, Agent, Here),
1247 related(exit(ExitName), Here, There)], 1248 [ related(in, Agent, There),
1249 ~related(in, Agent, Here)]).
1250oper_act( take(Agent, Thing), 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), 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), 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)] ).
1299
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 1308 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
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).
1334
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
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
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
1439step_is_achieved(step(_J, oper( _, [], _)), _Plan). 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
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
1459operators_as_steps([], []).
1460operators_as_steps([Oper | OpTail], [Step | StepTail]) :-
1461 copy_term(Oper, FreshOper), 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
1480protect(causes(StepI, _Cond0, _StepJ), StepI, _Cond1, Order0, Order0) :-
1481 !. 1482protect(causes(_StepI, _Cond0, StepJ), StepJ, _Cond1, Order0, Order0) :-
1483 !. 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 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
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
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
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
1528add_binding((X\=Y), Bindings, [(X\=Y)|Bindings]) :-
1529 X \== Y, 1530 1531 bindings_valid(Bindings).
1532
1533bindings_valid([]).
1534bindings_valid([(X\=Y)|Bindings]) :-
1535 X \== Y,
1536 bindings_valid(Bindings).
1540
1541bindings_safe([]) :- bugout(' BINDINGS are SAFE~n', planner).
1542bindings_safe([(X\=Y)|Bindings]) :-
1543 X \= Y,
1544 bindings_safe(Bindings).
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 1555 member(step(StepID, oper( _Action, _Preconds, Effects)), Steps),
1556 precondition_matches_effects(GoalCond, Effects),
1557 add_ordering(before(StepID, GoalID), Order0, Order1),
1558 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 1576 memberchk(step(start, oper( _Action, _Preconds, Effects)), Steps),
1577 \+ precondition_matches_effects(GoalCond, Effects),
1578 add_ordering(before(start, GoalID), Order0, Order1),
1579 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 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 1604 Depth0 > 0,
1605 Depth is Depth0 - 1,
1606 1607 copy_term(Operators, FreshOperators),
1608 1609 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 1615 add_orderings([before(start, StepID),
1616 before(StepID, GoalID),
1617 before(StepID, finish)],
1618 Order0, Order1),
1619 1620 protect_links(OldLinks, StepID, Effects, Order1, Order2),
1621 1622 protect_link_all(causes(StepID, GoalCond, GoalID), OldSteps, Order2, Order9),
1623 1624 append(OldSteps, [step(StepID, oper( Action, Preconds, Effects))], NewSteps),
1625 1626 union([causes(StepID, GoalCond, GoalID)], OldLinks, NewLinks),
1627 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 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 1653 planning_loop(Goals1, Operators, Plan1, Plan2, Depth, Timeout).
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 1709 thought(Agent, goals(Goals), Mem0),
1710 new_plan(Model0, Goals, SeedPlan),
1711 bugout('SEED PLAN is:~n', planner), pprint(SeedPlan, planner),
1712 !,
1713 1714 conds_as_goals(finish, Goals, PlannerGoals),
1715 get_time(Now),
1716 Timeout is Now + 60, 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
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 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
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 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 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
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), 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 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
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 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
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]). 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 1883 findall(Token,
1884 ( member(Word, Words),
1885 ( reflexive(Word), Token = Agent;
1886 Token = Word )),
1887 NewWords).
1888
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 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 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 1981 Action =.. [Verb|Args].
1982
1983rest_maybe_thing(_Agent, [Thing], Thing, _Mem):- !.
1984rest_maybe_thing(Agent, _, Agent, _Mem):- !.
1985
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
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
2043meta_pprint(_Doer, D,K):- pprint(D,K).
2044
2045maybe_pause(_).
2046
2047:- dynamic(adv:useragent/2). 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 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
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
2174
(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
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
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 2225 thought(Agent, todo([Action|_]), Mem0),
2226 bugout('~w: about to: ~w~n', [Agent, Action], autonomous).
2227autonomous_decide_action(Agent, Mem0, Mem1) :-
2228 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 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 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 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). 2260
2261
2262
2263console_decide_action(Agent, Mem0, Mem1):-
2264 2265 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
2308decide_action(Agent, Mem0, Mem1) :-
2309 notrace(declared(inherits(telnet), Mem0)),!,
2310 dmust(telnet_decide_action(Agent, Mem0, Mem1)).
2311
2313decide_action(Agent, Mem0, Mem1) :-
2314 thought(Agent, agent_type(console), Mem0),
2315 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). 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
2347
2348:- dynamic(undo/1). 2349undo([u, u, u, u, u, u, u, u]).
2350:- dynamic(advstate/1). 2352
2353run_all_agents([], S0, S0).
2354run_all_agents([Agent|AgentTail], S0, S2) :-
2355 run_agent(Agent, S0, S1),
2356 !, 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 !. 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 !. 2390
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 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 2407 2408 !,
2409 main_loop(S5).
2410main_loop(_) :-
2411 bugout('main_loop() FAILED!~n', general).
2412
2421add_look(_Agent, S1, S1).
2422
2423adventure :-
2424 2425 test_ordering,
2426 init_logging,
2427 (retractall(advstate(_));true),
2428 istate(S0),
2429 init_agents(S0, S1),
2430 2431 2432 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 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. 2452:- list_undefined([]).