1/* * module * 
    2% This file loads the world (world.pl), the map of the world, 
    3% the agents and their definitions.
    4% This file is used as a configuation file and a startup script.
    5%
    6% July 10,1996
    7% John Eikenberry
    8%
    9% Logicmoo Project PrologMUD: A MUD server written in Prolog
   10% Maintainer: Douglas Miles
   11% Dec 13, 2035
   12%
   13*/
   14
   15%:-pfc_untrace.
   16%:-pfc_no_spy_all.
   17
   18use_baseKB :- nop('$set_typein_module'( baseKB)),nop('$set_source_module'( baseKB)),nop(module( baseKB)),ignore(notrace(update_changed_files)).
   19:- use_baseKB.   20
   21% ==============================================
   22% ============= MUD SERVER CODE LOADED =============
   23% ==============================================
   24
   25:- with_mpred_trace_exec(ain(isLoaded(iSourceCode7))).   26
   27%:- flag_call(runtime_debug=3).
   28
   29:- if((gethostname(ubuntu),fail)). % INFO this fail is so we can start faster
   30:- show_entry(gripe_time(40, doall(baseKB:regression_test))).   31:- endif.   32
   33user:file_search_path(sample_games, Dir):- try_samples_game_dir(Dir).
   34try_samples_game_dir('./'):- exists_source('./src_game_nani/objs_misc_household.pfc').
   35try_samples_game_dir('~/'):- exists_source('~/src_game_nani/objs_misc_household.pfc').
   36try_samples_game_dir('/opt/logicmoo_workspace/prologmud_server/'):- 
   37  exists_source('/opt/logicmoo_workspace/prologmud_server/src_game_nani/objs_misc_household.pfc').
   38try_samples_game_dir(library('prologmud_sample_games/')).
   39
   40% ==============================================
   41% [Optional] Creates or suppliments a world
   42% ==============================================
   43/*% 
   44set_default_sample_games:- try_samples_game_dir(Try), 
   45   catch(absolute_file_name(Try,Dir,[file_type(directory), access(read)]),_,true),
   46   ignore((nonvar(Dir),asserta(user:file_search_path(sample_games,Dir)))),!.
   47set_default_sample_games:- user:file_search_path(sample_games,_Dir),!.
   48set_default_sample_games:- 
   49   must((catch(absolute_file_name(library('prologmud_sample_games/'),Dir,[file_type(directory), access(read)]),_,true),
   50   ignore((nonvar(Dir),asserta(user:file_search_path(sample_games,Dir)))))).
   51%:- if( \+ user:file_search_path(sample_games,_Dir)).
   52:- set_default_sample_games.
   53*/
   54%:- sanity(user:file_search_path(sample_games,_Dir)).
   55%:- endif.
   56
   57:- dynamic(lmconf:eachRule_Preconditional/1).   58:- dynamic(lmconf:eachFact_Preconditional/1).   59:- assert_setting01(lmconf:eachRule_Preconditional(true)).   60:- assert_setting01(lmconf:eachFact_Preconditional(true)).   61
   62:- if(functorDeclares(mobExplorer)).   63
   64:- sanity(functorDeclares(tSourceData)).   65:- sanity(functorDeclares(mobExplorer)).   66
   67
   68==>((tCol(tLivingRoom),
   69 tSet(tRegion),
   70 tSet(tLivingRoom),
   71
   72 tSet(mobExplorer),
   73 genls(tLivingRoom,tRegion),
   74 genls(tOfficeRoom,tRegion),
   75
   76
   77genlsFwd(tLivingRoom,tRegion),
   78genlsFwd(tOfficeRoom,tRegion),
   79
   80% create some seats
   81mobExplorer(iExplorer1),
   82mobExplorer(iExplorer2),
   83mobExplorer(iExplorer3),
   84mobExplorer(iExplorer4),
   85mobExplorer(iExplorer5),
   86mobExplorer(iExplorer6),
   87
   88(tHumanBody(skRelationAllExistsFn)==>{trace_or_throw(tHumanBody(skRelationAllExistsFn))}),
   89
   90genls(mobExplorer,tHominid))).
   91
   92:- endif.   93
   94
   95% ==============================================
   96% [Required] isRuntime Hook
   97% ==============================================
   98(((localityOfObject(P,_),isRuntime)==>{if_defined(put_in_world(P))})).
   99
  100
  101:- set_prolog_flag_until_eof(do_renames,term_expansion).  102
  103
  104
  105% ==============================================
  106% [Optional] Creates or suppliments a world
  107% ==============================================
  108:- if( \+ app_argv('--noworld')).  109:- if( \+ tRegion(_)).  110
  111==> prologHybrid(mudAreaConnected(tRegion,tRegion),rtSymmetricBinaryPredicate).
  112==> rtArgsVerbatum(mudAreaConnected).
  113
  114==>((
  115tRegion(iLivingRoom7),
  116tRegion(iOfficeRoom7),
  117
  118mobExplorer(iExplorer7),
  119wearsClothing(iExplorer7,'iBoots773'),
  120wearsClothing(iExplorer7,'iCommBadge774'),
  121wearsClothing(iExplorer7,'iGoldUniform775'),
  122mudStowing(iExplorer7,'iPhaser776'))).
  123
  124:- kb_shared(baseKB:tCol/1).  125:- kb_shared(baseKB:ttCoercable/1).  126:- kb_shared(baseKB:(onSpawn)/1).  127% :- add_import_module(mpred_type_isa,baseKB,end).
  128==>onSpawn(localityOfObject(iExplorer7,tLivingRoom)).
  129
  130==>((
  131pddlSomethingIsa('iBoots773',['tBoots','ProtectiveAttire','PortableObject','tWearAble']),
  132pddlSomethingIsa('iCommBadge774',['tCommBadge','ProtectiveAttire','PortableObject','tNecklace']),
  133pddlSomethingIsa('iGoldUniform775',['tGoldUniform','ProtectiveAttire','PortableObject','tWearAble']),
  134pddlSomethingIsa('iPhaser776',['tPhaser','Handgun',tWeapon,'LightingDevice','PortableObject','Device-SingleUser','tWearAble']),
  135
  136mobMonster(iCommanderdata66),
  137mobExplorer(iCommanderdata66),
  138mudDescription(iCommanderdata66,txtFormatFn("Very scary looking monster named ~w",[iCommanderdata66])),
  139tAgent(iCommanderdata66),
  140tHominid(iCommanderdata66),
  141wearsClothing(iCommanderdata66,'iBoots673'),
  142wearsClothing(iCommanderdata66,'iCommBadge674'),
  143wearsClothing(iCommanderdata66,'iGoldUniform675'),
  144mudStowing(iCommanderdata66,'iPhaser676'),
  145
  146pddlSomethingIsa('iBoots673',['tBoots','ProtectiveAttire','PortableObject','tWearAble']),
  147pddlSomethingIsa('iCommBadge674',['tCommBadge','ProtectiveAttire','PortableObject','tNecklace']),
  148pddlSomethingIsa('iGoldUniform675',['tGoldUniform','ProtectiveAttire','PortableObject','tWearAble']),
  149pddlSomethingIsa('iPhaser676',['tPhaser','Handgun',tWeapon,'LightingDevice','PortableObject','Device-SingleUser','tWearAble']))).
  150
  151
  152==>onSpawn(localityOfObject(iCommanderdata66,tOfficeRoom)).
  153==>onSpawn(mudAreaConnected(tLivingRoom,tOfficeRoom)).
  154:- endif.  155:- endif.  156
  157:- if( \+ is_startup_script(_) ).  158%:- init_why("run_mud_server").
  159:- endif.  160
  161
  162%:- set_prolog_flag(access_level,system).
  163%:- debug.
  164
  165
  166
  167start_mud_server:-  
  168  on_x_log_cont((call(call,start_mud_telnet))).
  169
  170% ==============================================
  171% [Optionaly] Start the telent server % iCommanderdata66
  172% ==============================================
  173%:- if( \+ app_argv('--nonet')).
  174:- after_boot(start_mud_server).  175% :- assert_setting01(lmconf:eachFact_Preconditional(isRuntime)).
  176%:- endif.
  177
  178% [Manditory] This loads the game and initializes so test can be ran
  179:- baseKB:ensure_loaded(sample_games('src_game_nani/objs_misc_household.pfc')).  180:- baseKB:ensure_loaded(sample_games('src_game_nani/a_nani_household.pfc')).  181
  182% isa(starTrek,mtHybrid).
  183%lst :- !.
  184lst :- baseKB:ensure_loaded(sample_games('src_game_startrek/?*.pfc*')).
  185lstr :- forall((baseKB:how_virtualize_file(heads,F,0), \+ mpred_unload_option(F, never)), baseKB:ensure_loaded(F)).
  186lstra :- forall(baseKB:how_virtualize_file(_,F,0),baseKB:ensure_loaded(F)).
  187
  188% ==============================================
  189% [Optional] the following game files though can be loaded separate instead
  190% ==============================================
  191:- declare_load_dbase(sample_games('src_game_nani/?*.pfc*')).  192
  193% ==============================================
  194% [Optional] the following worlds are in version control in examples
  195% ==============================================
  196% :- add_game_dir(sample_games('src_game_wumpus'),prolog_repl).
  197% :- add_game_dir(sample_games('src_game_sims'),prolog_repl).
  198% :- add_game_dir(sample_games('src_game_nani'),prolog_repl).
  199%:- add_game_dir(sample_games('src_game_startrek'),prolog_repl).
  200%:- declare_load_dbase(sample_games('src_game_startrek/?*.pfc*')).
  201
  202%:- check_clause_counts.
  203
  204:- sanity(argIsa(genlPreds,2,_)).  205
  206:- test_runtime_boot(argIsa(genlPreds,2,_)).  207
  208
  209% ==============================================
  210% Sanity tests
  211% ==============================================
  212:- if( \+ app_argv('--noworld')).  213sanity_test(ifood_rez):- ignore((
  214     %user:ensure_loaded(init_mud_server),
  215     % mpred_notrace_exec,
  216     % flag_call(runtime_debug>true),
  217     ain(isa(iFoodRez2,tFood)),must(isa(iFoodRez2,tEatAble)))),
  218    must((call(call,parseIsa_Call(tEatAble,O,["food"],Rest)),O=iFoodRez2,Rest=[])).
  219
  220:- test_runtime_boot((dmsg(sanity_test_ifood_rez))).  221
  222
  223sanity_test(s_direction):- gripe_time(1.0,must(coerce("s",vtDirection,_))).
  224sanity_test(l_not_a_direction):- gripe_time(2.0,must( \+ coerce(l,vtDirection,_))).
  225%:- test_runtime_boot().
  226%:- test_runtime_boot().
  227:- endif.  228:- test_runtime_boot((statistics)).  229:- test_runtime_boot(check_clause_counts).  230
  231
  232% ==============================================
  233% [Required/Optional]  Ensures...
  234% ==============================================
  235
  236% :- after_boot(set_prolog_flag(runtime_debug,0)).
  237:- before_boot(set_prolog_flag(unsafe_speedups,false)).  238
  239:- if( \+ app_argv('--noworld')).  240:- if(app_argv('--world')).  241% :- lst.
  242:- dmsg("Dont forget to ?- lst. ").  243:- add_history(lst).  244:- endif.  245:- retractall(t_l:disable_px).  246%:- xlisting('/mnt/sde1/packs_sys/logicmoo_base/prolog/logicmoo/pfc/system_basic.pfc.pl').
  247%:- break.
  248%:- lstr.
  249:- endif.  250
  251lar0 :- app_argv('--repl'),!,dmsg("Ctrl-D to start MUD"),prolog,lar.
  252lar0 :- lar.
  253
  254:- add_history(lar).  255lar :- % set_prolog_flag(dmsg_level,never),
  256     start_runtime_mud,
  257       if_defined(login_and_run,wdmsg("MUD code not loaded")).
  258
  259
  260%:- after_boot(qsave_lm(lm_init_mud)).
  261%:- after_boot(lar0).
  262
  263
  264:- after_boot((statistics,dmsg("Type lar.<enter> at the '?-' prompt to start the MUD (a shortcut for ?- login_and_run. )"))).  265
  266:- if(gethostname(gitlab)).                                            
  267
  268:- set_prolog_flag(runtime_debug,3).  269:- set_prolog_flag(runtime_safety,3).  270:- set_prolog_flag(runtime_speed,0).  271
  272:- else.  273
  274
  275:- set_prolog_flag(runtime_debug,1).  276:- set_prolog_flag(runtime_safety,1).  277:- set_prolog_flag(runtime_speed,1).  278
  279:- endif.  280
  281
  282:- before_boot(use_baseKB).  283:- during_boot(use_baseKB).  284:- after_boot(use_baseKB).  285
  286:- during_boot(baseKB:ain(tSourceData(iWorldData8))).  287
  288start_runtime_mud:- 
  289   update_changed_files,
  290   forall(tCol(X),call(baseKB:kb_shared,X/1)),
  291   forall(tSet(X),call(baseKB:kb_shared,X/1)),
  292   %forall(tCol(X),call(baseKB:make_as_dynamic,X/1)),
  293   %forall(tSet(X),call(baseKB:make_as_dynamic,X/1)),
  294   use_baseKB,
  295   notrace(baseKB:ain(isLoaded(iWorldData8))),
  296   notrace(with_mpred_trace_exec(baseKB:ain(isRuntime))),
  297   show_lm_tests.
  298
  299
  300show_lm_tests:-
  301  dmsg(call(listing(baseKB:feature_test))),
  302  dmsg(call(listing(baseKB:sanity_test))),
  303  dmsg(call(listing(baseKB:regression_test))),
  304  !.
  305
  306
  307:- after_boot(start_runtime_mud).  308
  309%:- setenv('DISPLAY', '').
  310
  311:- add_history(profile(ain(tAgent(foofy)))).  312:- add_history(listing(inRegion)).  313:- add_history(listing(localityOfObject)).                  
  314:- add_history(listing(mudAtLoc)).  315:- add_history(baseKB:lst).  316:- add_history(logicmoo_i_cyc_xform).  317
  318:- fixup_exports.