1/* -*- Mode:Prolog; coding:iso-8859-1; indent-tabs-mode:nil; prolog-indent-width:8; prolog-paren-indent:4; tab-width:8; -*- */
    2/*
    3% NomicMUD: A MUD server written in Prolog
    4% Maintainer: Douglas Miles
    5% Dec 13, 2035
    6%
    7% Bits and pieces:
    8%
    9% LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
   10% 
   11% Copyright (C) 2004 Marty White under the GNU GPL 
   12% Sept 20,1999 - Douglas Miles
   13% July 10,1996 - John Eikenberry 
   14%
   15% Logicmoo Project changes:
   16%
   17% Main file.
   18%
   19*/
   20
   21
   22each_live_agent(NewGoal, S0, S2) :-
   23 get_live_agents(List, S0),
   24 apply_mapl_state(NewGoal, List, S0, S2).
   25
   26each_sensing_thing(Sense, NewGoal, S0, S2) :-
   27 must_det((get_sensing_objects(Sense, List, S0),
   28  List\==[],
   29  %bugout1(each_sensing_thing(Sense)=(List=NewGoal)),
   30 apply_mapl_state(NewGoal, List, S0, S2))).
   31
   32each_agent(Precond, NewGoal, S0, S2) :-
   33 get_some_agents(Precond, List, S0),
   34 apply_mapl_state(NewGoal, List, S0, S2).
   35
   36
   37
   38% -----------------------------------------------------------------------------
   39% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   40% CODE FILE SECTION
   41:- nop(ensure_loaded('adv_agent_model')).   42% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   43
   44% Protocol:
   45% Agent: request(Action, Action_Id)
   46% Simulation: respond(Action_Id, LogicalResponse/Percept, EnglishResponse)
   47% Action(Verb, ...)
   48% failure(Reason)
   49% moved(agent, how, obj, from, prep)
   50
   51% -----------------------------------------------------------------------------
   52% The state of an Agent is stored in its memory.
   53% Agent memory is stored as a list in reverse chronological order, implicitly
   54% ordering and timestamping everything.
   55% Types of memories:
   56% inst(A)  - identity of agent (?)
   57% timestamp(T) - agent may add a new timestamp whenever a sequence point
   58%      is desired.
   59% [percept]  - received perceptions.
   60% model([...]) - Agent's internal model of the world.
   61%      Model is a collection of timestampped relations.
   62% goals([...]) - states the agent would like to achieve, or
   63%      acts the agent would like to be able to do.
   64% plan(S, O, B, L) - plans for achieving goals.
   65% affect(...)  - Agent's current affect.
   66% Multiple plans, goals, models, affects, etc. may be stored, for introspection
   67% about previous internal states.
   68
   69% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   70% CODE FILE SECTION
   71:- nop(ensure_loaded('adv_agent_goal')).   72% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   73
   74add_goal(Goal, Mem0, Mem2) :- is_list(Goal), !, apply_mapl_state(add_goal(), Goal, Mem0, Mem2).
   75add_goal(Goal, Mem0, Mem2) :-
   76 bugout3('adding goal ~w~n', [Goal], planner),
   77 forget(goals(OldGoals), Mem0, Mem1),
   78 append([Goal], OldGoals, NewGoals),
   79 memorize(goals(NewGoals), Mem1, Mem2).
   80
   81add_goals(Goals, Mem0, Mem2) :-
   82 forget(goals(OldGoals), Mem0, Mem1),
   83 append(Goals, OldGoals, NewGoals),
   84 memorize(goals(NewGoals), Mem1, Mem2).
   85
   86
   87add_todo(Auto, Mem0, Mem3) :- Auto = auto(Agent),
   88 %must_det(member(inst(Agent), Mem0)),
   89 autonomous_decide_action(Agent, Mem0, Mem3),!.
   90add_todo(Action, Mem0, Mem2) :- 
   91 forget(todo(OldToDo), Mem0, Mem1),
   92 append(OldToDo, [Action], NewToDo),
   93 memorize(todo(NewToDo), Mem1, Mem2).
   94
   95add_todo_all([], Mem0, Mem0).
   96add_todo_all([Action|Rest], Mem0, Mem2) :-
   97 add_todo(Action, Mem0, Mem1),
   98 add_todo_all(Rest, Mem1, Mem2).
   99
  100
  101 
  102% -----------------------------------------------------------------------------
  103% do_introspect(Agent, Query, Answer, Memory)
  104:- defn_state_getter(do_introspect(agent,action,result)).  105do_introspect(Agent, path(There), Answer, S0) :- !, 
  106   declared(h(_, _, There), S0),
  107   declared(h(_, Agent, Here), S0),
  108  do_introspect(Agent, path(Here, There), Answer, S0).
  109
  110do_introspect(Agent, path(Here, There), Answer, S0) :- !,
  111  declared(h(_, _, There), S0),
  112 do_introspect(Agent, path(Here, There), Answer, S0).
  113
  114do_introspect(Agent, path(Here, There), Answer, S0) :- 
  115 agent_thought_model(Agent, ModelData, S0),
  116 find_path(Here, There, Route, ModelData), !, 
  117 Answer = msg(['Model is:',Agent,'Shortest path is:\n', Route]).
  118
  119do_introspect(_Agent, path(Here, There), Answer, ModelData) :- 
  120 find_path(Here, There, Route, ModelData), !, 
  121 Answer = msg(['Model is:','State','Shortest path is\n:', Route]).
  122
  123do_introspect(Agent1, recall(Agent, WHQ, Target), Answer, S0) :- 
  124 agent_thought_model(Agent, ModelData, S0),
  125 recall_whereis(S0, Agent1, WHQ, Target, Answer, ModelData).
  126
  127do_introspect(Agent1, recall(Agent, Target), Answer, S0) :- !,
  128  do_introspect(Agent1, recall(Agent,what, Target), Answer, S0).
  129
  130recall_whereis(_S0,_Self,  _WHQ, There, Answer, ModelData) :-
  131 findall(Data, (member(Data,ModelData), nonvar_subterm(There, Data)), Memories),
  132 Memories\==[],
  133 Answer = Memories.
  134
  135recall_whereis(_S0,Agent,  _WHQ, There, Answer, _ModelData) :- 
  136 Answer = [subj(Agent), person('don\'t', 'doesn\'t'),
  137   'recall a "', There, '".'].
  138
  139
  140console_decide_action(Agent, Mem0, Mem1):- 
  141 %thought(timestamp(T0), Mem0),
  142 %bugout1(read_pending_codes(In,Codes,Found,Missing)),
  143 repeat,
  144 notrace((
  145 ttyflush,
  146 agent_to_input(Agent,In),
  147 must_det(is_stream(In)),
  148 setup_console,
  149 ensure_has_prompt(Agent),
  150 read_line_to_tokens(Agent, In,[], Words0), 
  151 (Words0==[]->(Words=[wait],makep);Words=Words0))),
  152 parse_command(Agent, Words, Action, Mem0),      
  153 !,
  154 if_tracing(bugout3('Console TODO ~p~n', [Agent: Words->Action], telnet)),
  155 add_todo(Action, Mem0, Mem1), ttyflush, !.
  156
  157makep:- 
  158 locally(set_prolog_flag(verbose_load,true),
  159 with_no_dmsg(make:((
  160  
  161  '$update_library_index',
  162 findall(File, make:modified_file(File), Reload0),
  163 list_to_set(Reload0, Reload),
  164 ( prolog:make_hook(before, Reload)
  165 -> true
  166 ; true
  167 ),
  168 print_message(silent, make(reload(Reload))),
  169 maplist(reload_file, Reload),
  170 print_message(silent, make(done(Reload))),
  171 ( prolog:make_hook(after, Reload)
  172 -> true
  173 ; nop(list_undefined),
  174  nop(list_void_declarations)
  175 ))))).
  176
  177
  178% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  179% CODE FILE SECTION
  180%:- bugout1(ensure_loaded('adv_agents')).
  181% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  182
  183decide_action(Agent, Mem0, Mem2):- 
  184  has_satisfied_goals(Agent, Mem0, Mem1), !,
  185  decide_action(Agent, Mem1, Mem2).
  186
  187decide_action(Agent, Mem0, Mem0) :- 
  188 thought(todo([Action|_]), Mem0),
  189 (declared(h(in, Agent, Here), advstate)->true;Here=somewhere),
  190 (trival_act(Action)->true;bugout3('~w @ ~w: already about todo: ~w~n', [Agent, Here, Action], autonomous)).
  191
  192% Telnet client
  193decide_action(Agent, Mem0, Mem1) :-
  194 notrace(declared(inherited(telnet), Mem0)),!,
  195 must_det(telnet_decide_action(Agent, Mem0, Mem1)).
  196
  197% Stdin Client
  198decide_action(Agent, Mem0, Mem1) :-
  199 notrace((declared(inherited(console), Mem0),current_input(In))),!, 
  200 agent_to_input(Agent,In),
  201 ensure_has_prompt(Agent),
  202 ttyflush,
  203 (tracing->catch(wait_for_input([In,user_input],Found,20),_,(nortrace,notrace,break));wait_for_input([In,user_input],Found,0)),
  204 (Found==[] -> (Mem0=Mem1) ;  quietly(((console_decide_action(Agent, Mem0, Mem1))))).
  205
  206decide_action(Agent, Mem0, Mem3) :-
  207 declared(inherited(autonomous), Mem0),
  208 maybe_autonomous_decide_goal_action(Agent, Mem0, Mem3).
  209
  210decide_action(_Agent, Mem, Mem) :-
  211 declared(inherited(memorize), Mem), !. % recorders don't decide much.
  212decide_action(Agent, Mem0, Mem0) :-
  213 set_last_action(Agent,[auto(Agent)]),
  214 nop(bugout3('decide_action(~w) FAILED!~n', [Agent], general)).
  215
  216
  217:- meta_predicate with_agent_console(*,0).  218/*
  219with_agent_console(Agent,Goal):- 
  220 adv:console_host_io_history_unused(Id,Alias,InStream,OutStream, Host, Peer, Agent),
  221 nop(adv:console_host_io_history_unused(Id,Alias,InStream,OutStream, Host, Peer, Agent)),
  222 current_input(WasIn),
  223 InStream\==WasIn,!,
  224 setup_call_cleanup(set_input(InStream),with_agent_console(Agent,Goal),set_input(WasIn)).
  225*/
  226with_agent_console(Agent,Goal):- 
  227 setup_call_cleanup(
  228  asserta(adv:current_agent_tl(Agent),E),
  229  Goal,erase(E)),!.
  230
  231run_agent_pass_1(Agent, S0, S) :-
  232 must_input_state(S0),
  233 with_agent_console(Agent,run_agent_pass_1_0(Agent, S0, S)),
  234 notrace(must_output_state(S)),!.
  235
  236
  237run_agent_pass_1_0(Agent, S0, S) :-
  238 undeclare(perceptq(Agent, PerceptQ), S0, S1), PerceptQ \== [],
  239 declare(perceptq(Agent, []), S1, S2),
  240 do_precept_list(Agent, PerceptQ, S2, S3),
  241 run_agent_pass_1_0(Agent, S3, S).
  242
  243run_agent_pass_1_0(Agent, S0, S) :- 
  244 undeclare(memories(Agent, Mem0), S0, S1),
  245 set_advstate(S1), % backtrackable leaks :( b_setval(advstate,S2),
  246 decide_action(Agent, Mem0, Mem2),
  247 declare(memories(Agent, Mem2), S1, S).
  248
  249run_agent_pass_1_0(Agent, S0, S0) :-
  250 bugout3('run_agent_pass_1(~w) FAILED!~n', [Agent], general).
  251
  252
  253
  254run_agent_pass_2(Agent, S0, S) :-
  255 with_agent_console(Agent,do_todo(Agent, S0, S)).
  256run_agent_pass_2(Agent, S0, S0) :-
  257 bugout3('run_agent_pass_2(~w) FAILED!~n', [Agent], general).
  258
  259
  260
  261  
  262:- meta_predicate match_functor_or_arg(1,*).  263match_functor_or_arg(Q,P):- compound(P),functor(P,F,_),(call(Q,F)->true;(arg(1,P,E),call(Q,E))),!.
  264
  265 
  266% --------