1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2011-2013, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(writef, 37 [ writef/1, % +Format 38 writef/2, % +Format, +Args 39 swritef/2, % -String, +Format 40 swritef/3 % -String, +Format, +Args 41 ]). 42:- set_prolog_flag(generate_debug_info, false). 43 44/** <module> Old-style formatted write 45 46This library provides writef/1 and friends. These predicates originate 47from Edinburgh C-Prolog and and provided for compatibility purposes. New 48code should use format/1, format/2 and friends, which are currently 49supported by more Prolog implementations. 50 51The writef-family of predicates conflicts with the modern 52_|character-esacapes|_ flag about the interpretation of \-sequences. 53This can be avoided by 54 55 1. Disable character escapes (not recommended unless one wants to 56 run really outdated code unmodified). 57 2. Double the \ for conflicting interpretations 58 3. Use ISO compliant alternatives for conflicting interpretations 59 60@copyright Copied from Edinburgh C-Prolog. Original version by Byrd, 61 changed many times since. 62*/ 63 64%! writef(+Format) is det. 65%! writef(+Format, +Arguments) is det. 66% 67% Formatted write to the =current_output=. Format is a format 68% specifier. Some escape sequences require arguments that must be 69% provided in the list Arguments. There are two types of escape 70% sequences: special characters start with =|\|= and include 71% arguments start with =|%|=. The special character sequences are: 72% 73% | =|\n|= | Output a newline character | 74% | =|\l|= | Output a line separator (same as =|\n|=) | 75% | =|\r|= | Output a carriage-return character (ASCII 13) | 76% | =|\r|= | Output a TAB character (ASCII 9) | 77% | =|\\|= | Output =|\|= | 78% | =|\%|= | Output =|%|= | 79% | =|\nnn|= | Output character <nnn>. <nnn> is a 1-3 decimal number | 80% 81% Escape sequences to include arguments from Arguments. Each time 82% a %-escape sequence is found in Format the next argument from 83% Arguments is formatted according to the specification. 84% 85% | =|%t|= | print/1 the next item (mnemonic: term) | 86% | =|%w|= | write/1 the next item | 87% | =|%q|= | writeq/1 the next item | 88% | =|%d|= | display/1 the next item | 89% | =|%n|= | Put the next item as a character | 90% | =|%r|= | Write the next item N times where N is the second item (an integer) | 91% | =|%s|= | Write the next item as a String (so it must be a list of characters) | 92% | =|%f|= |Perform a ttyflush/0 (no items used) | 93% | =|%Nc|= | Write the next item Centered in N columns. | 94% | =|%Nl|= | Write the next item Left justified in N columns. | 95% | =|%Nr|= | Write the next item Right justified in N columns. | 96% 97% @deprecated New code should use format/1, format/2, etc. 98 99writef(Format) :- 100 writef(Format, []). 101 102writef([F|String], List) :- 103 '$writefs'([F|String], List), 104 fail. % clean up global stack 105writef(String, List) :- 106 string(String), 107 string_codes(String, Fstring), 108 '$writefs'(Fstring, List), 109 fail. % clean up global stack 110writef(Format, List) :- 111 atom(Format), 112 name(Format, Fstring), 113 '$writefs'(Fstring, List), 114 fail. % clean up global stack 115writef(_, _). 116 117%! swritef(-String, +Format) is det. 118%! swritef(-String, +Format, +Arguments) is det. 119% 120% Use writef/1 or writef/2 and write the result to a _string_. 121% Note that this is a string in the sense of string_codes/2, 122% _not_ a list of character(-code)s. 123% 124% @deprecated. See format/2,3 and/or with_output_to/2. 125 126swritef(String, Format, Arguments) :- 127 with_output_to(string(String), writef(Format, Arguments)). 128swritef(String, Format) :- 129 with_output_to(string(String), writef(Format)). 130 131 % Formatted write for a string (i.e. a list of 132 % character codes). 133 134'$writefs'([], _). 135'$writefs'([0'%, A|Rest], List) :- % %<$action'> 136 '$action'(A, List, More), 137 !, 138 '$writefs'(Rest, More). 139'$writefs'([0'%, D|Rest], [Head|Tail]) :- % %<columns><just> 140 between(0'0, 0'9, D), 141 '$getpad'(Size, Just, [D|Rest], More), 142 !, 143 '$padout'(Head, Size, Just), 144 '$writefs'(More, Tail). 145'$writefs'([0'\\, C|Rest], List) :- % \<special> 146 '$special'(C, Char), 147 !, 148 put(Char), 149 '$writefs'(Rest, List). 150'$writefs'([0'\\|Rest], List) :- % \<character code in decimal> 151 '$getcode'(Char, Rest, More), 152 !, 153 put(Char), 154 '$writefs'(More, List). 155'$writefs'([Char|Rest], List) :- % <ordinary character> 156 put(Char), 157 '$writefs'(Rest, List). 158 159 160'$action'(0't, [Head|Tail], Tail) :- % Term 161 print(Head). 162'$action'(0'd, [Head|Tail], Tail) :- % Display 163 write_canonical(Head). 164'$action'(0'w, [Head|Tail], Tail) :- % Write 165 write(Head). 166'$action'(0'q, [Head|Tail], Tail) :- % Quoted 167 writeq(Head). 168'$action'(0'p, [Head|Tail], Tail) :- % Print 169 print(Head). 170'$action'(0'f, List, List) :- % Flush 171 ttyflush. 172'$action'(0'n, [Char|Tail], Tail) :- % iNteger (character) 173 put(Char). 174'$action'(0'r, [Thing, Times|Tail], Tail) :- % Repeatedly 175 '$writelots'(Times, Thing). 176'$action'(0's, [Head|Tail], Tail) :- % String 177 '$padout'(Head). 178 179'$special'(0'n, 10). /* n */ 180'$special'(0'l, 10). /* l */ 181'$special'(0'r, 10). /* r */ 182'$special'(0't, 9). /* t */ 183'$special'(0'\\, 0'\\). /* \ */ 184'$special'(0'%, 0'%). /* % */ 185 186'$getcode'(Char, In, Out) :- 187 '$getdigits'(3, Digits, In, Out), 188 Digits = [_|_], 189 name(Char, Digits), 190 Char < 128. 191 192'$getdigits'(Limit, [Digit|Digits], [Digit|Out0], Out) :- 193 Limit > 0, 194 between(0'0, 0'9, Digit), 195 Fewer is Limit - 1, 196 !, 197 '$getdigits'(Fewer, Digits, Out0, Out). 198'$getdigits'(_, [], Out, Out). 199 200'$writelots'(N, T) :- 201 N > 0, 202 !, 203 write(T), 204 M is N - 1, 205 '$writelots'(M, T). 206'$writelots'(_, _). 207 208/* The new formats are %nC, %nL, and %nR for centered, left, and right 209 justified output of atoms, integers, and strings. This is meant to 210 simplify the production of tabular output when it is appropriate. 211 At least one space will always precede/follow the item written. 212*/ 213 214'$getpad'(Size, Just, In, Out) :- 215 '$getdigits'(3, Digits, In, [Out1|Out]), 216 name(Size, Digits), 217 '$getpad'(Out1, Just). 218 219'$getpad'(0'r, r). % right justified 220'$getpad'(0'l, l). % left justified 221'$getpad'(0'c, c). % centered 222'$getpad'(0'R, r). % right justified 223'$getpad'(0'L, l). % left justified 224'$getpad'(0'C, c). % centered 225 226 227 % '$padout'(A, S, J) writes the item A in a 228 % field of S or more characters, Justified. 229 230'$padout'(String, Size, Just) :- 231 '$string'(String), 232 !, 233 name(Atom, String), 234 '$padout'(Atom, Size, Just). 235'$padout'(Term, Size, Just) :- 236 format(string(Atom), Term, Atom), 237 atom_length(Atom, Length), 238 '$padout'(Just, Size, Length, Left, Right), 239 tab(Left), 240 write(Atom), 241 tab(Right). 242 243'$string'(0) :- !, fail. 244'$string'([]) :- !. 245'$string'([H|T]) :- 246 '$print'(H), 247 !, 248 '$string'(T). 249 250'$print'(10). % newline 251'$print'(9). % tab 252'$print'(X) :- 253 integer(X), 254 between(32, 0'~, X). 255 256 257 % '$padout'(Just, Size, Length, Left, Right) 258 % calculates the number of spaces to put 259 % on the Left and Right of an item needing 260 % Length characters in a field of Size. 261 262'$padout'(l, Size, Length, 0, Right) :- 263 !, 264 Right is max(1, Size-Length). 265'$padout'(r, Size, Length, Left, 0) :- 266 !, 267 Left is max(1, Size-Length). 268'$padout'(c, Size, Length, Left, Right) :- 269 Left is max(1, round((Size - Length)/2)), 270 Right is max(1, Size - Length - Left). 271 272 % '$padout'(Str) writes a string. 273 274'$padout'([Head|Tail]) :- 275 !, 276 put(Head), 277 '$padout'(Tail). 278'$padout'([])