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%:- use_module(library(pfc)).
   20
   21:- if(\+ exists_source(library(poor_bugger))).   22:- prolog_load_context(file,File),
   23 absolute_file_name('..',X,[relative_to(File),file_type(directory)]),
   24 asserta(user:file_search_path(library,X)).   25:- endif.   26
   27:- if(exists_source(library(nldata/nl_iface))).   28% being in user is just to help debugging from console
   29:- user:ensure_loaded(library(nldata/nl_iface)).   30:- endif.   31
   32
   33security_of(_,_Wiz).
   34admin :- true. % Potential security hazzard.
   35wizard :- true. % Potential to really muck up game.
   36extra :- true. % Fuller, but questionable if needed yet.
   37
   38:- op(200,fx,'$').   39
   40:- user:ensure_loaded(library(parser_sharing)).   41
   42
   43:- consult(adv_debug).   44:- consult(adv_help).   45:- consult(adv_util).   46:- consult(adv_io).   47
   48:- consult(adv_model).   49:- consult(adv_percept).   50
   51:- consult(adv_inst).   52:- consult(adv_edit).   53:- ensure_loaded(adv_axiom).   54
   55:- ensure_loaded(adv_abdemo).   56
   57:- consult(adv_examine).   58:- consult(adv_action).   59:- consult(adv_agent).   60:- consult(adv_eng2cmd).   61:- consult(adv_floyd).   62:- consult(adv_log2eng).   63:- consult(adv_physics).   64:- consult(adv_plan).   65:- consult(adv_state).   66:- consult(adv_data).   67
   68%:- consult(adv_test).
   69%:- consult(adv_telnet).
   70
   71
   72adventure_init :-
   73 %guitracer,
   74 must_det((
   75 test_ordering,
   76 init_logging,
   77 (retractall(advstate_db(_));true),!,
   78 istate(S0),!,
   79 init_objects(S0, S1),!,
   80 asserta(advstate_db(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 stop_logging.
   97
   98adventure :-
   99 stop_logging,
  100 player_format('adventure FAILED~n', []),
  101 !, fail.  
  102
  103
  104main(S0, S9) :-
  105 notrace((set_advstate(S0))),
  106 must_det(update_telnet_clients(S0,S1)),
  107 ((set_advstate(S1),
  108 % pprint(S1,general),
  109 get_live_agents(LiveAgents, S1),
  110 ttyflush)),
  111 %bugout1(liveAgents = LiveAgents),
  112 apply_mapl_state(run_agent_pass_1(), LiveAgents, S1, S2),
  113 apply_mapl_state(run_agent_pass_2(), LiveAgents, S2, S9),
  114 notrace((set_advstate(S9))),
  115 !. % Don't allow future failure to redo main.
  116main(S0, S0) :-
  117 bugout3('main FAILED~n', general).
  118
  119:- dynamic(adv:agent_conn/4).  120
  121update_telnet_clients(S0,S2):-
  122 retract(adv:agent_conn(Agent,Named,_Alias,Info)),
  123 create_agent_conn(Agent,Named,Info,S0,S1),
  124 update_telnet_clients(S1,S2).
  125update_telnet_clients(S0,S0).
  126
  127
  128
  129:- dynamic(adv:console_tokens/2).  130telnet_decide_action(Agent, Mem0, Mem0):-
  131 % If actions are queued, no further thinking required.
  132 thought(todo([Action|_]), Mem0),
  133 (declared_advstate(h(in, Agent, Here))->true;Here=somewhere),
  134 bugout3('~w @ ~w telnet: Already about to: ~w~n', [Agent, Here, Action], telnet).
  135
  136telnet_decide_action(Agent, Mem0, Mem1) :-
  137 %must_det(thought(timestamp(T0), Mem0)),
  138 retract(adv:console_tokens(Agent, Words)), !,
  139 must_det((parse_command(Agent, Words, Action, Mem0),
  140 if_tracing(bugout3('Telnet TODO ~p~n', [Agent: Words->Action], telnet)),
  141 add_todo(Action, Mem0, Mem1))), !.
  142telnet_decide_action(Agent, Mem, Mem) :-
  143 nop(bugout3('~w: Can\'t think of anything to do.~n', [Agent], telnet)).
  144
  145
  146%:- if(\+ prolog_load_context(reloading, t)).
  147:- initialization(adventure, main).  148%:- endif.
  149
  150main_once:- 
  151 must_det((
  152   retract(advstate_db(S0)),
  153   main(S0, S1),
  154   asserta(advstate_db(S1)),
  155   must_output_state(S1))
  156 ),!.
  157
  158mainloop :-
  159 repeat,
  160 once(main_once),
  161 (advstate_db(S1)->declared(quit, S1)),
  162 !. % Don't allow future failure to redo mainloop.
  163
  164% TODO: try converting this to a true "repeat" loop.
  165/*main_loop(State) :-
  166 declared(quit, State), !.
  167main_loop(State) :-
  168 declared(undo, State),
  169 current_agent(Player),
  170 retract(undo(Player, [_, Prev|Tail])),
  171 assertz(undo(Player, Tail)),
  172 !,
  173 main_loop(Prev).
  174main_loop(S0) :-
  175 %repeat,
  176 current_agent(Player),
  177 retract(undo(Player, [U1, U2, U3, U4, U5, U6|_])),
  178 assertz(undo(Player, [S0, U1, U2, U3, U4, U5, U6])),
  179 run_agent(Player, S0, S4),
  180 run_agent(floyd, S4, S5),
  181 %user_interact(S3, S4), !,
  182 %automate_agent(floyd, S4, S5),
  183 !,
  184 main_loop(S5).
  185main_loop(_) :-
  186 bugout3('main_loop() FAILED!~n', general).
  187*/
  188
  189
  190% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  191% CODE FILE SECTION
  192:- nop(ensure_loaded('adv_main_commands')).  193% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  194
  195
  196save_term(Filename, Term) :-
  197 \+ access_file(Filename, exist),
  198 open(Filename, write, FH),
  199 write(FH, Term),
  200 close(FH),
  201 player_format('Saved to file "~w".~n', [Filename]).
  202save_term(Filename, _) :-
  203 access_file(Filename, exist),
  204 player_format('Save FAILED! Does file "~w" already exist?~n', [Filename]).
  205save_term(Filename, _) :-
  206 player_format('Failed to open file "~w" for saving.~n', [Filename])