1%   File   : WRITEF.PL
    2%   Author : Lawrence + Richard
    3%   Updated: 7 February 2001
    4%   Purpose: Formatted write routine (and support)
    5
    6% Modified by Neil Smith for LPA compatability
    7% This includes splicing it into the module system,
    8% and mucking around with CR/LF for DOS compatability
    9
   10
   11:- module(writef,
   12      [	prconj/1,               %   print conjunction
   13        prexpr/1,               %   print logical expression
   14        prlist/1,               %   print list, one per line
   15        ttyprint/1,             %   print on terminal
   16        fwritef/2,
   17        fwritef/3,              %   formatted write to file
   18        writef/1,
   19        writef/2                %   formatted write
   20      ]).   21
   22/*******************
   23*:- mode
   24*        ttyprint(?),
   25*        prlist(?),
   26*        prconj(?),
   27*        prexpr(?),
   28*                prexpr(+,+,-,?,?),
   29*                prexpr(+,-,-,-),
   30*                prexpr(+,+),
   31*        fwritef(+,+),
   32*        fwritef(+,+,+),
   33*        writef(+),
   34*        writef(+,+),
   35*                wf_act(+,+,-),
   36*                getcode(-,+,-),
   37*                getdigits(+,-,+,-),
   38*                getpad(+,-),
   39*                getpad(+,+,-),
   40*                getpad(-,-,+,-),
   41*                padout(+),
   42*                padout(+,+,+),
   43*                padout(+,+,+,-,-),
   44*                praggl(+,+,+,+),
   45*                wf_char(+,-),
   46*                wf_suffix(+,+,-),
   47*                writelots(?,+),
   48*                writef_nonlist(+,-),
   49*                writefs(+,+).
   50*************************************/
   51
   52
   53                        % Print (therefore use pretty printing) onto
   54                        %  the terminal (no-one uses this routine).
   55
   56ttyprint(X) :-          % fwritef(user, '%p', [X])
   57        telling(Old),
   58        tell(user),
   59        print(X),
   60        tell(Old).
   61
   62
   63
   64                        % Print a list, one element per line
   65
   66prlist([]) :- !.
   67prlist([Head|Tail]) :-
   68        tab(4), print(Head), nl,
   69        prlist(Tail).
   70
   71
   72
   73                        % Print a conjunction, one element per line
   74
   75prconj(true) :- !.
   76prconj(&(A,B)) :-
   77        prconj(A), !,
   78        prconj(B).
   79prconj((A,B)) :-
   80        prconj(A), !,
   81        prconj(B).
   82prconj(A) :-
   83        tab(4), print(A), nl.
   84
   85
   86
   87                        % Pretty print a simple logical expression
   88                        %  This is done by first printing the logical
   89                        %  structure using X1 X2 etc to name the components
   90                        %  and then printing the 'values' of X1 X2 etc on
   91                        %  separate lines.
   92
   93prexpr(Expr) :-
   94        prexpr(Expr, 1, _, Elements, []),
   95        nl, write('  where :'), nl,
   96        prexpr(Elements, 1).
   97
   98
   99prexpr(Term, Nin, Nout, Elements, Z) :-
  100        prexpr(Term, Conn, A, B), !,
  101        put("("), prexpr(A, Nin, Nmid, Elements, Rest),
  102        put(" "), put(Conn),
  103        put(" "), prexpr(B, Nmid, Nout, Rest, Z),
  104        put(")").
  105prexpr(Term, Nin, Nout, [Term|Z], Z) :-
  106        Nout is Nin+1,
  107        put("X"), write(Nin).
  108
  109
  110        prexpr(&(A,B),  38, A, B).      %  38 is "&"
  111        prexpr(#(A,B),  35, A, B).      %  35 is "#"
  112        prexpr((A,B),   38, A, B).      %  38 is "&"
  113        prexpr((A;B),  124, A, B).      % 124 is "|"
  114
  115
  116prexpr([Head|Tail], M) :-
  117        write('    X'), write(M), write(' =  '),
  118        print(Head), nl,
  119        N is M+1, !,
  120        prexpr(Tail, N).
  121prexpr([], _).
  122
  123
  124                        % Formatted write utility
  125                        %  This converts the format atom to a string and
  126                        %  uses writefs on that. Note that it fails back over
  127                        %  itself to recover all used space.
  128
  129fwritef(File, Format) :-
  130        fwritef(File, Format, []).
  131
  132fwritef(File, Format, List) :-
  133        telling(Old),
  134        tell(File),
  135        writef(Format, List),
  136        tell(Old).
  137
  138writef(Format) :-
  139        writef(Format, []).
  140
  141
  142writef(Format, Item) :-
  143        writef_nonlist(Item, List), !,
  144        writef(Format, List).
  145writef([F|String], List) :-
  146        writefs([F|String], List),
  147        fail.
  148writef(Format, List) :-
  149        atom(Format),
  150        name(Format, Fstring),
  151        writefs(Fstring, List),
  152        fail.
  153writef(_, _).
  154
  155
  156writef_nonlist([], _) :- !, fail.
  157writef_nonlist([_|_], _) :- !, fail.
  158writef_nonlist(Item, [Item]).
  159
  160
  161
  162                        % Formatted write for a string (ie a list of
  163                        %  character codes).
  164
  165writefs([], _List).
  166
  167writefs([37,A|Rest], List) :-           %   %<action>
  168        wf_act(A, List, More), !,
  169        writefs(Rest, More).
  170
  171writefs([37,D|Rest], [Head|Tail]) :-    %   %<columns><just>
  172        "0" =< D, D =< "9",
  173        getpad(Size, Just, [D|Rest], More),
  174        padout(Head, Size, Just), !,
  175        writefs(More, Tail).
  176
  177writefs([92,C|Rest], List) :-           %   \<special>
  178        wf_char(C, [Char|CharL]),
  179        putL([Char|CharL]), !,
  180        writefs(Rest, List).
  181writefs([92,C|Rest], List) :-           %   \<special>
  182        wf_char(C, Char),
  183        put(Char), !,
  184        writefs(Rest, List).
  185
  186writefs([92|Rest], List) :-             %   \<character code in decimal>
  187        getcode(Char, Rest, More),
  188        put(Char), !,
  189        writefs(More, List).
  190
  191writefs([Char|Rest], List) :-           %   <ordinary character>
  192        put(Char), !,
  193        writefs(Rest, List).
  194
  195putL([]).
  196putL([C|Cs]):-
  197	put(C),
  198	putL(Cs).
  199
  200
  201wf_act( 99, [Head|Tail], Tail) :-       %   Conjunction
  202        nl, !, prconj(Head).
  203
  204wf_act(100, [Head|Tail], Tail) :-       %   Display
  205        display(Head).
  206
  207wf_act(101, [Head|Tail], Tail) :-       %   Expression
  208        nl, !, prexpr(Head).
  209
  210wf_act(102, List, List) :-              %   Flush
  211        ttyflush.
  212
  213wf_act(103, [Head|Tail], Tail) :-       %   aGglutinated
  214        cfunctor(Head, F, N),
  215        praggl(1, N, F, Head).
  216
  217wf_act(105, [Format,List|Tail], Tail):- %   Indirect
  218        writef(Format, List).
  219
  220wf_act(106, [1,S,_|Tail], Tail) :- !,   %   "unua" or "multaJ"?
  221        write(S).
  222wf_act(106, [_,_,P|Tail], Tail) :-
  223        write(P).
  224
  225wf_act(108, [Head|Tail], Tail) :-       %   List
  226        nl, !, prlist(Head).
  227
  228wf_act(110, [Char|Tail], Tail) :-       %   iNteger (character)
  229        put(Char).
  230
  231wf_act(112,  [Head|Tail], Tail) :-      %   Print
  232        print(Head).
  233
  234wf_act(113, [Head|Tail], Tail) :-       %   Quoted
  235        writeq(Head).
  236
  237wf_act(114, [Thing,Times|Tail],Tail) :- %   Repeatedly
  238        writelots(Times, Thing).
  239
  240wf_act(115, [Head|Tail], Tail) :-       %   String
  241        padout(Head).
  242
  243wf_act(116, [Head|Tail], Tail) :-       %   Term
  244        print(Head).
  245
  246wf_act(118, List, List) :-              %   numberVars
  247        numbervars(List, 0, _).
  248
  249wf_act(119, [Head|Tail], Tail) :-       %   Write
  250        write(Head).
  251
  252wf_act(120, [_|Tail], Tail).            %   X (skip)
  253
  254
  255
  256
  257wf_char( 37, 37).               %  %
  258wf_char( 92, 92).               %  \
  259wf_char( 98,  8).               %  Backspace
  260wf_char(101, 27).               %  Escape
  261wf_char(102, 12).               %  Formfeed
  262wf_char(108, 10).               %  Linefeed
  263wf_char(110, [13, 10]).         %  Newline (=LF in UNIX, =CR LF in Win95)
  264wf_char(114, 13).               %  Return
  265wf_char(116,  9).               %  Tab
  266
  267
  268
  269getcode(Char) -->
  270        getdigits(3, Digits), !,
  271        {   Digits \== [], name(Char, Digits),  Char < 128   }.
  272
  273getdigits(Limit, [Digit|Digits]) -->
  274        {   Limit > 0   },
  275        [Digit],        {   "0" =< Digit, Digit =< "9"   },
  276        {   Fewer is Limit-1   }, !,
  277        getdigits(Fewer, Digits).
  278getdigits(_, []) --> [].
  279
  280
  281writelots(N, T) :-
  282        N > 0,
  283        write(T),
  284        M is N-1, !,
  285        writelots(M, T).
  286writelots(_, _).
  287
  288
  289%   praggl(ArgNo, Arity, Func, Term)
  290%   prints the arguments of the term one after the other, starting with
  291%   argument ArgNo.  Arguments are separated by " Func ".  This is meant
  292%   mainly for ASA, but should be generally useful.
  293
  294praggl(N, N, _, Term) :- !,
  295        arg(N, Term, Arg),
  296        print(Arg).
  297praggl(L, N, F, Term) :-
  298        arg(L, Term, Arg),
  299        print(Arg),
  300        put(32), write(F), put(32),
  301        M is L+1, !,
  302        praggl(M, N, F, Term).
  303
  304
  305/*  The new formats are %nC, %nL, and %nR for centered, left, and right
  306    justified output of atoms, integers, and strings.  This is meant to
  307    simplify the production of tabular output when it is appropriate.
  308    At least one space will always precede/follow the item written.
  309*/
  310
  311getpad(Size, Just) -->
  312        getdigits(3, Digits),   {   name(Size, Digits)   },
  313        [Char],                 {   getpad(Char, Just)   }.
  314
  315        getpad(114, r).         %  right justified
  316        getpad(108, l).         %  left justified
  317        getpad(106, j).         %  plural ending
  318        getpad( 99, c).         %  centered
  319        getpad( 82, r).         %  right justified
  320        getpad( 76, l).         %  left justified
  321        getpad( 74, j).         %  plural ending
  322        getpad( 67, c).         %  centered
  323
  324
  325
  326                                %   padout(A,S,J) writes the item A in a
  327                                %   field of S or more characters, Justified.
  328
  329padout(Number, Style, j) :-
  330        wf_suffix(Style, Number, Suffix),
  331        !,
  332        write(Suffix).
  333padout(Atom, Size, Just) :-
  334        atomic(Atom),
  335        name(Atom, Name), !,
  336        padout(Name, Size, Just).
  337padout(String, Size, Just) :-
  338        length(String, Length),
  339        padout(Just, Size, Length, Left, Right),
  340        tab(Left),
  341        padout(String),
  342        tab(Right).
  343
  344                                %   padout(Just,Size,Length,Left,Right)
  345                                %   calculates the number of spaces to put
  346                                %   on the Left and Right of an item needing
  347                                %   Length characters in a field of Size.
  348
  349padout(l, Size, Length, 0, Right) :-
  350        Excess is Size-Length, !,
  351        getpad(Excess, 1, Right).
  352padout(r, Size, Length, Left, 0) :-
  353        Excess is Size-Length, !,
  354        getpad(Excess, 1, Left).
  355padout(c, Size, Length, Left, Right) :-
  356        Prefix is (Size-Length)//2,
  357        getpad(Prefix, 1, Left),
  358        Remainder is (Size-Length)-Left, !,
  359        getpad(Remainder, 1, Right).
  360
  361
  362                                %   getpad(A,B,Max) returns the maximum.
  363
  364getpad(A, B, A) :- A >= B, !.
  365getpad(_, B, B).
  366
  367
  368                                %   padout(Str) writes a string.
  369
  370padout([Head|Tail]) :-
  371        put(Head), !,
  372        padout(Tail).
  373padout([]).
  374
  375
  376wf_suffix(1,    1,      '').            %  1 = -/s
  377wf_suffix(1,    _,      s).
  378wf_suffix(2,    1,      '').            %  2 = -/es
  379wf_suffix(2,    _,      es).
  380wf_suffix(3,    1,      y).             %  3 = y/ies
  381wf_suffix(3,    _,      ies).
  382wf_suffix(4,    1,      fe).            %  4 = fe/ves
  383wf_suffix(4,    _,      ves).
  384wf_suffix(5,    1,      s).             %  5 = s/- (for verbs)
  385wf_suffix(5,    _,      '').
  386wf_suffix(6,    1,      es).            %  6 = es/- (for verbs)
  387wf_suffix(6,    _,      '').
  388wf_suffix(7,    1,      ies).           %  7 = ies/y (for verbs)
  389wf_suffix(7,    _,      y).
  390wf_suffix(8,    1,      '').            %  8 = -/j
  391wf_suffix(8,    _,      j)