]>
Commit | Line | Data |
---|---|---|
83ffe9cd | 1 | (* Copyright (C) 2015-2023 Free Software Foundation, Inc. *) |
1eee94d3 GM |
2 | (* This file is part of GNU Modula-2. |
3 | ||
4 | GNU Modula-2 is free software; you can redistribute it and/or modify it under | |
5 | the terms of the GNU General Public License as published by the Free | |
6 | Software Foundation; either version 3, or (at your option) any later | |
7 | version. | |
8 | ||
9 | GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY | |
10 | WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
11 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
12 | for more details. | |
13 | ||
14 | You should have received a copy of the GNU General Public License along | |
15 | with gm2; see the file COPYING. If not, write to the Free Software | |
16 | Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) | |
17 | ||
18 | IMPLEMENTATION MODULE mcPrintf ; | |
19 | ||
20 | FROM SFIO IMPORT WriteS ; | |
21 | FROM FIO IMPORT StdOut ; | |
22 | FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, Mark ; | |
23 | FROM StrLib IMPORT StrLen ; | |
24 | FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ; | |
25 | FROM nameKey IMPORT Name, keyToCharStar ; | |
26 | ||
27 | ||
28 | (* | |
29 | isDigit - returns TRUE if, ch, is a character 0..9 | |
30 | *) | |
31 | ||
32 | PROCEDURE isDigit (ch: CHAR) : BOOLEAN ; | |
33 | BEGIN | |
34 | RETURN (ch>='0') AND (ch<='9') | |
35 | END isDigit ; | |
36 | ||
37 | ||
38 | (* | |
39 | cast - casts a := b | |
40 | *) | |
41 | ||
42 | PROCEDURE cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ; | |
43 | VAR | |
44 | i: CARDINAL ; | |
45 | BEGIN | |
46 | IF HIGH (a) = HIGH (b) | |
47 | THEN | |
48 | FOR i := 0 TO HIGH (a) DO | |
49 | a[i] := b[i] | |
50 | END | |
51 | ELSE | |
52 | HALT | |
53 | END | |
54 | END cast ; | |
55 | ||
56 | ||
57 | (* | |
58 | TranslateNameToCharStar - takes a format specification string, a, and | |
59 | if they consist of of %a then this is translated | |
60 | into a String and %a is replaced by %s. | |
61 | *) | |
62 | ||
63 | PROCEDURE TranslateNameToCharStar (VAR a: ARRAY OF CHAR; | |
64 | n: CARDINAL) : BOOLEAN ; | |
65 | VAR | |
66 | argno, | |
67 | i, h : CARDINAL ; | |
68 | BEGIN | |
69 | argno := 1 ; | |
70 | i := 0 ; | |
71 | h := StrLen (a) ; | |
72 | WHILE i<h DO | |
73 | IF (a[i]='%') AND (i+1<h) | |
74 | THEN | |
75 | IF (a[i+1]='a') AND (argno=n) | |
76 | THEN | |
77 | a[i+1] := 's' ; | |
78 | RETURN TRUE | |
79 | END ; | |
80 | INC (argno) ; | |
81 | IF argno>n | |
82 | THEN | |
83 | (* all done *) | |
84 | RETURN FALSE | |
85 | END | |
86 | END ; | |
87 | INC (i) | |
88 | END ; | |
89 | RETURN FALSE | |
90 | END TranslateNameToCharStar ; | |
91 | ||
92 | ||
93 | (* | |
94 | fprintf0 - writes out an array to, file, after the escape sequences | |
95 | have been translated. | |
96 | *) | |
97 | ||
98 | PROCEDURE fprintf0 (file: File; a: ARRAY OF CHAR) ; | |
99 | BEGIN | |
100 | IF KillString (WriteS (file, Sprintf0 (InitString (a)))) = NIL | |
101 | THEN | |
102 | END | |
103 | END fprintf0 ; | |
104 | ||
105 | ||
106 | PROCEDURE fprintf1 (file: File; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ; | |
107 | VAR | |
108 | s, t: String ; | |
109 | n : Name ; | |
110 | BEGIN | |
111 | IF TranslateNameToCharStar (a, 1) | |
112 | THEN | |
113 | cast (n, w) ; | |
114 | s := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
115 | t := Mark (InitString (a)) ; | |
116 | s := Sprintf1 (t, s) | |
117 | ELSE | |
118 | t := Mark (InitString (a)) ; | |
119 | s := Sprintf1 (t, w) | |
120 | END ; | |
121 | IF KillString (WriteS (file, s)) = NIL | |
122 | THEN | |
123 | END | |
124 | END fprintf1 ; | |
125 | ||
126 | ||
127 | PROCEDURE fprintf2 (file: File; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ; | |
128 | VAR | |
129 | n : Name ; | |
130 | s, | |
131 | s1, s2: String ; | |
132 | b : BITSET ; | |
133 | BEGIN | |
134 | b := {} ; | |
135 | IF TranslateNameToCharStar (a, 1) | |
136 | THEN | |
137 | cast (n, w1) ; | |
138 | s1 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
139 | INCL (b, 1) | |
140 | END ; | |
141 | IF TranslateNameToCharStar (a, 2) | |
142 | THEN | |
143 | cast (n, w2) ; | |
144 | s2 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
145 | INCL (b, 2) | |
146 | END ; | |
147 | CASE b OF | |
148 | ||
149 | {} : s := Sprintf2 (Mark (InitString (a)), w1, w2) | | |
150 | {1} : s := Sprintf2 (Mark (InitString (a)), s1, w2) | | |
151 | {2} : s := Sprintf2 (Mark (InitString (a)), w1, s2) | | |
152 | {1,2}: s := Sprintf2 (Mark (InitString (a)), s1, s2) | |
153 | ||
154 | ELSE | |
155 | HALT | |
156 | END ; | |
157 | IF KillString (WriteS (file, s)) = NIL | |
158 | THEN | |
159 | END | |
160 | END fprintf2 ; | |
161 | ||
162 | ||
163 | PROCEDURE fprintf3 (file: File; a: ARRAY OF CHAR; | |
164 | w1, w2, w3: ARRAY OF BYTE) ; | |
165 | VAR | |
166 | n : Name ; | |
167 | s, s1, s2, s3: String ; | |
168 | b : BITSET ; | |
169 | BEGIN | |
170 | b := {} ; | |
171 | IF TranslateNameToCharStar (a, 1) | |
172 | THEN | |
173 | cast (n, w1) ; | |
174 | s1 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
175 | INCL (b, 1) | |
176 | END ; | |
177 | IF TranslateNameToCharStar (a, 2) | |
178 | THEN | |
179 | cast (n, w2) ; | |
180 | s2 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
181 | INCL (b, 2) | |
182 | END ; | |
183 | IF TranslateNameToCharStar (a, 3) | |
184 | THEN | |
185 | cast (n, w3) ; | |
186 | s3 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
187 | INCL (b, 3) | |
188 | END ; | |
189 | CASE b OF | |
190 | ||
191 | {} : s := Sprintf3 (Mark (InitString (a)), w1, w2, w3) | | |
192 | {1} : s := Sprintf3 (Mark (InitString (a)), s1, w2, w3) | | |
193 | {2} : s := Sprintf3 (Mark (InitString (a)), w1, s2, w3) | | |
194 | {1,2} : s := Sprintf3 (Mark (InitString (a)), s1, s2, w3) | | |
195 | {3} : s := Sprintf3 (Mark (InitString (a)), w1, w2, s3) | | |
196 | {1,3} : s := Sprintf3 (Mark (InitString (a)), s1, w2, s3) | | |
197 | {2,3} : s := Sprintf3 (Mark (InitString (a)), w1, s2, s3) | | |
198 | {1,2,3}: s := Sprintf3 (Mark (InitString (a)), s1, s2, s3) | |
199 | ||
200 | ELSE | |
201 | HALT | |
202 | END ; | |
203 | IF KillString(WriteS(file, s))=NIL | |
204 | THEN | |
205 | END | |
206 | END fprintf3 ; | |
207 | ||
208 | ||
209 | PROCEDURE fprintf4 (file: File; a: ARRAY OF CHAR; | |
210 | w1, w2, w3, w4: ARRAY OF BYTE) ; | |
211 | VAR | |
212 | n : Name ; | |
213 | s, s1, s2, s3, s4: String ; | |
214 | b : BITSET ; | |
215 | BEGIN | |
216 | b := {} ; | |
217 | IF TranslateNameToCharStar (a, 1) | |
218 | THEN | |
219 | cast (n, w1) ; | |
220 | s1 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
221 | INCL (b, 1) | |
222 | END ; | |
223 | IF TranslateNameToCharStar (a, 2) | |
224 | THEN | |
225 | cast (n, w2) ; | |
226 | s2 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
227 | INCL (b, 2) | |
228 | END ; | |
229 | IF TranslateNameToCharStar (a, 3) | |
230 | THEN | |
231 | cast (n, w3) ; | |
232 | s3 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
233 | INCL (b, 3) | |
234 | END ; | |
235 | IF TranslateNameToCharStar (a, 4) | |
236 | THEN | |
237 | cast (n, w4) ; | |
238 | s4 := Mark (InitStringCharStar (keyToCharStar (n))) ; | |
239 | INCL (b, 4) | |
240 | END ; | |
241 | CASE b OF | |
242 | ||
243 | {} : s := Sprintf4 (Mark(InitString (a)), w1, w2, w3, w4) | | |
244 | {1} : s := Sprintf4 (Mark(InitString (a)), s1, w2, w3, w4) | | |
245 | {2} : s := Sprintf4 (Mark(InitString (a)), w1, s2, w3, w4) | | |
246 | {1,2} : s := Sprintf4 (Mark(InitString (a)), s1, s2, w3, w4) | | |
247 | {3} : s := Sprintf4 (Mark(InitString (a)), w1, w2, s3, w4) | | |
248 | {1,3} : s := Sprintf4 (Mark(InitString (a)), s1, w2, s3, w4) | | |
249 | {2,3} : s := Sprintf4 (Mark(InitString (a)), w1, s2, s3, w4) | | |
250 | {1,2,3} : s := Sprintf4 (Mark(InitString (a)), s1, s2, s3, w4) | | |
251 | {4} : s := Sprintf4 (Mark(InitString (a)), w1, w2, w3, s4) | | |
252 | {1,4} : s := Sprintf4 (Mark(InitString (a)), s1, w2, w3, s4) | | |
253 | {2,4} : s := Sprintf4 (Mark(InitString (a)), w1, s2, w3, s4) | | |
254 | {1,2,4} : s := Sprintf4 (Mark(InitString (a)), s1, s2, w3, s4) | | |
255 | {3,4} : s := Sprintf4 (Mark(InitString (a)), w1, w2, s3, s4) | | |
256 | {1,3,4} : s := Sprintf4 (Mark(InitString (a)), s1, w2, s3, s4) | | |
257 | {2,3,4} : s := Sprintf4 (Mark(InitString (a)), w1, s2, s3, s4) | | |
258 | {1,2,3,4}: s := Sprintf4 (Mark(InitString (a)), s1, s2, s3, s4) | |
259 | ||
260 | ELSE | |
261 | HALT | |
262 | END ; | |
263 | IF KillString (WriteS (file, s)) = NIL | |
264 | THEN | |
265 | END | |
266 | END fprintf4 ; | |
267 | ||
268 | ||
269 | (* | |
270 | printf0 - writes out an array to, StdOut, after the escape | |
271 | sequences have been translated. | |
272 | *) | |
273 | ||
274 | PROCEDURE printf0 (a: ARRAY OF CHAR) ; | |
275 | BEGIN | |
276 | fprintf0 (StdOut, a) | |
277 | END printf0 ; | |
278 | ||
279 | ||
280 | PROCEDURE printf1 (a: ARRAY OF CHAR; | |
281 | w: ARRAY OF BYTE) ; | |
282 | BEGIN | |
283 | fprintf1 (StdOut, a, w) | |
284 | END printf1 ; | |
285 | ||
286 | ||
287 | PROCEDURE printf2 (a: ARRAY OF CHAR; | |
288 | w1, w2: ARRAY OF BYTE) ; | |
289 | BEGIN | |
290 | fprintf2 (StdOut, a, w1, w2) | |
291 | END printf2 ; | |
292 | ||
293 | ||
294 | PROCEDURE printf3 (a: ARRAY OF CHAR; | |
295 | w1, w2, w3: ARRAY OF BYTE) ; | |
296 | BEGIN | |
297 | fprintf3 (StdOut, a, w1, w2, w3) | |
298 | END printf3 ; | |
299 | ||
300 | ||
301 | PROCEDURE printf4 (a: ARRAY OF CHAR; | |
302 | w1, w2, w3, w4: ARRAY OF BYTE) ; | |
303 | BEGIN | |
304 | fprintf4 (StdOut, a, w1, w2, w3, w4) | |
305 | END printf4 ; | |
306 | ||
307 | ||
308 | END mcPrintf. |