1/*
    2
    3* &ght;module> 
    4% This file loads the world (world.pl), the map of the world, 
    5% the agents and their definitions.
    6% This file is used as a configuation file and a startup script.
    7%
    8% July 10,1996
    9% John Eikenberry
   10%
   11% Logicmoo Project PrologMUD: A MUD server written in Prolog
   12% Maintainer: Douglas Miles
   13% Dec 13, 2035
   14%
   15*/
   16
   17%:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). 
   18% :- module(mud_loader,[]).
   19%:- endif.
   20%:- set_prolog_flag(pfc_booted,false).
   21
   22
   23
   24:- thread_local(t_l:disable_px/0).   25% :- must(\+ t_l:disable_px).
   26:- retractall(t_l:disable_px).
   32% UNDO % :- add_import_module(baseKB,world,end).
   33% % UNDO % :- add_import_module(baseKB,baseKB,end).
   34% UNDO % :- add_import_module(baseKB,mud_testing,end).
   35% UNDO % :- add_import_module(baseKB,mud_telnet,end).
   36% UNDO % :- add_import_module(mud_testing,mud_telnet,end).
   37% UNDO % :- add_import_module(mud_telnet,world,end).
   38% UNDO % :- add_import_module(baseKB,lmcache,end).
   39% % UNDO % :- add_import_module(baseKB,world,end).
   40
   41:- dynamic   user:file_search_path/2.   42:- multifile user:file_search_path/2.   43
   44:- op(200,fy,(-)).   45
   46%:- set_prolog_flag(verbose_load,true).
   47
   48
   49
   50:- dynamic user:prolog_load_file/2.   51:- multifile user:prolog_load_file/2.   52:- module_transparent user:prolog_load_file/2.   53
   54user:prolog_load_file(ModuleSpec, Options) :-
   55 Found = f(_),
   56 once((
   57 strip_module(ModuleSpec, Module, Spec),
   58 nonvar(Spec),
   59 contains_wildcard(Spec),
   60 forall((enumerate_files(ModuleSpec,Result),exists_file(Result)),
   61   (load_files(Module:Result,Options),nb_setarg(1,Found,true))))),
   62 ground(Found),!.
   63 
   64
   65%:- include(mud_header).
   66
   67
   68:- set_prolog_flag(generate_debug_info, true).   69% [Optionaly] Set the Prolog optimize/debug flags
   70%:- set_prolog_flag(verbose_load,true).
   71%:- use_module(library(gui_tracer)).
   72%:- set_prolog_flag(gui_tracer, false).
   73%:- set_prolog_flag(answer_write_options, [quoted(true), portray(true), max_depth(1000), spacing(next_argument)]).
   74%:- catch(noguitracer,_,true).
   75
   76
   77%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   78:- dmsg("[Optional] Load the Logicmoo Early Network System").   79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   80:- if(\+ app_argv('--nonet')).   81:- whenever_flag_permits(load_network,load_library_system(library(logicmoo_network))).   82:- endif.   83
   84:- user:use_module(library(logicmoo_utils_all)).   85
   86% ==============================================
   87% [Required] Load the Logicmoo User System
   88% ==============================================
   89:- user:load_library_system(library(logicmoo_lib)).   90
   91:- use_module(library(logicmoo/butterfly_console)).   92
   93
   94:- if(\+ app_argv('--nonet')).   95:- whenever_flag_permits(load_network,load_library_system(library(logicmoo_webbot))).   96:- endif.   97
   98% [Optionaly] Set up the Prolog optimize/debug flags
   99%:- set_prolog_flag(debug,false).
  100%:- set_optimize(true).
  101
  102
  103% [Optionaly] load the mpred_online system
  104% :- if_file_exists(ensure_loaded(library(logicmoo/mpred_online))).
  105
  106:- if( \+ user:file_search_path(prologmud,_)).  107:- prolog_load_context(directory,Dir),
  108   asserta(user:file_search_path(prologmud,Dir)).  109:- endif.  110
  111% xyzFn(R,X,Y,Z):-dmsg(xyzFn(R,X,Y,Z)),trace_or_throw(xyzFn(R,X,Y,Z)).
  112
  113% :- multifile prolog:message/3.
  114% prolog:message(git(update_versions),A,A):-!.
  115
  116:- use_module(library(settings)).  117% :- use_module(library(check)).
  118% :- make.
  119%:- portray_text(true).
  120
  121/*
  122:-set_prolog_stack(global, limit(32*10**9)).
  123:-set_prolog_stack(local, limit(32*10**9)).
  124:-set_prolog_stack(trail, limit(32*10**9)).
  125*/
  126
  127:- multifile( entailment:rdf /3 ).  128
  129% [Optionaly] Solve the Halting problem
  130:-use_module(library(process)).  131% :-use_module(library(pce)).
  132%:- has_gui_debug -> true ; remove_pred(pce_principal,send,2).
  133%:- has_gui_debug -> true ; remove_pred(pce_principal,new,2).
  134
  135
  136:- export(add_game_dir/2).  137add_game_dir(GAMEDIR,Else):- add_to_search_path_first(game, GAMEDIR),now_try_game_dir(Else).
  138
  139
  140now_try_game_dir(Else):-  
  141 enumerate_files(game('.'), GAMEDIR) *-> 
  142  ((exists_directory(GAMEDIR) -> 
  143    with_all_dmsg(( 
  144      % forall(enumerate_files(game('**/*.pl'),X),ensure_loaded(X)),
  145      forall(no_repeats_old(X,enumerate_files(game('*.pfc.pl'),X)),declare_load_dbase(X)))); (wdmsg(missing(GAMEDIR)),Else)));  (wdmsg(no_game_dir),Else).
  146
  147
  148:-context_module(CM),assert(loading_from_cm(CM)).  149create_module(M):-current_module(M),!.
  150create_module(M):-context_module(CM),module(M),asserta(M:this_is_a_module(M)),writeq(switching_back_to_module(M,CM)),module(CM).
  151:-create_module(t_l).  152:-create_module(user).  153
  154%:-create_module(baseKB).
  155%:-create_module(moo).
  156
  157
  158:-module_transparent parser_chat80_module/1.  159:-multifile parser_chat80_module/1.  160:-export((parser_chat80_module/1)).  161parser_chat80_module(moo).
  162
  163
  164
  165:-export(prolog_repl/0).  166
  167prolog_repl:- !, with_all_dmsg((nl,fmt("Press Ctrl-D to resume to the mud!"),nl,!,call_u(break))).
  168/*
  169prolog_repl:- with_all_dmsg((nl,fmt("Press Ctrl-D to resume to the mud!"),nl,
  170  current_input(In),
  171  current_output(Out),
  172  % current_error(Err),
  173  /*must(lmcache:main_thread_error_stream(Err)),*/
  174  set_prolog_IO(In,Out,Out),
  175  % must(get_thread_current_error(O)),
  176  with_ioe(call_u(break)))).
  177*/
  178
  179%:- set_prolog_flag(gui,false).
  180%:- set_prolog_flag(history,1000).
  181
  182% :- prolog_ide(debug_monitor),prolog_ide(open_debug_status). % ,prolog_ide(xref).
  183
  184
  185
  186
  187:-export(within_user/1).  188
  189
  190within_user(Call):- '@'(Call,'user').
  191
  192% ======================================================
  193% Configure the logicmoo utilities into the file path
  194% :- include('logicmoo_util/logicmoo_util_header').
  195% :- user:use_module('logicmoo_util/logicmoo_util_all.pl').
  196% And adds the local directories to file search path of logicmoo(..)
  197% ======================================================
  198
  199
  200:- dynamic   user:file_search_path/2.  201:- multifile user:file_search_path/2.  202
  203:- user:use_module(library(settings)).  204
  205:- ignore((user:file_search_path(cliopatria,SP),
  206   exists_directory(SP),!,
  207   writeq(user:file_search_path(cliopatria,SP)),nl)).  208   %set_setting_default(cliopatria_binding:path, SP).
  209   %save_settings('moo_settings.db').
  210   %%setting(cliopatria_binding:path, atom, SP, 'Path to root of cliopatria install'),!.
  211
  212% :- user:use_module(logicmoo('http/user_page')).
  213
  214
  215if_version_greater(V,Goal):- current_prolog_flag(version,F), ((F > V) -> call(Goal) ; true).
  216:- meta_predicate(if_version_greater(?,0)).  217
  218% set to false because we don't want to use the mudconsole
  219:- if_flag_true(false, if_version_greater(70109,baseKB:ensure_loaded(logicmoo('mudconsole/mudconsolestart')))).  220
  221% [Optionaly 1st run] tell where ClioPatria is located and restart for the 2nd run
  222%:- set_setting(cliopatria_binding:path, '/devel/ClioPatria'), save_settings('moo_settings.db').
  223
  224start_boxer:-
  225   %threads,
  226   ensure_loaded(logicmoo(candc/parser_boxer)),
  227   % make,   
  228   runtime_boot(prolog_repl).
  229
  230
  231
  232% We don't start cliopatria we here. We have to manually start
  233%  with  ?- start_servers.
  234hard_work:-!.
  235hard_work:-
  236   with_no_mpred_expansions(locally_hide(op(200,fy,'@'),
  237   ((
  238 %  use_module('t:/devel/cliopatria/rdfql/sparql_runtime.pl'),
  239  % ensure_loaded(logicmoo(launchcliopatria)),
  240  % ensure_loaded(logicmoo(testwebconsole)),
  241  % kill_term_expansion, 
  242   ensure_loaded(swish(logicmoo_run_swish))
  243   )))),!.
  244
  245% [Required] load the mud PFCs
  246%:- set_prolog_flag(pfc_booted,false).
  247
  248:- retractall(t_l:disable_px).  249
  250:- set_prolog_flag(expect_pfc_file,soon).  251:- show_entry(gripe_time(40,ensure_loaded(prologmud('mud_builtin.pfc')))).  252:- set_prolog_flag(expect_pfc_file,never).  253
  254% :- show_entry(gripe_time(40,force_reload_mpred_file(prologmud('mud_builtin.pfc')))).
  255
  256slow_work:- locally_hide( set_prolog_flag(subclause_expansion,false) , within_user(after_boot(hard_work))).
  257
  258thread_work:- thread_property(X, status(running)),X=loading_code,!.
  259thread_work:- thread_create(slow_work,_,[alias(loading_code)]).
  260
  261% start_servers :- if_version_greater(70111,thread_work).
  262start_servers :- if_version_greater(70111,slow_work).
  263
  264run_setup_now:-
  265   within_user((
  266      finish_processing_world      
  267   % TO UNDO register_timer_thread(npc_ticker,90,npc_tick)
  268   )).
  269
  270run_setup:- within_user(after_boot(run_setup_now)).
  271
  272
  273
  274
  275% [Optionaly] load and start sparql server
  276% starts in forground
  277%:- after_boot(slow_work).
  278% starts in thread (the the above was commented out)
  279%:- after_boot(start_servers).
  280% commented out except on run
  281
  282
  283debug_repl_w_cyc(Module,CallFirst):- !,         
  284          locally_hide(t_l:useOnlyExternalDBs,
  285            locally(baseKB:use_cyc_database,
  286               ((ain(tCol(person)),
  287                ensure_mpred_file_loaded(logicmoo('rooms/startrek.all.pfc.pl')),
  288                 call_with_typein_and_source(Module,Module,(show_call(CallFirst), prolog_repl)))))).
  289debug_repl_wo_cyc(Module,CallFirst):- !,         
  290          locally(t_l:useOnlyExternalDBs,
  291            locally_hide(baseKB:use_cyc_database,
  292               ((ain(tCol(person)),          
  293                ensure_mpred_file_loaded(logicmoo('rooms/startrek.all.pfc.pl')),
  294                 call_with_typein_and_source(Module,Module,(show_call(CallFirst), prolog_repl)))))).
  295
  296%  bug.. swi does not maintain context_module(CM) outside
  297%  of the current caller (so we have no idea what the real context module is!?!)
  298debug_repl_m(Module,CallFirst):- 
  299        context_module(CM),
  300          call_cleanup(
  301            (module(Module),
  302              debug_repl_wo_cyc(Module,CallFirst)),
  303            module(CM)).
  304
  305% [Required] Defines debug80
  306debug80:- parser_chat80_module(M),debug_repl_wo_cyc(M,M:t1).
  307
  308% [Optionaly] Allows testing/debug of the chat80 system (withouyt loading the servers)
  309% :- parser_chat80:t1.
  310
  311% [Required] Defines debug_e2c
  312debug_e2c:- debug_repl_wo_cyc(parser_e2c,cache_the_posms).
  313
  314
  315% [Required] Defines debug_talk
  316debug_talk:- debug_repl_wo_cyc(parser_talk,t3).
  317
  318
  319% [Optional] This loads boxer
  320% :- after_boot(locally(set_prolog_flag(subclause_expansion,false),within_user(ignore(catch(start_boxer,_,true))))).
  321
  322% [Optional] Testing PTTP
  323% :-is_startup_file('run_debug.pl')->doall(do_pttp_test(_));true.
  324
  325% Was this our startup file?
  326was_runs_tests_pl:-is_startup_file('run_tests.pl').
  327
  328% [Optional] Interactively debug E2C
  329% :- debug_e2c.
  330
  331
  332:- ain((mud_test_local :- cwc,if_defined(kellerStorage:kellerStorageTestSuite,true))).  333
  334% :-curt80.
  335
  336
  337% the real tests now (once)
  338:- ain((mud_test_local :- cwc,if_flag_true(was_runs_tests_pl,after_boot(must_det(run_mud_tests))))).  339
  340 % :- if_flag_true(was_runs_tests_pl, doall(now_run_local_tests_dbg)).
  341
  342
  343% [Optionaly] Allows testing/debug of the chat80 system (withouyt loading the servers)
  344% :- debug80.
  345/*
  346
  347explorer(player1)> prolog statistics
  348notice(you,begin(you,req1(statistics)))
  349statistics.
  350188.523 seconds cpu time for 282,024,744 inferences
  3511,004,265 atoms, 14,959 functors, 11,578 predicates, 176 modules, 268,104,937 VM-codes
  352
  353                       Limit    Allocated       In use
  354Local  stack :137,438,953,472      126,976       41,032 Bytes
  355Global stack :137,438,953,472  805,302,256  669,634,856 Bytes
  356Trail  stack :137,438,953,472      129,016        2,448 Bytes
  357
  3581 garbage collections gained 41,528 bytes in 0.000 seconds.
  3592 atom garbage collections gained 19,741 atoms in 1.360 seconds.
  360Stack shifts: 4 local, 22 global, 20 trail in 0.038 seconds.
  3612 threads, 0 finished threads used 0.000 seconds.
  362true.
  363
  364cmdresult(statistics,true)
  365
  366*/
  367
  368% :- kill_term_expansion.
  369% :- slow_work.
  370% :- prolog.
  371% :- now_run_local_tests_dbg.
  372% :- prolog.
  373
  374% :-foc_current_agent(P),assertz_if_new(agent_action_queue(P,chat80)).
  375:- if_flag_true(was_runs_tests_pl, runtime_boot(login_and_run)).  376
  377
  378% So scripted versions don't just exit
  379%:- if_flag_true(was_runs_tests_pl,after_boot(prolog)).
  380
  381%:- kill_term_expansion.
  382%:- prolog.
  383
  384% :-proccess_command_line.
  385
  386/*
  387If we ask, 'What is "Being"?', we keep within an understanding of the 'is', though we are unable to fix conceptionally what that 'is' signifies. We do not even know the horizon in terms of which that meaning is to be grasped and fixed. But irregardless we have this vague average understanding of Being is still a Fact.
  388
  389PTTP input formulas:
  390  1  firstOrder(motherOf,joe,sue).
  391  2  not_firstOrder(motherOf,_,A);firstOrder(female,A).
  392  3  not_firstOrder(sonOf,B,A);firstOrder(motherOf,A,B);firstOrder(fatherOf,A,B).
  393  4  query:-firstOrder(female,_).
  394PTTP to Prolog translation time: 0.0028555670000001143 seconds
  395
  396Prolog compilation time: 0.0004133299999997675 seconds
  3972.
  398Proof time: 4.34149999994915e-5 seconds
  399Proof:
  400length = 2, depth = 1
  401Goal#  Wff#  Wff Instance
  402-----  ----  ------------
  403  [0]    4   query :- [1].
  404  [1]    2      firstOrder(female,sue) :- [2].
  405  [2]    1         firstOrder(motherOf,joe,sue).
  406Proof end.
  407%                    succceeded(prove_timed(logicmoo_example1,query))
  408%                do_pttp_test(logicmoo_example1_holds)
  409
  410PTTP input formulas:
  411  1  firstOrder(motherOf,joe,sue).
  412  2  not_firstOrder(motherOf,_,A);firstOrder(female,A).
  413  3  not_firstOrder(sonOf,B,A);firstOrder(motherOf,A,B);firstOrder(fatherOf,A,B).
  414  4  query:-firstOrder(female,_).
  415PTTP to Prolog translation time: 0.0024834679999994336 seconds
  416
  417Prolog compilation time: 0.00039567500000003974 seconds
  4182.
  419Proof time: 3.7734999999372576e-5 seconds
  420Proof:
  421length = 2, depth = 1
  422Goal#  Wff#  Wff Instance
  423-----  ----  ------------
  424  [0]    4   query :- [1].
  425  [1]    2      firstOrder(female,sue) :- [2].
  426  [2]    1         firstOrder(motherOf,joe,sue).
  427Proof end.
  428%                    succceeded(prove_timed(logicmoo_example1_holds,query))
  429%                do_pttp_test(logicmoo_example2)
  430
  431
  432*/
  433
  434
  435% standard header used in all files that all modules are loaded (therefore useful for when(?) the day comes that modules *can*only*see their explicitly imported modules)
  436%:- prolog_flag(unknown,error,fail). % Not sure if this is needed for Quintus
  437%:- use_module(library(random)).
  438%:- use_module(library(date)).
  439% This one is for use with SWI
  440%:- use_module(library(quintus)).
  441
  442
  443% logicmoo utils shared with other systems
  444:- set_prolog_flag(double_quotes, atom).  445:- set_prolog_flag(double_quotes, string).  446
  447
  448% logicmoo vworld mud server
  449
  450:- ensure_loaded(prologmud(server/mud_telnet)).  451
  452
  453% :- ensure_loaded(('/root/lib/swipl/pack/prologmud/prolog/prologmud/actions/eat.pl')).
  454
  455
  456% :- ensure_loaded_no_mpreds(prologmud(server/mud_telnet)).
  457:- ensure_loaded(prologmud(server/mud_irc)).  458:- set_prolog_flag(expect_pfc_file,soon).  459:- if(app_argv1('--profile')).  460:- profile(ensure_loaded(prologmud('vworld/world.pfc'))).  461:- else.  462:- ensure_loaded(prologmud('vworld/world.pfc')).  463:- endif.  464
  465
  466:- ensure_loaded(prologmud(server/mud_testing)).  467
  468
  469/*
  470
  471 First time you run this 2 million clauses are qcompiled 
  472 (I've excluded 7 million more clauses that are only available with spec ial C Y C  Liciens ing)
  473
  474%     /devel/logicmoo/src_data/pldata/tiny_kb.pl *qcompiled* into tiny_kb 2.40 sec, 8,481 clauses
  475%     /devel/logicmoo/src_data/pldata/nldata_freq_pdat.pl *qcompiled* into nldata_freq_pdat 7.88 sec, 107,704 clauses
  476%     /devel/logicmoo/src_data/pldata/nldata_BRN_WSJ_LEXICON.pl *qcompiled* into nldata_BRN_WSJ_LEXICON 7.65 sec, 113,863 clauses
  477%     /devel/logicmoo/src_data/pldata/nldata_colloc_pdat.pl *qcompiled* into nldata_colloc_pdat 6.31 sec, 64,081 clauses
  478%     /devel/logicmoo/src_data/pldata/nldata_cycl_pos0.pl *qcompiled* into nldata_cycl_pos0 0.20 sec, 2,488 clauses
  479%     /devel/logicmoo/src_data/pldata/nldata_dictionary_some01.pl *qcompiled* into nldata_dictionary_some01 0.03 sec, 293 clauses
  480%     /devel/logicmoo/src_data/pldata/tt0_00022_cycl.pl *qcompiled* into tt0_00022_cycl 26.86 sec, 313,234 clauses
  481%     /devel/logicmoo/src_data/pldata/hl_holds.pl *qcompiled* into hl_holds 175.31 sec, 1,041,317 clauses
  482%     /devel/logicmoo/src_data/pldata/mworld0_declpreds.pl *qcompiled* into dbase 0.05 sec, 680 clauses
  483%     /devel/logicmoo/src_data/pldata/mworld0.pl *qcompiled* into mworld0 60.49 sec, 483,046 clauses
  484
  485  It took several minutes on my 24 core machine with 128gb ram on all SSDs as you can see.. 
  486
  487  But afterwards (the results next) .. it is able to load the system from .qlf in a mater of under 3 seconds!
  488
  489  No other SQL clone has been able to beat this .. Prolog uses 80% less ram and 10x times faster than
  490    any SQL indexing strategy I've for a large database (wtf? secret is all atoms are keys)  
  491   (The atom table (pointers to strings) is of no interest/use during join ops obviouslly.. 
  492     in which i have to do millions of join ops per semantic parse)
  493
  494%     pldata('tiny_kb') loaded into tiny_kb 0.02 sec, 9,016 clauses
  495%     pldata('nldata_freq_pdat') loaded into nldata_freq_pdat 0.10 sec, 107,709 clauses
  496%     pldata('nldata_BRN_WSJ_LEXICON') loaded into nldata_BRN_WSJ_LEXICON 0.09 sec, 113,868 clauses
  497%     pldata('nldata_colloc_pdat') loaded into nldata_colloc_pdat 0.06 sec, 64,086 clauses
  498%     pldata('nldata_cycl_pos0') loaded into nldata_cycl_pos0 0.00 sec, 2,479 clauses
  499%     pldata('nldata_dictionary_some01') loaded into nldata_dictionary_some01 0.00 sec, 264 clauses
  500%     pldata('tt0_00022_cycl') loaded into tt0_00022_cycl 0.28 sec, 313,287 clauses
  501%     pldata('hl_holds') loaded into hl_holds 1.31 sec, 1,041,321 clauses
  502%     pldata('mworld0_declpreds') loaded into dbase 0.00 sec, 679 clauses
  503%     pldata('mworld0') loaded into mworld0 0.60 sec, 483,058 clauses
  504
  505*/
  506
  507
  508% done in 'user' to avoid reloading when we reload dbase
  509ensure_q_loaded(File):-
  510    expand_file_search_path(pldata('mworld0_declpreds.pl'),Path),exists_file(Path),!,                                 
  511   '@'(load_files(File,[if(not_loaded),qcompile(auto),expand(true),derived_from(Path)]),user).
  512
  513make_qlfs:-
  514 %ensure_q_loaded(pldata('tiny_kb')),
  515 ensure_q_loaded(pldata('nldata_freq_pdat')),
  516 ensure_q_loaded(pldata('nldata_BRN_WSJ_LEXICON')),
  517 ensure_q_loaded(pldata('nldata_colloc_pdat')),
  518 ensure_q_loaded(pldata('nldata_cycl_pos0')),
  519 ensure_q_loaded(pldata('nldata_dictionary_some01')),
  520 % ensure_q_loaded(pldata('tt0_00022_cycl')),
  521 %ensure_q_loaded(pldata('hl_holds')),
  522 %ensure_q_loaded(pldata('mworld0')),
  523 %ensure_q_loaded(pldata('mworld0_declpreds')),
  524 nop(catch(ensure_q_loaded(pldata('withvars_988')),_,true)).
  525
  526% :- catch(pldata('mworld0_declpreds.qlf'),_,make_qlfs).
  527
  528
  529/*
  530
  531% done in 'user' to avoid reloading when we reload dbase
  532
  533:- include_prolog_files('../src_asserts/pldata/?*.pl').
  534
  535*/
  536
  537:-export(ensure_nl_loaded/1).  538system:ensure_nl_loaded(F):- baseKB:load_files([F],[expand(true),if(changed),qcompile(auto)]).
  539
  540% :- ensure_loaded(pldata(tiny_kb)).
  541/*
  542:- system:ensure_nl_loaded(pldata(nldata_freq_pdat)).
  543:- system:ensure_nl_loaded(pldata(nldata_BRN_WSJ_LEXICON)).
  544:- system:ensure_nl_loaded(pldata(nldata_colloc_pdat)).
  545:- system:ensure_nl_loaded(pldata(nldata_cycl_pos0)).
  546:- system:ensure_nl_loaded(pldata(nldata_dictionary_some01)).
  547:- system:ensure_nl_loaded(pldata(nldata_talk_db_pdat)).
  548*/
  549% :- ensure_loaded(pldata(tt0_00022_cycl)).
  550% :- ensure_loaded(pldata(hl_holds)).
  551% :- ensure_loaded(pldata(mworld0)).
  552% :- system:ensure_nl_loaded(pldata(transform_dump)).
  553% :- catch(ensure_loaded(pldata(withvars_988)),_,true).
  554download_and_install_el:-
  555  shell('wget -N http://logicmoo.org/devel/LogicmooDeveloperFramework/TEMP~/www.logicmoo.org/downloads/datafiles/PlDataBinary.zip',_),
  556  shell('unzip -u -d ../src_assets/pldata/PlDataBinary.zip'),
  557  catch(ensure_loaded(pldata(el_assertions)),E,fmt('Cant use el_assertions',E)).
  558
  559%:- xperimental_big_data->catch(ensure_loaded(pldata(el_assertions)),_,download_and_install_el);true.
  560
  561% :- asserta(lmcache:loaded_external_kbs(mud)),show_call(kbp_to_mpred_t).
  562
  563:- ensure_loaded(prologmud(parsing/parser_imperative)).  564:- ensure_loaded(prologmud(parsing/simple_decl_parser)). 
  565:- dynamic(baseKB:mudStowing/2).  566
  567/*
  568:- ensure_loaded(logicmoo(parsing/parser_talk)). 
  569:- ensure_loaded(logicmoo(parsing/parser_e2c)). 
  570:- ensure_loaded(logicmoo(parsing/parser_CURT)). 
  571:- ensure_loaded(logicmoo(parsing/parser_chat80)). 
  572*/
  573
  574%:- ensure_loaded(logicmoo(dbase/mpred_ext_lisp)).
  575%:- ensure_loaded(logicmoo(dbase/mpred_ext_chr)).
  576
  577include_prolog_file_mask(F):- 
  578  dmsg(include_prolog_file_mask(F)), 
  579  absolute_file_name(F,I),
  580  expand_file_name(I,O),
  581  maplist(ensure_mpred_file_loaded,O).
  582
  583
  584% NPC planners
  585:- ain(monitoredDiskFiles(prologmud('./mobs/?*.pl'))).  586:- ain(monitoredDiskFiles(prologmud('./actions/?*.pl'))).  587:- ain(monitoredDiskFiles(prologmud('./objs/?*.pl'))).  588
  589rescan_disk_files:- 
  590   forall(monitoredDiskFiles(Mask),include_prolog_file_mask(Mask)).
  591
  592:- multifile(prolog:make_hook/2).  593:- dynamic(prolog:make_hook/2).  594prolog:make_hook(after, []):- once(rescan_disk_files),fail.
  595
  596:- rescan_disk_files.  597
  598% Define the agents traits, both for your agent and the world inhabitants. 
  599% agent name and stats ([] = defaults).
  600% Agents with numbered names (eg. prey(1)) are able to be used multiple times.
  601% Just copy their line and increment the number to make more of them.
  602/*
  603:-create_agent(predator(1),[str(4),stm(2),height(2),spd(3)]).
  604:-create_agent(prey(1),[str(0),stm(-8),spd(1),height(1)]).
  605:-create_agent(prey(2),[str(0),stm(-8),spd(1),height(1)]).
  606:-create_agent(prey(3),[str(0),stm(-8),spd(1),height(1)]).
  607%:-create_agent(prey(4),[str(0),stm(-8),spd(1),height(1)]).
  608:-create_agent(monster(1),[str(6),stm(2),height(2),spd(1)]).
  609:-create_agent(monster(2),[str(6),stm(2),height(2),spd(1)]).
  610:-create_agent(explorer(1),[str(2),spd(4),stm(3),height(2)]).
  611:-create_agent(vacuum(1),[]).
  612:-create_agent(explorer(2),[]).
  613*/
  614
  615:- ain((baseKB:agent_text_command(Agent,["run",Term], Agent,actProlog(Term)):- ignore(Term=someCode))).  616
  617%:-forall(make_tabled_perm(get_all_templates(TEMPL)),dmsg(TEMPL)).
  618%:-forall(make_tabled_perm(grab_argsIsa(F,Types)),dmsg(grab_argsIsa(F,Types))).
  619
  620
  621% :- show_entry(ensure_mpred_file_loaded(prologmud(server/builtin))).
  622% :- must(rescan_pfc).
  623% :- show_entry(forall(filematch('./*/*.pfc.pl', X),(dmsg(ensure_mpred_file_loaded(X)),ensure_mpred_file_loaded(X)))).
  624
  625
  626% standard header used in all files that all modules are loaded (therefore useful for when(?) the day comes that modules *can*only*see their explicitly imported modules)
  627% :- include(prologmud(mud_header)).
  628
  629% These contain the definition of the object cols.
  630% Load the map file appropriate for the world being used.
  631% Load the mud files appropriate for the mobs being used.
  632
  633/*
  634:- show_entry(forall(filematch(prologmud('* /?*.pfc.pl'), X),dmsg(X))).
  635:- show_entry(ensure_mpred_file_loaded(prologmud('* /?*.pfc.pl'))).
  636:- show_entry(forall(filematch(prologmud('* / * /?*.pfc.pl'), X),dmsg(X))).
  637%:- show_entry(ensure_mpred_file_loaded(prologmud('* / * /?*.pfc.pl'))).
  638*/
  639
  640% puts world into running state
  641% :- must(old_setup).
  642
  643% [Optionaly] Start the telnet server
  644
  645
  646% standard footer to clean up any header defined states
  647:- include(prologmud(mud_footer)).  648/*
  649% Load datalog
  650:- if_flag_true(fullStart, ((ensure_loaded(logicmoo('des/des.pl')),
  651  flush_output,
  652  init_des,
  653  display_status,
  654 %  des,
  655   !))).
  656
  657*/
  658
  659
  660
  661% GOLOG SYSTEM WITHOUT FLUX (Default Commented Out)
  662%:- if_flag_true(fullStart,ensure_loaded(logicmoo('indigolog/indigolog_main_swi.pl'))).
  663
  664% FLUX AGENT SYSTEM WITHOUT GOLOG (Default Commented Out)
  665%:- if_flag_true(fullStart,ensure_loaded(logicmoo('indigolog/flux_main_swi.pl'))).
  666
  667% FLUX AGENT SYSTEM WITH GOLOG
  668% :- if_flag_true(true,ensure_loaded(logicmoo('indigolog/indigolog_main_swi_flux.pl'))).
  669
  670
  671% when we import new and awefull code base (the previous )this can be helpfull
  672% we redfine list_undefined/1 .. this is the old version
  673/*
  674lundef :- A = [],
  675       check:( merge_options(A, [module_class([user])], B),
  676        prolog_walk_code([undefined(trace), on_trace(found_undef)|B]),
  677        findall(C-D, retract(undef(C, D)), E),
  678        (   E==[]
  679        ->  true
  680        ;   print_message(warning, check(undefined_predicates)),
  681            keysort(E, F),
  682            group_pairs_by_key(F, G),
  683            maplist(report_undefined, G)
  684        )).
  685*/
  686% :- if_flag_true(fullStart,remove_undef_search).
  687
  688
  689/*
  690  ==
  691  ?- [library(mudconsole)].
  692  ?- mc_start.				% opens browser
  693
  694   or else http_mud_server
  695
  696  ?- mc_format('Hello ~w', [world]).
  697  ?- mc_html(p(['Hello ', b(world)])).
  698  ?- mc_ask([age(Age)], [p('How old are you'), input([name(age)])]).
  699  Age = 24.				% col 24 <enter>
  700  ==
  701
  702*/
  703
  704%:-mred_untrace.
  705%:-mred_no_spy_all.
  706%.
  707
  708==> tSourceCode(iSourceCode7).
  709:- current_prolog_flag(pfc_booted,true).  710% should happen *after game loaded %
  711% :- set_prolog_flag(assert_attvars,true).
  712:- ain(isLoaded(iSourceCode7)).