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,[readtokens/3,readline/2,
   21   clear_overwritten_chars/1,
   22   readtokens/1,
   23   redraw_prompt/1,
   24   player_format/2,
   25   player_format/3,
   26   bugout/2,
   27   bugout/3,
   28
   29   pprint/2,
   30   init_logging/0,
   31   bug/1,
   32   agent_to_input/2,
   33   get_overwritten_chars/2,
   34   restore_overwritten_chars/1]).   35
   36:- use_module(library(editline)).   37:- initialization('$toplevel':setup_readline,now).   38
   39:- dynamic(adv:input_log/1).   40init_logging :-
   41  get_time(StartTime),
   42  convert_time(StartTime, StartTimeString),
   43  open('input.log', append, FH),
   44  format(FH, '\n==== ADVENTURE INPUT, ~w\n', [StartTimeString]),
   45  asserta(adv:input_log(FH)).
   46
   47:- dynamic(bugs/1). % Types of logging output.
   48%bugs([general, printer, planner, autonomous]).
   49bugs([general, planner, autonomous, telnet]).
   50%bugs([general, autonomous]).
   51bug(B) :-
   52  bugs(L),
   53  member(B, L).
   54
   55bugout(A, B) :-
   56  bug(B),
   57  !,
   58  dbug(B:A).
   59bugout(_, _).
   60
   61bugout(A, L, B) :-
   62  bug(B),
   63  !,
   64  dmust(maplist(simplify_dbug, L, LA)),
   65  ansi_format([fg(cyan)], '~N% ', []),
   66  ansi_format([fg(cyan)], A, LA),
   67  dmust((console_player(Player),redraw_prompt(Player))),!.
   68bugout(_, _, _).
   69
   70
   71:- export(simplify_dbug/2).   72simplify_dbug(G,GG):- \+ compound(G),!,GG=G.
   73simplify_dbug({O},{O}):- !.
   74simplify_dbug(List,O):-
   75 ( is_list(List) -> clip_cons(List,'...'(_),O) ;
   76   ( List = [_|_], append(LeftSide,Open,List),
   77     Open \= [_|_], !, assertion(is_list(LeftSide)),
   78   clip_cons(LeftSide,'...'(Open),O))).
   79simplify_dbug(G,GG):- compound_name_arguments(G,F,GL), F\==sense_props, !,
   80  maplist(simplify_dbug,GL,GGL),!,compound_name_arguments(GG,F,GGL).
   81simplify_dbug(G,G).
   82is_state_list(G,_):- \+ compound(G),!,fail.
   83is_state_list([G1|_],{GG,'...'}):- compound(G1),G1=structure_label(GG),!.
   84is_state_list([_|G],GG):- is_state_list(G,GG).
   85clip_cons(G,GG):- is_state_list(G,GG),!.
   86clip_cons(List,ClipTail,{Len,Left,ClipTail}):- 
   87   length(List,Len),
   88   MaxLen = 5, Len>MaxLen,
   89   length(Left,MaxLen),
   90   append(Left,_,List),!.
   91clip_cons(List,_,List).
   92
   93
   94pprint(Term, B) :-
   95  bug(B),
   96  !,
   97  player_format('~N~@~N',[prolog_pretty_print:print_term(Term, [output(current_output)])]),!.
   98pprint(_, _).
   99
  100/*
  101redraw_prompt(Agent):- (Agent == 'floyd~1'),
  102
  103redraw_prompt(_Agent):- 
  104 % console_player(Player),
  105   current_player(Player),
  106   player_format(Player,'~w@spatial> ',[Player]),!.
  107*/
  108redraw_prompt(Agent):- (Agent \== 'floyd~1'),!, 
  109  player_format(Agent,'~w@spatial> ',[Agent]),!.
  110redraw_prompt(_Agent).
  111
  112player_format(Fmt,List):-
  113  current_player(Agent) ->
  114  notrace(player_format(Agent, Fmt,List)).
  115
  116player_format(Agent,Fmt,List):-
  117  agent_output(Agent,OutStream),
  118  dmust(format(OutStream,Fmt,List)),!.
  119player_format(_, Fmt,List):- dmust(format(Fmt,List)).
  120
  121
  122agent_output(Agent,OutStream):- 
  123  adv:console_info(_Id,_Alias,_InStream,OutStream,_Host,_Peer, Agent).
  124
  125
  126
  127
  128
  129
  130
  131identifer_code(Char) :- char_type(Char, csym).
  132identifer_code(Char) :- char_type(Char,to_lower('~')).
  133identifer_code(Char) :- memberchk(Char, `-'`).
  134
  135punct_code(Punct) :- memberchk(Punct, `,.?;:!&\"`), !.
  136punct_code(Punct) :- \+ identifer_code(Punct), char_type(Punct, graph).
  137
  138% -- Split a list of chars into a leading identifier and the rest.
  139% Fails if list does not start with a valid identifier.
  140identifier([-1|_String], _, _) :- !, fail. % char_type pukes on -1 (EOF)
  141identifier([Char|String], [Char|Tail], Rest) :-
  142  identifer_code(Char),
  143  identifier1(String, Tail, Rest).
  144
  145identifier1(String, Id, Rest) :-
  146  identifier(String, Id, Rest), !.
  147identifier1(String, [], String).
  148
  149% -- Split a list of chars into a leading token and the rest.
  150% Fails if list does not start with a valid token.
  151token(String, Token, Rest) :-
  152  identifier(String, Token, Rest), !.  % Is it an identifier?
  153%token(String,id(Atom),Rest) :-
  154%  identifier(String, Text, Rest), !, atom_codes(Atom,Text).
  155token([Punct|Rest], [Punct], Rest) :-
  156  %char_type(Punct, punct), !.  % Is it a single char token?
  157  punct_code(Punct), !. 
  158
  159% -- Completely tokenize a string.
  160% Ignores unrecognized characters.
  161tokenize([],[]) :- !.
  162tokenize([-1],[`quit`]) :- !.
  163tokenize(String, [Token|Rest]) :-
  164  token(String, Token, Tail),
  165  !,
  166  tokenize(Tail, Rest).
  167tokenize([_BadChar|Tail], Rest) :-
  168  !,
  169  tokenize(Tail, Rest).
  170
  171log_codes([-1]).
  172log_codes(LineCodes) :-
  173  atom_codes(Line, LineCodes),
  174  adv:input_log(FH),
  175  format(FH, '>~w\n', [Line]).
  176
  177% -- Input from stdin, convert to a list of atom-tokens.
  178
  179readtokens(Tokens) :- current_player(Agent),readtokens(Agent,[],Tokens).
  180
  181readtokens(In,Prev,Tokens):- 
  182  assertion(is_stream(In)),!,
  183  New = '',
  184  setup_call_cleanup(prompt(Old,New),
  185     read_line_to_tokens(In,Prev,Tokens),
  186     prompt(_,Old)),
  187  !.
  188
  189read_line_to_tokens(In,Prev,Tokens):- 
  190  read_line_to_codes(In,LineCodesR), 
  191  append(Prev,LineCodesR,LineCodes),
  192  NegOne is -1,     
  193  dmust(line_to_tokens(LineCodes,NegOne,Tokens0)),!,
  194  dmust(Tokens0=Tokens).
  195
  196line_to_tokens([],_,[]):-!.
  197line_to_tokens(NegOne,NegOne,[quit]):-!.
  198line_to_tokens([NegOne],NegOne,[quit]):-!.
  199line_to_tokens(LineCodes,_NegOne,Tokens) :- 
  200    append(_NewLineCodes,[L],LineCodes),
  201    member(L,[46]),read_term_from_codes(LineCodes,Term,
  202     [syntax_errors(fail),var_prefix(false),
  203        % variables(Vars),
  204        variable_names(_VNs),cycles(true),dotlists(true),singletons(_)]),
  205    Term=..Tokens,!.
  206line_to_tokens(LineCodes,NegOne,Tokens) :- 
  207  append(NewLineCodes,[L],LineCodes),
  208  member(L,[10,13,32,46]),!,
  209  line_to_tokens(NewLineCodes,NegOne,Tokens).
  210line_to_tokens(LineCodes,_,Tokens):- 
  211  ignore(log_codes(LineCodes)),!,
  212  tokenize(LineCodes, TokenCodes),!,
  213  % Convert list of list of codes to list of atoms:
  214  findall(Atom, (member(Codes, TokenCodes), atom_codes(Atom, Codes)), Tokens),  
  215  save_to_history(LineCodes),
  216  !.
  217
  218save_to_history(LineCodes):- 
  219  ignore(notrace((atom_codes(AtomLineCodes, LineCodes), 
  220  catch(prolog:history(current_input, add(AtomLineCodes)), _, fail)))).
  221
  222
  223
  224/*
  225readlist(Agent,L) :-  % return a line of input, split into a list of words.
  226  readline(Agent,CL),
  227  wordlist(L, CL, []),
  228  !.
  229*/
  230
  231:- dynamic(overwritten_chars/2).  232
  233add_pending_input(Agent,C):- agent_to_input(Agent,In),add_pending_input0(In,C).
  234add_pending_input0(In,C):- retract(overwritten_chars(In,SoFar)),append(SoFar,[C],New),!,assert(overwritten_chars(In,New)).
  235add_pending_input0(In,C):- assert(overwritten_chars(In,[C])).
  236
  237clear_overwritten_chars(Agent):- agent_to_input(Agent,In),retractall(overwritten_chars(In,_SoFar)).
  238restore_overwritten_chars(Agent):- agent_to_input(Agent,In),overwritten_chars(In,SoFar),format('~s',[SoFar]).
  239
  240% agent_to_input(Agent,In):- overwritten_chars(Agent,_SoFar),In=Agent,
  241agent_to_input(Agent,In):- adv:console_info(_Id,_Alias,In,_OutStream,_Host, _Peer, Agent),!.
  242% agent_to_input(Agent,In):- stream_or_alias(In,Alias), stream_property(Agent,file_no(F)),stream_property(In,file_no(F)),stream_property(In,read),!.
  243agent_to_input(_Agent,In):- current_input(In).
  244
  245user:bi:- agent_to_input('telnet~1',In),
  246   forall(stream_property(In,P),dbug(ins(P))),
  247   %line_position(In,LIn),
  248   %dbug(ins(line_position(In,LIn))),
  249   forall(stream_property('telnet~1',P),dbug(outs(P))),listing(overwritten_chars),
  250   line_position('telnet~1',LInOut),!,
  251   dbug(outs(line_position('telnet~1',LInOut))),!.
  252
  253get_overwritten_chars(Agent,Chars):- agent_to_input(Agent,In),overwritten_chars(In,Chars).
  254get_overwritten_chars(_Agent,[]).
  255
  256% readline(Agent,[]):- agent_to_input(Agent,In),at_end_of_stream(In),clear_overwritten_chars(Agent).
  257readline(Agent,L) :-  % return a line of input as a list of ASCII codes.
  258  % current_input(X),(overwritten_chars(In,Chars)->true;Chars=[]),
  259  clear_overwritten_chars(Agent),
  260  agent_to_input(Agent,In),
  261  stream_property(In,buffer(Was)),
  262  set_stream(In,buffer(false)),
  263  call_cleanup(((
  264  get0(In,C), add_pending_input(Agent,C),
  265    readlinetail(Agent,C, L))),
  266    set_stream(In,buffer(Was))),!.  
  267
  268readlinetail(Agent,13, []):- clear_overwritten_chars(Agent).
  269readlinetail(Agent,10, []):- clear_overwritten_chars(Agent).
  270readlinetail(Agent,-1, [-1]) :- nl,clear_overwritten_chars(Agent).
  271% readlinetail(Agent,C, [C]):- at_end_of_stream,!, clear_overwritten_chars(Agent).
  272readlinetail(Agent,C, [C|X]) :-
  273  agent_to_input(Agent,In),
  274  get0(In,C2),
  275  add_pending_input(Agent,C2),
  276  readlinetail(Agent,C2, X).
  277
  278wordlist(List) --> optional_ws, wordlist1(List), optional_ws.
  279optional_ws --> whitespace.
  280optional_ws --> {true}.
  281wordlist1(List) --> wordlist2(List).
  282wordlist1([]) --> {true}.
  283wordlist2([X|Y]) --> word(X), whitespace, wordlist2(Y).
  284wordlist2([X]) --> word(X).
  285%wordlist([X|Y]) --> word(X), whitespace, wordlist(Y).
  286%wordlist([X]) --> whitespace, wordlist(X).
  287%wordlist([X]) --> word(X).
  288%wordlist([X]) --> word(X), whitespace.
  289
  290%word(W) --> charlist(X), {name(W,X)}.
  291word(W) --> charlist(X), {atom_codes(W,X)}.
  292
  293charlist([X|Y]) --> chr(X), charlist(Y).
  294charlist([X]) --> chr(X).
  295
  296chr(X) --> [X], {X>=48}.
  297
  298whitespace --> whsp, whitespace.
  299whitespace --> whsp.
  300
  301whsp --> [X], {X<48}