1/*
    2%  NomicMUD: A MUD server written in Prolog
    3%  Maintainer: Douglas Miles
    4%  Dec 13, 2035
    5%
    6%  Bits and pieces:
    7%
    8%    LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    9% 
   10%  Copyright (C) 2004 Marty White under the GNU GPL 
   11%  Sept 20,1999 - Douglas Miles
   12%  July 10,1996 - John Eikenberry 
   13%
   14%  Logicmoo Project changes:
   15%
   16% Main file.
   17%
   18*/
   19
   20admin :- true.  % Potential security hazzard.
   21wizard :- true. % Potential to really muck up game.
   22extra :-  true. % Fuller, but questionable if needed yet.
   23
   24:- op(200,fx,'$').   25
   26:- use_module(library(editline)).   27:- initialization('$toplevel':setup_readline,now).   28
   29:- user:ensure_loaded((.. / parser_sharing)).   30:- consult(adv_debug).   31:- consult(adv_util).   32:- consult(adv_io).   33
   34:- consult(adv_model).   35:- consult(adv_percept).   36
   37:- consult(adv_inst).   38:- consult(adv_edit).   39
   40:- consult(adv_action).   41:- consult(adv_agent).   42:- consult(adv_eng2cmd).   43:- consult(adv_floyd).   44:- consult(adv_log2eng).   45:- consult(adv_physics).   46:- consult(adv_plan).   47:- consult(adv_state).   48:- consult(adv_data).   49
   50%:- consult(adv_test).
   51%:- consult(adv_telnet).
   52
   53
   54:- export(console_player/1).   55console_player(Agent):-
   56  current_input(InStream),
   57  adv:console_info(_Id, _Alias, InStream, _OutStream, _Host, _Peer, Agent),!.
   58console_player(Agent):-
   59  Agent = 'player~1',
   60  (( \+ adv:console_info(_Id, _Alias, _InStream, _OutStream, _Host, _Peer, Agent))).
   61
   62:- thread_local(adv:current_agent/1).   63current_player(Agent):- adv:current_agent(Agent),!.
   64current_player(Agent):- thread_self(Id),adv:console_info(Id,_Alias,_InStream,_OutStream,_Host,_Peer, Agent).
   65current_player('player~1').
   66:- export(current_player/1).   67
   68
   69adventure_init :-
   70 use_module(library(editline)),
   71 ignore(notrace(catch(('$toplevel':setup_readline),_,true))),
   72  %guitracer,
   73 dmust((
   74  test_ordering,
   75  init_logging,
   76  (retractall(advstate(_));true),
   77  istate(S0),
   78  init_objects(S0, S1),
   79  %each_live_agent(must_act(look), S1, S3),
   80  asserta(advstate(S1)))), !,
   81   player_format('=============================================~n', []),
   82   player_format('INIT STATE~n', []),
   83   player_format('=============================================~n', []),
   84   printable_state(S1,SP), 
   85   pprint(SP, general),!.
   86
   87
   88adventure:- 
   89   adventure_init,
   90   player_format('=============================================~n', []),
   91   player_format('Welcome to Marty\'s Prolog Adventure Prototype~n', []),
   92   player_format('=============================================~n', []),  
   93  % trace,  
   94  mainloop,
   95  %main_loop(S3),
   96  adv:input_log(FH),
   97  close(FH).
   98
   99adventure :-
  100  adv:input_log(FH),
  101  close(FH),
  102  player_format('adventure FAILED~n', []),
  103  !, fail.        
  104
  105
  106main(S0, S9) :-
  107  notrace((nb_setval(advstate,S0))),
  108  update_telnet_clients(S0,S1),
  109  ((nb_setval(advstate,S1),
  110  % pprint(S1,general),
  111  get_live_agents(LiveAgents, S1),
  112  ttyflush)),
  113  %dbug(liveAgents = LiveAgents),
  114  apply_all(LiveAgents, run_agent_pass_1(), S1, S2),
  115  apply_all(LiveAgents, run_agent_pass_2(), S2, S9),
  116  notrace((nb_setval(advstate,S9))),
  117  !. % Don't allow future failure to redo main.
  118main(S0, S0) :-
  119  bugout('main FAILED~n', general).
  120
  121:- dynamic(adv:agent_conn/4).  122
  123update_telnet_clients(S0,S2):-
  124   retract(adv:agent_conn(Agent,Named,_Alias,Info)),
  125   create_agent_conn(Agent,Named,Info,S0,S1),
  126   update_telnet_clients(S1,S2).
  127update_telnet_clients(S0,S0).
  128
  129
  130
  131:- dynamic(adv:console_tokens/2).  132telnet_decide_action(Agent, Mem0, Mem0):-
  133  % If actions are queued, no further thinking required.
  134  thought(todo([Action|_]), Mem0),
  135  (declared(h(_Spatial, in, Agent, Here), Mem0)->true;Here=somewhere),
  136  bugout('~w @ ~w telnet: Already about to: ~w~n', [Agent, Here, Action], telnet).
  137
  138telnet_decide_action(Agent, Mem0, Mem1) :-
  139  %dmust(thought(timestamp(T0), Mem0)),
  140  retract(adv:console_tokens(Agent, Words)), !,
  141  dmust((parse(Words, Action, Mem0),
  142  nop(bugout('Telnet TODO ~p~n', [Agent: Words->Action], telnet)),
  143  add_todo(Action, Mem0, Mem1))), !.
  144telnet_decide_action(Agent, Mem, Mem) :-
  145  nop(bugout('~w: Can\'t think of anything to do.~n', [Agent], telnet)).
  146
  147
  148%:- if(\+ prolog_load_context(reloading, t)).
  149:- initialization(adventure, main).  150%:- endif.
  151
  152mainloop :-
  153  repeat,
  154    once(dmust((
  155          retract(advstate(S0)),
  156          main(S0, S1),
  157          asserta(advstate(S1)),
  158          must_output_state(S1)))),
  159    declared(quit, S1),
  160  !. % Don't allow future failure to redo mainloop.
  161
  162% TODO: try converting this to a true "repeat" loop.
  163/*main_loop(State) :-
  164  declared(quit, State), !.
  165main_loop(State) :-
  166  declared(undo, State),
  167  current_player(Player),
  168  retract(undo(Player, [_, Prev|Tail])),
  169  assertz(undo(Player, Tail)),
  170  !,
  171  main_loop(Prev).
  172main_loop(S0) :-
  173  %repeat,
  174  current_player(Player),
  175  retract(undo(Player, [U1, U2, U3, U4, U5, U6|_])),
  176  assertz(undo(Player, [S0, U1, U2, U3, U4, U5, U6])),
  177  run_agent(Player, S0, S4),
  178  run_agent(floyd, S4, S5),
  179  %user_interact(S3, S4), !,
  180  %automate_agent(floyd, S4, S5),
  181  !,
  182  main_loop(S5).
  183main_loop(_) :-
  184  bugout('main_loop() FAILED!~n', general).
  185*/
  186
  187
  188% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  189%  CODE FILE SECTION
  190:- nop(ensure_loaded('adv_main_commands')).  191% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  192
  193
  194save_term(Filename, Term) :-
  195  \+ access_file(Filename, exist),
  196  open(Filename, write, FH),
  197  write(FH, Term),
  198  close(FH),
  199  player_format('Saved to file "~w".~n', [Filename]).
  200save_term(Filename, _) :-
  201  access_file(Filename, exist),
  202  player_format('Save FAILED! Does file "~w" already exist?~n', [Filename]).
  203save_term(Filename, _) :-
  204  player_format('Failed to state(Spatial, open, t) file "~w" for saving.~n', [Filename])