/* WRITEF : Formatted write routine (and support)

                                                UTILITY
                                                Lawrence
                                                Updated: 11 September 81
*/

        %%% WRITEF requires no other modules

                        % Print (therefore use pretty printing) onto

                        %  the terminal

ttyprint(X)
     :- seeing(Old),
        see(user),
        print(X),
        see(Old).



                        % Print a list, one element per line

  prlist([]) :- !.

  prlist([HD|TL])
        :- tab(4), print(HD), nl,
           prlist(TL).



                        % Print a conjunction, one element per line

prconj(true) :- !.

prconj(A&B)
     :- !,
        tab(4), print(A), nl,
        prconj(B).

prconj(A)
     :- tab(4), print(A), nl.



                        % Pretty print a simple logical expression
                        %  This is done by first printing the logical
                        %  structure using X1 X2 etc to name the components
                        %  and then printing the 'values' of X1 X2 etc on
                        %  spearate lines.

prexpr(Expr)
     :- prlog(Expr,1,N,Elements,[]),
        nl, write('  where :'), nl,
        prels(Elements,1).



prlog(A & B,Nin,Nout,Elements,Z)
     :- !,
        doexpr(38,A,B,Nin,Nout,Elements,Z).     % Ascii 38 = "&"

prlog(A # B,Nin,Nout,Elements,Z)
     :- !,
        doexpr(35,A,B,Nin,Nout,Elements,Z).     % Ascii 35 = "#"

prlog(X,Nin,Nout,[X|Z],Z)
     :- put("X"),
        write(Nin),
        Nout is Nin+1.



doexpr(Conn,A,B,Nin,Nout,Elements,Z)
     :- put("("), put(" "),
        prlog(A,Nin,Ninter,Elements,Rest),
        put(" "), put(Conn), put(" "),
        prlog(B,Ninter,Nout,Rest,Z),
        put(" "), put(")").



prels([],_).

prels([First|Rest],N)
     :- write('    X'), write(N), write(' =  '), print(First), nl,
        N2 is N+1,
        prels(Rest,N2).



                        % Formatted write utility
                        %  This converts the format atom to a string and
                        %  uses writefs on that. Note that it fails back over
                        %  itself to recover all used space.

writef(Format) :- writef(Format,[]).


writef(Format,List)
     :- name(Format,Fstring),
        writefs(Fstring,List),
        fail.

writef(_,_).



                        % Formatted write for a string (ie a list of
                        %  character codes).

writefs([],X).

writefs([37,X|Rest],List)                       /*   "%"   */
     :- action(X,List,List2),
        !,
        writefs(Rest,List2).

writefs([92,X|Rest],L)                  /*   "\" special   */
     :- special(X,Char),
        !,
        put(Char),
        writefs(Rest,L).

writefs([92|Rest],L)                            /*   "\" number    */
     :- getcode(Rest,Rest2,Char),
        !,
        put(Char),
        writefs(Rest2,L).

writefs([Char|Rest],L)                  /*   character     */
     :- put(Char),
        writefs(Rest,L).



action(116,[HD|TL],TL)          /*  t  */
     :- print(HD).

action(100,[HD|TL],TL)          /*  d  */
     :- display(HD).

action(119,[HD|TL],TL)          /*  w  */
     :- write(HD).

action(113,[HD|TL],TL)          /*  q  */
     :- writeq(HD).

action(112,[HD|TL],TL)          /*  p  */
     :- print(HD).

action(108,[HD|TL],TL)          /*  l  */
     :- nl, prlist(HD).

action(99,[HD|TL],TL)           /*  c  */
     :- nl, prconj(HD).

action(101,[HD|TL],TL)          /*  e  */
     :- nl, prexpr(HD).

action(102,L,L)                 /*  f  */
     :- ttyflush.

action(110,[HD|TL],TL)          /*  n  */
     :- put(HD).

action(114,[T,N|TL],TL) /*  r  */
     :- writelots(N,T).



special(110,10).                /*  n  */
special(108,10).                /*  l  */
special(114,13).                /*  r  */
special(116,9).                 /*  t  */
special(92,92).                 /*  \  */
special(37,37).                 /*  %  */



getcode(List,Rest,Char)
     :- getdigits(1,List,Rest,Digits),
        name(Char,Digits),
        Char < 128.


getdigits(N,[HD|TL1],Rest,[HD|TL2])
     :- N =< 3,
        HD >= "0",
        HD =< "9",
        !,
        N2 is N+1,
        getdigits(N2,TL1,Rest,TL2).

getdigits(_,Rest,Rest,[]).



writelots(0,_) :- !.

writelots(N,T)
     :- N > 0,
        N2 is N-1,
        write(T),
        writelots(N2,T).