1/*
    2% NomicMUD: A MUD server written in Prolog
    3%
    4% Some parts used Inform7, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    5% 
    6% July 10,1996 - John Eikenberry 
    7% Copyright (C) 2004 Marty White under the GNU GPL
    8% 
    9% Dec 13, 2035 - Douglas Miles
   10%
   11%
   12% Logicmoo Project changes:
   13%
   14% Main file.
   15%
   16*/
   17
   18% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   19% CODE FILE SECTION
   20%:- bugout1(ensure_loaded('adv_robot_floyd')).
   21% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   22
   23random_noise(Agent, [cap(subj(Agent)), Msg]) :- fail, 
   24 random_member(Msg, [
   25 'hums quietly to themself.',
   26 'inspects their inspection cover.',
   27 'buffs their chestplate.',
   28 'fidgets uncomfortably.'
   29 ]).
   30
   31:- dynamic(adv:agent_last_action/3).   32 
   33
   34do_autonomous_cycle(Agent):- time_since_last_action(Agent,When), When > 10, !.
   35do_autonomous_cycle(Agent):- 
   36 time_since_last_action(Other,When),
   37 Other \== Agent, When < 1, !, 
   38 retractall(adv:agent_last_action(Other,_,_)),
   39 nop(bugout1(time_since_last_action_for(Other,When,Agent))).
   40
   41
   42% If actions are queued, no further thinking required. 
   43maybe_autonomous_decide_goal_action(Agent, Mem0, Mem2):- 
   44  has_satisfied_goals(Agent, Mem0, Mem1), !,
   45  maybe_autonomous_decide_goal_action(Agent, Mem1, Mem2).
   46% Is powered down
   47maybe_autonomous_decide_goal_action(Agent, Mem0, Mem0) :- 
   48 get_advstate(State),getprop(Agent, (powered = f), State),!.
   49% is not yet time to do something
   50maybe_autonomous_decide_goal_action(Agent, Mem0, Mem0) :- 
   51 notrace( \+ do_autonomous_cycle(Agent)), !.
   52% try to run the auto(Agent) command
   53maybe_autonomous_decide_goal_action(Agent, Mem0, Mem1) :- 
   54 add_todo(auto(Agent), Mem0, Mem1).
   55
   56
   57
   58% If actions are queued, no further thinking required. 
   59autonomous_decide_action(Agent, Mem0, Mem2):- 
   60  has_satisfied_goals(Agent, Mem0, Mem1), !,
   61  autonomous_decide_action(Agent, Mem1, Mem2).
   62
   63% If actions are queued, no further thinking required. 
   64autonomous_decide_action(Agent, Mem0, Mem0) :- 
   65 thought(todo([Action|_]), Mem0),
   66 (declared_advstate(h(in, Agent, Here))->true;Here=somewhere),
   67 (trival_act(Action)->true;bugout3('~w @ ~w: already about todo: ~w~n', [Agent, Here, Action], autonomous)).
   68
   69% notices bugs
   70autonomous_decide_action(Agent, Mem0, _) :-
   71 once((agent_thought_model(Agent,ModelData, Mem0),
   72 (\+ in_agent_model(Agent, h(_, Agent, _), ModelData) -> (pprint(Mem0, always),pprint(ModelData, always)) ; true),
   73 must_det(in_agent_model(Agent,h(_Prep, Agent, Here), ModelData)),
   74 nonvar(Here))), 
   75 fail.
   76
   77% If goals exist, try to solve them.
   78autonomous_decide_action(Agent, Mem0, Mem1) :-
   79 thought(goals([_|_]), Mem0),
   80 action_handle_goals(Agent, Mem0, Mem1),!.
   81autonomous_decide_action(Agent, Mem0, Mem1) :- 
   82 once(autonomous_create_new_goal(Agent, Mem0, Mem1);
   83% If no actions or goals, but there's an unexplored exit here, go that way.
   84 autonomous_decide_unexplored_exit(Agent, Mem0, Mem1);
   85 autonomous_decide_unexplored_object(Agent, Mem0, Mem1);
   86 autonomous_decide_follow_player(Agent, Mem0, Mem1);
   87 autonomous_decide_silly_emoter_action(Agent, Mem0, Mem1)).
   88autonomous_decide_action(Agent, Mem0, Mem0) :-
   89 (declared_advstate(h(in, Agent, Here))->true;Here=somewhere),
   90 nop(bugout3('~w: Can\'t think of anything to do.~n', [Agent-Here], autonomous+verbose)).% trace.
   91
   92
   93autonomous_create_new_goal(_Agent, _Mem0, _Mem1) :- fail.
   94
   95% An unexplored exit here, go that way.
   96autonomous_decide_unexplored_exit(Agent, Mem0, Mem2) :-
   97 agent_thought_model(Agent,ModelData, Mem0),
   98 in_agent_model(Agent,h(exit(Prev), There, '<mystery>'(exit,_,_)), ModelData),
   99 in_agent_model(Agent,h(exit(Dir), Here, There), ModelData),
  100 in_agent_model(Agent,h(in, Agent, Here), ModelData),
  101 add_todo( go_dir(Agent, walk, Dir), Mem0, Mem1),
  102 add_todo( go_dir(Agent, walk, Prev), Mem1, Mem2).
  103autonomous_decide_unexplored_exit(Agent, Mem0, Mem1) :-
  104 agent_thought_model(Agent,ModelData, Mem0),
  105 in_agent_model(Agent,h(in, Agent, Here), ModelData),
  106 in_agent_model(Agent,h(exit(Dir), Here, '<mystery>'(exit,_,_)), ModelData),
  107 add_todo( go_dir(Agent, walk, Dir), Mem0, Mem1).
  108
  109% An unexplored object!
  110autonomous_decide_unexplored_object(Agent, Mem0, Mem2) :-
  111 agent_thought_model(Agent,ModelData, Mem0),
  112 in_agent_model(Agent,h(_, '<mystery>'(closed,_, _), Object), ModelData),
  113 in_agent_model(Agent,h(in, Object, Here), ModelData),
  114 in_agent_model(Agent,h(in, Agent, Here), ModelData),
  115 add_todo( open(Agent, Object), Mem0, Mem1),
  116 add_todo( examine(Agent, see, Object), Mem1, Mem2).
  117
  118autonomous_decide_unexplored_object(Agent, Mem0, Mem1) :- fail,
  119 agent_thought_model(Agent,ModelData, Mem0),
  120 in_agent_model(Agent,h(_, '<mystery>'(closed,_, _), Object), ModelData),
  121 add_todo( make_true(Agent, ~(h(_, Object, '<mystery>'(closed,_, _)))), Mem0, Mem1).
  122
  123
  124% Follow Player to adjacent rooms.
  125autonomous_decide_follow_player(Agent, Mem0, Mem1) :- % 1 is random(2),
  126 must_det((
  127 agent_thought_model(Agent,ModelData, Mem0),
  128 in_agent_model(Agent,h(_, Agent, Here), ModelData))),
  129 dif(Agent, Player), current_agent(Player),
  130 in_agent_model(Agent,h(_, Player, There), ModelData),
  131 in_agent_model(Agent,h(exit(Dir), Here, There), ModelData),
  132 add_todo(go_dir(Agent, walk, Dir), Mem0, Mem1).
  133
  134autonomous_decide_silly_emoter_action(Agent, Mem0, Mem1) :-
  135 0 is random(5),
  136 random_noise(Agent, Msg),
  137 add_todo(emote(Agent, act, *, Msg), Mem0, Mem1).
  138
  139
  140always_action(go_dir(_,_,_)).
  141
  142% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  143% CODE FILE SECTION
  144:- nop(ensure_loaded('adv_agent_listen')).  145% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  146
  147consider_text(Speaker, _EmoteType, Agent, Words, Mem0, Mem1):-
  148 parse_command(Agent, Words, Action, Mem0) -> 
  149 consider_request(Speaker, Agent, Action, Mem0, Mem1).
  150
  151% For now, agents will attempt to satisfy all commands.
  152consider_request(Requester, Agent, Action, _M0, _M1) :-
  153 bugout3('~w: considering request from: ~w.~n', [Requester, Agent, Action], autonomous),
  154 fail.
  155
  156consider_request(Requester, Agent, Query, M0, M1) :-
  157 do_introspect(Agent,Query, Answer, M0),
  158 %add_todo(print_(Answer), M0, M1).
  159 add_todo(emote(Agent, say, Requester, Answer), M0, M1).
  160
  161consider_request(_Speaker, Agent, forget(goals), M0, M2) :-
  162 bugout3('~w: forgetting goals.~n', [Agent], autonomous),
  163 forget_always(goals(_), M0, M1),
  164 memorize(goals([]), M1, M2).
  165% Bring object back to Speaker.
  166consider_request(Speaker, _Agent, fetch(Object), M0, M1) :- 
  167 add_goal(h(held_by, Object, Speaker), M0, M1).
  168consider_request(_Speaker, Agent, put(Agent, Thing, Relation, Where), M0, M) :-
  169 add_goal(h(Relation, Thing, Where), M0, M).
  170consider_request(_Speaker, Agent, take(Agent, Thing), M0, M) :-
  171 add_goal(h(held_by, Thing, Agent), M0, M).
  172consider_request(_Speaker, Agent, drop(Agent, Object), M0, M1) :-
  173 add_goal(~(h(held_by, Object, Agent)), M0, M1).
  174
  175consider_request(_Speaker, _Agent, AlwaysAction, M0, M1) :-  
  176 always_action(AlwaysAction),
  177 bugout3('Queueing action ~w~n', AlwaysAction, autonomous),
  178 add_todo(AlwaysAction, M0, M1).
  179
  180consider_request(_Speaker, Agent, Action, M0, M1) :-
  181 bugout3('Finding goals for action: ~w~n', [Action], autonomous),
  182 initial_operators(Agent, Operators),
  183 findall(Effects,
  184   member(oper(Agent, Action, _Conds, Effects), Operators),
  185   [UnambiguousGoals]),
  186 bugout3('Request: ~w --> goals ~w.~n', [Action, UnambiguousGoals], autonomous),
  187 add_goals(UnambiguousGoals, M0, M1).
  188
  189consider_request(_Speaker, _Agent, Action, M0, M1) :-
  190 bugout3('Queueing action: ~w~n', [Action], autonomous),
  191 add_todo(Action, M0, M1).
  192consider_request(_Speaker, Agent, Action, M0, M0) :-
  193 bugout3('~w: did not understand request: ~w~n', [Agent, Action], autonomous)