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
   20:- module(mu, [srv_mu/0, run_mu/0]).   21
   22% nohup websocket_redir.sh dbutterfly 2666 &
   23
   24:- if(\+ exists_source(library(poor_bugger))).   25:- prolog_load_context(file,File),
   26   absolute_file_name('.',X,[relative_to(File),file_type(directory)]),
   27   asserta(user:file_search_path(library,X)).   28:- endif.   29
   30:- pack_install(dictoo).   31
   32:- ensure_loaded('./marty_white/adv_telnet').   33:- ensure_loaded('./marty_white/adv_main').   34%:- use_module(library(dialect/ifprolog),except([time/1])).
   35%:- use_module('./chat80').
   36
   37%:- ensure_loaded('./adv_chat80').
   38
   39mu_port(2666).
   40
   41srv_mu(TwoSixSixSix) :-
   42  atom_concat('mu_',TwoSixSixSix,Alias),
   43  thread_property(_,alias(Alias)),!,  
   44  format('~NServer should be running on port ~w~n',[TwoSixSixSix]),
   45  threads, !.
   46
   47srv_mu(TwoSixSixSix) :- 
   48  adv_server(TwoSixSixSix),
   49  format('~NServer is starting on port ~w~n',[TwoSixSixSix]),
   50  threads,
   51  !.
   52  
   53srv_mu:-
   54  mu_port(TwoSixSixSix),
   55  srv_mu(TwoSixSixSix),
   56  run_mu.
   57
   58run_mu:- 
   59   setup_console,
   60   must(adventure),!.
   61
   62
   63usage_mu:- format('~N
   64You may start the server with:
   65
   66 ?- srv_mu.
   67
   68',[]).
   69
   70
   71  
   72
   73:- initialization(srv_mu, main).   74
   75:- initialization(usage_mu).