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% Marty's Tokenizer/Scanner/Lexer, written in Prolog.
   20:- module(adv_io,[
   21 read_line_to_tokens/4,
   22 clear_overwritten_chars/1,
   23 is_main_console/0,
   24 overwrote_prompt/1,ensure_has_prompt/1,
   25 player_format/2,
   26 player_format/3,
   27 bugout3/2,
   28 bugout1/1,
   29 bugout3/3,
   30 with_tty/2,
   31 pprint/2,
   32 init_logging/0,
   33 stop_logging/0,
   34 bug/1,
   35 agent_to_input/2,
   36 agent_to_output/2,
   37 get_overwritten_chars/2,
   38 restore_overwritten_chars/1,
   39 %setup_console/0, 
   40 setup_console/1,
   41
   42 our_current_portray_level/1,
   43
   44 current_error/1,set_error/1, redirect_error_to_string/2
   45   
   46   /*post_message/1,
   47   post_message/2,
   48   sv_message/2,
   49   svo_message/3,
   50   svi_message/3,
   51   svoi_message/4,*/ ]).   52
   53:- dynamic(adv:wants_quit/3).   54:- dynamic(adv:console_tokens/2).   55:- dynamic(adv:console_io_player/3).   56:- volatile(adv:console_io_player/3).   57
   58
   59
   60current_error(Stream) :- stream_property(Stream, alias(user_error)), !. % force det. 
   61current_error(Stream) :- stream_property(Stream, alias(current_error)), !. % force det. 
   62current_error(Stream) :- stream_property(Stream, file_no(2)), !. % force det. 
   63set_error(Stream) :- set_stream(Stream, alias(user_error)). 
   64
   65:- meta_predicate redirect_error_to_string(0,-).   66redirect_error_to_string(Goal, String) :- 
   67  current_error(OldErr),
   68  new_memory_file(Handle),  
   69  setup_call_cleanup( 
   70   open_memory_file(Handle, write, Err),
   71   setup_call_cleanup( 
   72    set_error(Err),
   73    (once(Goal),
   74     flush_output(Err)), 
   75    set_error(OldErr)), 
   76   close(Err)),
   77  memory_file_to_string(Handle,String).
   78
   79
   80user:setup_console :- current_input(In),setup_console(In).
   81
   82:- dynamic(adv:has_setup_setup_console/1).   83:- volatile(adv:has_setup_setup_console/1).   84
   85setup_console(In):- adv:has_setup_setup_console(In),!.
   86setup_console(In):- 
   87 assert(adv:has_setup_setup_console(In)),
   88 set_prolog_flag(color_term, true),
   89 ensure_loaded(library(prolog_history)),
   90 (current_prolog_flag(readline,X)-> ensure_loaded(library(X));ensure_loaded(library(editline))),
   91 %ensure_loaded(library(editline)),
   92 '$toplevel':(
   93   
   94  setup_colors,
   95  setup_history,
   96  setup_readline),!.
   97
   98
   99:- dynamic(adv:input_log/1).  100init_logging :- !.
  101init_logging :-
  102 get_time(StartTime),
  103 convert_time(StartTime, StartTimeString),
  104 open('~/.nomic_mu_input.log', append, FH),
  105 format(FH, '\n==== ADVENTURE INPUT, ~w\n', [StartTimeString]),
  106 asserta(adv:input_log(FH)).
  107stop_logging :-
  108 adv:input_log(FH) -> close(FH) ; true.
  109
  110% :- dynamic(bugs/1). % Types of logging output.
  111%bugs([general, printer, planner, autonomous]).
  112bug_contexts([always, general, planner, autonomous, telnet, general, parser, printer]).
  113:- bug_contexts(List),foreach(member(E,List),debug(adv(E))).  114:- debug(adv_skip(printer)).  115:- debug(adv(unknown)).  116:- nodebug(adv(unknown)).  117:- debug(adv(all)).  118%bugs([general, autonomous]).
  119
  120bug(B) :- debugging(B,false),!,fail.
  121bug(B) :- debugging(adv_skip(B),true),!,fail.
  122bug(_) :- debugging(adv_skip(all),true),!,fail.
  123bug(_) :- debugging(adv(all)).
  124bug(B) :- debugging(adv(B),YN),!,YN.
  125bug(_) :- debugging(adv(unknown),YN),!,YN.
  126
  127bugout1(L) :- bugout3('~q', [L], always).
  128
  129bugout3(A, B) :- bugout3('~q', [A], B).
  130
  131bugout3(A, L, B) :-
  132 bug(B),
  133 !,
  134 must_det(maplist(simplify_dbug, L, LA)),
  135 ansi_format([fg(cyan)], '~N% ', []), ansi_format([fg(cyan)], A, LA),
  136 must_det((stdio_player(Player),overwrote_prompt(Player))),!.
  137bugout3(_, _, _).
  138
  139      
  140%:- set_stream(user_input,buffer_size(1)).
  141%:- set_stream(user_input,buffer(none)).
  142%:- set_stream(user_input,timeout(0.1)).
  143
  144
  145pprint(Term, B) :-
  146 bug(B),
  147 !,
  148 player_format('~N~@~N',[our_pretty_printer(Term)]),!.
  149pprint(_, _).
  150
  151:- use_module(library(logicmoo/portray_vars)).  152
  153:- flag(our_pretty_printer,_,0).  154our_current_portray_level(Level) :- flag(our_pretty_printer,Was,Was),Was=Level.
  155:- export(our_current_portray_level/1).  156%our_pretty_printer(Term):- !, fmt90(Term).
  157our_pretty_printer(Term):- compound(Term),
  158 \+ \+ setup_call_cleanup( flag(our_pretty_printer,Was,Was+1),
  159                     \+ \+ our_prolog_pretty_print(Term),
  160                     flag(our_pretty_printer,_,Was)).
  161% our_pretty_printer(Term):- format(current_output,'~w',[Term]).
  162our_pretty_printer(Term):- fmt90(Term).
  163
  164our_prolog_pretty_print(Term):- 
  165  pretty_numbervars(Term,Term2),
  166  prolog_pretty_print:print_term(Term2, [ output(current_output)]).
  167
  168
  169:- export(stdio_player/1).  170stdio_player(Agent):- nonvar(Agent),!, stdio_player(AgentWas), !, AgentWas == Agent.
  171stdio_player(Agent):- stream_property(InStream, fileno(0)), adv:console_io_player(InStream, _, Agent),!.
  172stdio_player(Agent):- 
  173  Agent = 'player~1',
  174 \+ adv:console_io_player(_, _, Agent). 
  175
  176:- thread_local(adv:current_agent_tl/1).  177current_player(Agent):- current_agent(AgentWas),!,AgentWas= Agent.
  178
  179current_agent(Agent):- current_agent_(AgentWas),!,AgentWas= Agent.
  180:- export(current_agent/1).  181current_agent_(Agent):- adv:current_agent_tl(Agent),!.
  182current_agent_(Agent):- current_input(InStream),adv:console_io_player(InStream, _, Agent).
  183current_agent_(Agent):- current_output(OutStream),adv:console_io_player(_, OutStream, Agent).
  184%current_agent_(Agent):- thread_self(Id),adv:console_host_io_history_unused(Id,_Alias,_InStream,_OutStream,_Host,_Peer, Agent).
  185current_agent_('player~1').
  186
  187:- dynamic(adv:need_redraw/1).  188overwrote_prompt(Agent):- retractall(adv:need_redraw(Agent)), asserta(adv:need_redraw(Agent)),!.
  189
  190ensure_has_prompt(Agent):-  
  191 ignore((retract(adv:need_redraw(Agent)),
  192  ttyflush,
  193  player_format(Agent,'~N~w@spatial> ',[Agent]),retractall(adv:need_redraw(Agent)))),
  194  ttyflush.
  195
  196
  197player_format(Fmt,List):-
  198 current_agent(Agent) ->
  199 notrace(player_format(Agent, Fmt, List)).
  200
  201player_format(Agent,Fmt,List):-
  202 agent_to_output(Agent,OutStream),
  203 must_det(format(OutStream,Fmt,List)),!,
  204 overwrote_prompt(Agent).
  205player_format(Agent,Fmt,List):- must_det(format(Fmt,List)),
  206 overwrote_prompt(Agent).
  207
  208
  209
  210
  211:- dynamic user:portray/1.  212:- multifile user:portray/1.  213:- module_transparent user:portray/1.  214user:portray(Logic) :- fail,  
  215 compound(Logic), 
  216 our_current_portray_level(Level),
  217 our_portray_at_level(Level, Logic),!.
  218
  219our_portray_at_level(Level,Logic):- 
  220 Level<2,
  221 our_pretty_printer(Logic).
  222
  223%user:portray(ItemToPrint) :- print_item_list(ItemToPrint). % called by print.
  224
  225
  226
  227identifer_code(Char) :- char_type(Char, csym).
  228identifer_code(Char) :- char_type(Char,to_lower('~')).
  229identifer_code(Char) :- memberchk(Char, `-'`).
  230
  231punct_code(Punct) :- memberchk(Punct, `,.?;:!&\"`), !. % '
  232punct_code(Punct) :- \+ identifer_code(Punct), char_type(Punct, graph).
  233
  234% -- Split a list of chars into a leading identifier and the rest.
  235% Fails if list does not start with a valid identifier.
  236identifier([-1|_String], _, _) :- !, fail. % char_type pukes on -1 (EOF)
  237identifier([Char|String], [Char|Tail], Rest) :-
  238 identifer_code(Char),
  239 identifier1(String, Tail, Rest).
  240
  241identifier1(String, Id, Rest) :-
  242 identifier(String, Id, Rest), !.
  243identifier1(String, [], String).
  244
  245% -- Split a list of chars into a leading token and the rest.
  246% Fails if list does not start with a valid token.
  247token(String, Token, Rest) :-
  248 identifier(String, Token, Rest), !. % Is it an identifier?
  249%token(String,id(Atom),Rest) :-
  250% identifier(String, Text, Rest), !, atom_codes(Atom,Text).
  251token([Punct|Rest], [Punct], Rest) :-
  252 %char_type(Punct, punct), !. % Is it a single char token?
  253 punct_code(Punct), !. 
  254
  255% -- Completely tokenize a string.
  256% Ignores unrecognized characters.
  257tokenize([],[]) :- !.
  258tokenize([-1],[`quit`]) :- !.
  259tokenize(String, [Token|Rest]) :-
  260 token(String, Token, Tail),
  261 !,
  262 tokenize(Tail, Rest).
  263tokenize([_BadChar|Tail], Rest) :-
  264 !,
  265 tokenize(Tail, Rest).
  266
  267log_codes([-1]).
  268log_codes(_) :- \+ adv:input_log(_),!.
  269log_codes(LineCodes) :-
  270 ignore(notrace(catch((atom_codes(Line, LineCodes),
  271 adv:input_log(FH),
  272 format(FH, '>~w\n', [Line])),_,true))).

 skip_to_nl(+Input) is det

Read input after the term. Skips white space and %... comment until the end of the line or a non-blank character.

  280skip_to_nl(In) :-
  281 repeat,
  282 peek_char(In, C),
  283 ( C == '%'
  284 -> skip(In, '\n')
  285 ; char_type(C, space)
  286 -> get_char(In, _),
  287  C == '\n'
  288 ; true
  289 ),
  290 !.
  291
  292
  293:- meta_predicate with_tty(+,0).  294with_tty(In,Goal):- 
  295 stream_property(In,tty(Was)),
  296 stream_property(In,timeout(TWas)), 
  297 New = '', % format(atom(New),'~w@spatial> ',[Agent]),
  298 setup_call_cleanup(( 
  299 set_stream(In, tty(true)),set_stream(In, timeout(infinite))), 
  300  setup_call_cleanup(prompt(Old,New),
  301  (%skip_to_nl(In),
  302  Goal), prompt(_,Old)),
  303 (set_stream(In, timeout(TWas)),set_stream(In, tty(Was)))),!.
  304         
  305% -- Input from stdin, convert to a list of atom-tokens.
  306
  307read_line_to_tokens(_Agent,In,Prev,Tokens):- 
  308 setup_console(In),
  309 with_tty(In,
  310            (read_line_to_codes(In,LineCodesR),read_pending_input(In,_,[]))), 
  311 append(Prev,LineCodesR,LineCodes),
  312 NegOne is -1,  
  313 must_det(line_to_tokens(LineCodes,NegOne,Tokens0)),!,
  314 must_det(Tokens0=Tokens).
  315
  316line_to_tokens([],_,[]):-!.
  317line_to_tokens(NegOne,NegOne,end_of_file):-!.
  318line_to_tokens([NegOne],NegOne,end_of_file):-!.
  319
  320line_to_tokens(LineCodes,NegOne,Tokens) :- 
  321 append([L],NewLineCodes,LineCodes),
  322 member(L,[10,13,32]),!,
  323 line_to_tokens(NewLineCodes,NegOne,Tokens).
  324line_to_tokens(LineCodes,NegOne,Tokens) :- 
  325 append(NewLineCodes,[L],LineCodes),
  326 member(L,[10,13,32]),!,
  327 line_to_tokens(NewLineCodes,NegOne,Tokens).
  328
  329line_to_tokens(LineCodes,_NegOne,Tokens) :- 
  330 last(LineCodes,L),
  331 memberchk(L,[46, 41|`.)`]), 
  332 notrace(catch((read_term_from_codes(LineCodes,Term,
  333  [syntax_errors(error),var_prefix(false),
  334  % variables(Vars),
  335  variable_names(VNs),cycles(true),dotlists(true),singletons(_)])),_,fail)),
  336 nb_setval('$variable_names',VNs),
  337 Tokens=Term,!.
  338
  339line_to_tokens(LineCodes,_,Tokens):- 
  340 ignore(log_codes(LineCodes)),!,
  341 tokenize(LineCodes, TokenCodes),!,
  342 % Convert list of list of codes to list of atoms:
  343 findall(Atom, (member(Codes, TokenCodes), atom_codes(Atom, Codes)), Tokens), 
  344 nop(save_to_history(LineCodes)),
  345 !.
  346
  347:- multifile(prolog:history/2).  348save_to_history(LineCodes):- 
  349 ignore(notrace((
  350 atom_string(AtomLineCodes,LineCodes), 
  351 current_input(In),
  352 % dmsg(LineCodes->AtomLineCodes),
  353 ignore(catch('$save_history_line'(AtomLineCodes),_,true)),
  354 ignore(catch(prolog:history(user_input, add(AtomLineCodes)), _, true)),
  355 ignore(catch(prolog:history(In, add(AtomLineCodes)), _, true))))).
  356
  357
  358:- dynamic(overwritten_chars/2).  359:- volatile(overwritten_chars/2).  360
  361add_pending_input(Agent,C):- agent_to_input(Agent,In),add_pending_input0(In,C).
  362add_pending_input0(In,C):- retract(overwritten_chars(In,SoFar)),append(SoFar,[C],New),!,assert(overwritten_chars(In,New)).
  363add_pending_input0(In,C):- assert(overwritten_chars(In,[C])).
  364
  365clear_overwritten_chars(Agent):- agent_to_input(Agent,In),retractall(overwritten_chars(In,_SoFar)).
  366restore_overwritten_chars(Agent):- agent_to_input(Agent,In),overwritten_chars(In,SoFar),format('~s',[SoFar]).
  367
  368
  369stream_pairs(In,Out):- nonvar(In), var(Out), stream_property(In,file_no(F)),stream_property(Out,file_no(F)),stream_property(Out,output),!.
  370stream_pairs(In,Out):- nonvar(Out), var(In), stream_property(Out,file_no(F)),stream_property(In,file_no(F)),stream_property(In,input),!.
  371stream_pairs(In,Out):- adv:console_io_player(In,Out, _Agent).
  372stream_pairs(In,Out):- var(In), !, stream_property(Out, input), \+ stream_property(Out, file_name(_)), once(stream_pairs(In,Out)), \+ using_stream_in(In,_OtherAgent).
  373%stream_pairs(In,Out):- var(Out), !, stream_property(Out, output), \+ stream_property(Out, fileno(2)), once(stream_pairs(In,Out)), \+ using_stream_in(In,_OtherAgent).
  374
  375using_stream_in(Stream,OtherAgent):- adv:console_io_player(Stream, _, OtherAgent).
  376%using_stream_in(Stream,OtherAgent):- adv:console_host_io_history_unused(_Id,_Alias,Stream,_Out,_Host, _Peer, OtherAgent), \+ adv:console_io_player(Stream, OtherAgent).
  377
  378using_stream(Stream,OtherAgent):- using_stream_in(Stream,OtherAgent).
  379using_stream(Stream,OtherAgent):- adv:console_io_player(_, Stream, OtherAgent).
  380
  381agent_to_output(Agent, Stream):- adv:console_io_player(_, Stream, Agent).
  382agent_to_output(Agent, Stream):- adv:console_io_player(InStream, _, Agent),stream_pairs(InStream, Stream).
  383agent_to_output(_Agent,Stream):- current_output(Stream), \+ using_stream(Stream,_Other),!.
  384agent_to_output(_Agent,Stream):- stream_property(Stream, file_no(1)), \+ using_stream(Stream,_Other),!.
  385agent_to_output(Agent, Stream):- fail, agent_to_input(Agent,In), stream_property(In,file_no(F)),stream_property(Stream,file_no(F)),stream_property(Stream,write),!.
  386agent_to_output(Agent, Stream):- throw(agent_io(Agent,agent_to_output(Agent, Stream))).
  387%agent_to_output(Agent, Stream):- adv:console_host_io_history_unused(_Id,_Alias,_In,Stream,_Host, _Peer, Agent),!.
  388       
  389% agent_to_input(Agent,In):- overwritten_chars(Agent,_SoFar),In=Agent,
  390agent_to_input(Agent, Stream):- using_stream_in(Stream,Agent),!.
  391agent_to_input(_Agent,Stream):- current_input(Stream), \+ using_stream(Stream,_Other),!.
  392agent_to_input(_Agent,Stream):- stream_property(Stream, file_no(0)), \+ using_stream(Stream,_Other),!.
  393agent_to_input(Agent, Stream):- fail, agent_to_output(Agent,Stream), stream_property(Stream,file_no(F)),stream_property(Stream,file_no(F)),stream_property(Stream,read),!.
  394agent_to_input(Agent, Stream):- throw(agent_io(Agent,agent_to_input(Agent, Stream))).
  395%agent_to_input(Agent, Stream):- adv:console_host_io_history_unused(_Id,_Alias,Stream,_Out,_Host, _Peer, Agent),!.
  396
  397is_main_console:- current_input(Stream), stream_property(Stream, file_no(0)).
  398
  399user:ci:- ci('telnet~1').
  400user:ci(Agent):- 
  401 agent_to_input(Agent,In),
  402 agent_to_output(Agent,Out),
  403 forall(stream_property(In,P),bugout1(ins(P))),
  404 listing(overwritten_chars),
  405 %line_position(In,LIn),
  406 %bugout1(ins(line_position(In,LIn))),
  407 forall(stream_property(Out,P),bugout1(outs(P))),
  408 line_position(Out,LInOut),!,bugout1(outs(line_position(Out,LInOut))),!.
  409
  410get_overwritten_chars(Agent,Chars):- agent_to_input(Agent,In),overwritten_chars(In,Chars).
  411get_overwritten_chars(_Agent,[]).
  412
  413
  414wordlist(List) --> optional_ws, wordlist1(List), optional_ws.
  415optional_ws --> whitespace.
  416optional_ws --> {true}.
  417wordlist1(List) --> wordlist2(List).
  418wordlist1([]) --> {true}.
  419wordlist2([X|Y]) --> word(X), whitespace, wordlist2(Y).
  420wordlist2([X]) --> word(X).
  421%wordlist([X|Y]) --> word(X), whitespace, wordlist(Y).
  422%wordlist([X]) --> whitespace, wordlist(X).
  423%wordlist([X]) --> word(X).
  424%wordlist([X]) --> word(X), whitespace.
  425
  426%word(W) --> charlist(X), {name(W,X)}.
  427word(W) --> charlist(X), {atom_codes(W,X)}.
  428
  429charlist([X|Y]) --> chr(X), charlist(Y).
  430charlist([X]) --> chr(X).
  431
  432chr(X) --> [X], {X>=48}.
  433
  434whitespace --> whsp, whitespace.
  435whitespace --> whsp.
  436
  437whsp --> [X], {X<48}.
  438
  439:- initialization(setup_console,program).  440
  441:- initialization(setup_console,restore).