|
a/FormAusLib.mod |
|
b/FormAusLib.mod |
1 |
IMPLEMENTATION MODULE FormAusLib;
|
1 |
IMPLEMENTATION MODULE FormAusLib;
|
2 |
|
2 |
|
3 |
(*------------------------------------------------------------------------*)
|
3 |
(*------------------------------------------------------------------------*)
|
4 |
(* Routinen die gemeinsam von {T|F|S}FormAus genutzt werden *)
|
4 |
(* [DE] Routinen die gemeinsam von {T|F|S}FormAus genutzt werden. *)
|
|
|
5 |
(* *)
|
|
|
6 |
(* Der Parameter "Laenge" gibt jeweils die Anzahl uebergebener Bytes an *)
|
|
|
7 |
(* wenn nicht explizit etwas anderes in der Prozedurebeschreibung ange- *)
|
|
|
8 |
(* geben ist. *)
|
|
|
9 |
(* *)
|
|
|
10 |
(* [EN] Routines used by {T|F|S}FormAus. NOT for direct use !!! *)
|
|
|
11 |
(* *)
|
|
|
12 |
(* The parameter "Laenge" defines the number of bytes handed over in all *)
|
|
|
13 |
(* procedures if not explicitly describes having another meaning *)
|
5 |
(*------------------------------------------------------------------------*)
|
14 |
(*------------------------------------------------------------------------*)
|
6 |
(* Letzte Bearbeitung: *)
|
15 |
(* Letzte Bearbeitung: *)
|
7 |
(* *)
|
16 |
(* *)
|
8 |
(* 05.09.94, MRi: Durchsicht *)
|
17 |
(* 05.09.94, MRi: Durchsicht *)
|
9 |
(* 22.06.15, MRi: Einf"uhren des "An"-Formats in WriteN,dWriteN *)
|
18 |
(* 22.06.15, MRi: Einf"uhren des "An"-Formats in WriteN,dWriteN *)
|
10 |
(* 02.10.16, MRi: Aufsplitten der Module FormAus und SFormAus in *)
|
19 |
(* 02.10.16, MRi: Aufsplitten der Module FormAus und SFormAus in *)
|
11 |
(* TFormAus,FFormAus,SFormAus *)
|
20 |
(* TFormAus,FFormAus,SFormAus *)
|
12 |
(* 02.12.16, MRi: In ByteToLngReal Umwandlung von 4-BYTE Reals eingefuegt *)
|
21 |
(* 02.12.16, MRi: In ByteToLngReal Umwandlung von 4-BYTE Reals eingefuegt *)
|
|
|
22 |
(* 28.06.18, MRi: Erstellen der ersten Version von PreParseFormat *)
|
|
|
23 |
(* 29.06.18, MRi: Korrekturen in PreParseFormat, erstellen von StrTok *)
|
|
|
24 |
(* 03.07.18, MRi: Ersetzen von StrTok durch StringTok *)
|
13 |
(*------------------------------------------------------------------------*)
|
25 |
(*------------------------------------------------------------------------*)
|
14 |
(* Offene Punkte *)
|
26 |
(* Offene Punkte *)
|
15 |
(* *)
|
27 |
(* *)
|
16 |
(* - Eventuell die Formatanweisung ausgeben wenn eine ByteToXXX Routinen *)
|
28 |
(* - Eventuell die Formatanweisung ausgeben wenn eine ByteToXXX Routinen *)
|
17 |
(* einen Fehler meldet so dass diese leichter gefunden werden kann. *)
|
29 |
(* einen Fehler meldet so dass diese leichter gefunden werden kann. *)
|
18 |
(* - Durchsicht der Laengenparameter fuer Cardinal *)
|
30 |
(* - Durchsicht der Laengenparameter fuer Cardinal *)
|
19 |
(* - Ausschreiben einer LONGINT wie LONGCARD behandeln *)
|
31 |
(* - Ausschreiben einer LONGINT wie LONGCARD behandeln *)
|
20 |
(* - Ausschreiben von REAL einfuegen - Mechanismus wie bei CARDINAL (OK) *)
|
32 |
(* - Ausschreiben von REAL einfuegen - Mechanismus wie bei CARDINAL *)
|
21 |
(*------------------------------------------------------------------------*)
|
33 |
(*------------------------------------------------------------------------*)
|
|
|
34 |
(* Implementation : Michael Riedl *)
|
22 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
35 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
23 |
(*------------------------------------------------------------------------*)
|
36 |
(*------------------------------------------------------------------------*)
|
24 |
|
37 |
|
25 |
(* $Id: FormAusLib.mod,v 1.2 2018/01/05 13:41:13 mriedl Exp mriedl $ *)
|
38 |
(* $Id: FormAusLib.mod,v 1.2 2018/01/05 13:41:13 mriedl Exp mriedl $ *)
|
26 |
|
39 |
|
27 |
FROM SYSTEM IMPORT BYTE,TSIZE,ADR;
|
40 |
FROM SYSTEM IMPORT BYTE,TSIZE,ADR;
|
28 |
FROM Deklera IMPORT STRING;
|
41 |
FROM Deklera IMPORT STRING;
|
29 |
FROM Errors IMPORT Fehler,ErrOut;
|
42 |
FROM Errors IMPORT Fehler,ErrOut;
|
30 |
IMPORT TestReal; (* Sollte IEEE.NAN sein *)
|
43 |
IMPORT Errors;
|
|
|
44 |
FROM StringsLib IMPORT Length,Copy,Append,Delete,PosChar,AppendChar,
|
|
|
45 |
Stripped,SubString;
|
|
|
46 |
FROM CharClass IMPORT IsNumeric;
|
|
|
47 |
FROM NumConvert IMPORT StringToCard;
|
|
|
48 |
FROM ConvTypes IMPORT ConvResults;
|
31 |
IMPORT TIO;
|
49 |
IMPORT TIO;
|
32 |
|
50 |
|
33 |
VAR NAN : LONGREAL;
|
|
|
34 |
|
51 |
|
35 |
PROCEDURE WrByteStr(Str : ARRAY OF BYTE; (* F"ur Mocka *)
|
52 |
PROCEDURE WrByteStr(Str : ARRAY OF BYTE; (* F"ur Mocka *)
|
36 |
Laenge : CARDINAL);
|
53 |
Laenge : CARDINAL);
|
37 |
|
54 |
|
38 |
VAR String : StrPrt;
|
55 |
VAR String : StrPrt;
|
|
... |
|
... |
114 |
ELSE
|
131 |
ELSE
|
115 |
I:=ADR(i); RETURN I^;
|
132 |
I:=ADR(i); RETURN I^;
|
116 |
END;
|
133 |
END;
|
117 |
END ByteToLngCard;
|
134 |
END ByteToLngCard;
|
118 |
|
135 |
|
119 |
|
|
|
120 |
PROCEDURE ByteToLngReal(x : ARRAY OF BYTE;
|
136 |
PROCEDURE ByteToLngReal(x : ARRAY OF BYTE;
|
121 |
Laenge : CARDINAL) : LONGREAL;
|
137 |
Laenge : CARDINAL) : LONGREAL;
|
122 |
|
138 |
|
123 |
VAR R8 : POINTER TO LONGREAL;
|
139 |
VAR R8 : POINTER TO LONGREAL;
|
124 |
R4 : POINTER TO REAL;
|
140 |
R4 : POINTER TO REAL;
|
125 |
r8 : LONGREAL;
|
141 |
r8 : LONGREAL;
|
126 |
BEGIN
|
142 |
BEGIN
|
127 |
IF (Laenge # TSIZE(LONGREAL)) AND (Laenge # TSIZE(REAL)) THEN
|
143 |
IF (Laenge # TSIZE(LONGREAL)) AND (Laenge # TSIZE(REAL)) THEN
|
128 |
Fehler:=TRUE;
|
144 |
Fehler:=TRUE;
|
129 |
TIO.WrStr('Fehler in ByteToLngReal.');
|
145 |
TIO.WrStr('Fehler in ByteToLngReal.');
|
130 |
RETURN VAL(LONGREAL,NAN);
|
146 |
RETURN MAX(LONGREAL);
|
131 |
END;
|
147 |
END;
|
132 |
IF (Laenge = TSIZE(LONGREAL)) THEN
|
148 |
IF (Laenge = TSIZE(LONGREAL)) THEN
|
133 |
R8:=ADR(x);
|
149 |
R8:=ADR(x);
|
134 |
RETURN R8^;
|
150 |
RETURN R8^;
|
135 |
ELSE
|
151 |
ELSE
|
136 |
R4:=ADR(x); r8:=VAL(LONGREAL,R4^);
|
152 |
R4:=ADR(x); r8:=VAL(LONGREAL,R4^);
|
137 |
RETURN r8;
|
153 |
RETURN r8;
|
138 |
END;
|
154 |
END;
|
139 |
END ByteToLngReal;
|
155 |
END ByteToLngReal;
|
140 |
|
156 |
|
|
|
157 |
PROCEDURE StringTok( Quelle : ARRAY OF CHAR;
|
|
|
158 |
Trenner : ARRAY OF CHAR;
|
|
|
159 |
include : BOOLEAN;
|
|
|
160 |
VAR Tokens : ARRAY OF ARRAY OF CHAR;
|
|
|
161 |
VAR NToken : CARDINAL;
|
|
|
162 |
VAR done : BOOLEAN);
|
|
|
163 |
|
|
|
164 |
(*----------------------------------------------------------------*)
|
|
|
165 |
(* Sehr einfacher Tokenisierer, faengt multiple Trennzeichen *)
|
|
|
166 |
(* zwischen einzelnen Token nicht ab, nur fuer speziellen Zweck. *)
|
|
|
167 |
(* *)
|
|
|
168 |
(* Simple tokenier, does not capture occurence of multiple *)
|
|
|
169 |
(* separators between tokens, not for general use. *)
|
|
|
170 |
(*----------------------------------------------------------------*)
|
|
|
171 |
|
|
|
172 |
VAR anz : CARDINAL;
|
|
|
173 |
|
|
|
174 |
PROCEDURE IstTrennZeichen(chr : CHAR) : BOOLEAN;
|
|
|
175 |
|
|
|
176 |
VAR gefunden : BOOLEAN;
|
|
|
177 |
itr : CARDINAL;
|
|
|
178 |
BEGIN
|
|
|
179 |
gefunden := (chr = 0C); itr:=0;
|
|
|
180 |
WHILE NOT gefunden AND (itr < anz) DO
|
|
|
181 |
gefunden := (chr = Trenner[itr]); INC(itr);
|
|
|
182 |
END;
|
|
|
183 |
RETURN gefunden;
|
|
|
184 |
END IstTrennZeichen;
|
|
|
185 |
|
|
|
186 |
VAR is,ie,len,ipos,itok : CARDINAL;
|
141 |
BEGIN
|
187 |
BEGIN
|
142 |
NAN := VAL(LONGREAL,TestReal.Real8NaNquite());
|
188 |
done:=TRUE;
|
|
|
189 |
len:=Length(Quelle);
|
|
|
190 |
anz:=Length(Trenner);
|
|
|
191 |
is:=0; ipos:=0; itok:=0;
|
|
|
192 |
WHILE (ipos <= len+1) DO
|
|
|
193 |
IF IstTrennZeichen(Quelle[ipos]) THEN
|
|
|
194 |
IF (ipos > 0) THEN ie := ipos-1; ELSE ie:=0; END;
|
|
|
195 |
SubString(Quelle,is,ie,Tokens[itok]);
|
|
|
196 |
IF (Tokens[itok][0] # 0C) THEN INC(itok); END;
|
|
|
197 |
IF include THEN is:=ie+1; ELSE is:=ie+2; END;
|
|
|
198 |
END;
|
|
|
199 |
INC(ipos);
|
|
|
200 |
END;
|
|
|
201 |
NToken:=itok;
|
|
|
202 |
END StringTok;
|
|
|
203 |
|
|
|
204 |
PROCEDURE PreParseFormat( FmtAlt : ARRAY OF CHAR;
|
|
|
205 |
VAR FmtNeu : ARRAY OF CHAR;
|
|
|
206 |
VAR done : BOOLEAN);
|
|
|
207 |
|
|
|
208 |
CONST debug = (1 = 0);
|
|
|
209 |
X = "X";
|
|
|
210 |
|
|
|
211 |
VAR Trenner : ARRAY [0.. 7] OF CHAR;
|
|
|
212 |
tmpstr : ARRAY [0..15] OF CHAR;
|
|
|
213 |
zahl : ARRAY [0..15] OF CHAR;
|
|
|
214 |
Tokens : ARRAY [1..32] OF ARRAY [0..127] OF CHAR;
|
|
|
215 |
NToken,itok : CARDINAL;
|
|
|
216 |
zaehler,iz,ix: CARDINAL;
|
|
|
217 |
Zahlen : ARRAY [1..4] OF CARDINAL;
|
|
|
218 |
k,ik,nk,ip : CARDINAL;
|
|
|
219 |
s,e,len : CARDINAL;
|
|
|
220 |
result : ConvResults;
|
|
|
221 |
IstInKlammer : ARRAY [1..8] OF BOOLEAN;
|
|
|
222 |
BEGIN
|
|
|
223 |
done:=TRUE;
|
|
|
224 |
Stripped(FmtAlt," ");
|
|
|
225 |
(* Ersetze nX durch Xn im Format *)
|
|
|
226 |
ip:=PosChar(FmtAlt,"X",0);
|
|
|
227 |
IF (ip # MAX(CARDINAL)) THEN (* nX in Format enthalten *)
|
|
|
228 |
Trenner:=",";
|
|
|
229 |
StringTok(FmtAlt,Trenner,TRUE,Tokens,NToken,done);
|
|
|
230 |
FmtNeu[0]:=0C;
|
|
|
231 |
FOR itok:=1 TO NToken DO
|
|
|
232 |
IF debug THEN
|
|
|
233 |
TIO.WrLn;
|
|
|
234 |
TIO.WrCard(itok,2);
|
|
|
235 |
TIO.WrStr(' "'); TIO.WrStr(Tokens[itok]); TIO.WrChar('"');
|
|
|
236 |
END;
|
|
|
237 |
len := Length(Tokens[itok]);
|
|
|
238 |
ix := PosChar(Tokens[itok],"X",0);
|
|
|
239 |
IF (ix = 0) THEN
|
|
|
240 |
Errors.ErrOut("Vorgaenger von X nicht vorhanden ()");
|
|
|
241 |
END;
|
|
|
242 |
IF (ix # MAX(CARDINAL)) THEN (* es gibt ein "nX" *)
|
|
|
243 |
IF NOT IsNumeric(Tokens[itok][ix-1]) THEN
|
|
|
244 |
Errors.ErrOut("Vorgaenger von X nicht numerisch ()");
|
|
|
245 |
END;
|
|
|
246 |
e:=ix-1; k:=e;
|
|
|
247 |
WHILE (k > 0) AND IsNumeric(Tokens[itok][k-1]) DO
|
|
|
248 |
(* Ermittel den Anfang "s" von n *)
|
|
|
249 |
DEC(k);
|
|
|
250 |
END;
|
|
|
251 |
s:=k;
|
|
|
252 |
|
|
|
253 |
IF debug THEN
|
|
|
254 |
TIO.WrStr(' Token = "');
|
|
|
255 |
TIO.WrStr(Tokens[itok]); TIO.WrStr('" s,e = ');
|
|
|
256 |
TIO.WrCard(s,3); TIO.WrCard(e,3); TIO.WrLn;
|
|
|
257 |
END;
|
|
|
258 |
|
|
|
259 |
(* Zeichen vor "n" *)
|
|
|
260 |
IF (s > 0) THEN
|
|
|
261 |
FOR k:=0 TO s-1 DO tmpstr[k]:=Tokens[itok][k]; END;
|
|
|
262 |
END;
|
|
|
263 |
|
|
|
264 |
tmpstr[s]:="X"; (* jetzt Xn *)
|
|
|
265 |
FOR k:=s TO e DO tmpstr[k+1]:=Tokens[itok][k]; END;
|
|
|
266 |
|
|
|
267 |
(* Was kommt hinter dem X ... *)
|
|
|
268 |
FOR k:=ix+1 TO len DO tmpstr[k]:=Tokens[itok][k]; END;
|
|
|
269 |
tmpstr[len+1]:=0C;
|
|
|
270 |
|
|
|
271 |
Copy(Tokens[itok],tmpstr); (* Ersetze alten Token *)
|
|
|
272 |
IF debug THEN
|
|
|
273 |
TIO.WrStr('tmpstr : "'); TIO.WrStr(tmpstr); TIO.WrChar('"');
|
|
|
274 |
TIO.WrLn;
|
|
|
275 |
TIO.WrStr(" x ");
|
|
|
276 |
END;
|
|
|
277 |
ELSE
|
|
|
278 |
IF debug THEN TIO.WrStr(" - "); END;
|
|
|
279 |
END;
|
|
|
280 |
IF debug THEN
|
|
|
281 |
TIO.WrStr(' = "'); TIO.WrStr(Tokens[itok]); TIO.WrChar('"');
|
|
|
282 |
TIO.WrLn;
|
|
|
283 |
END;
|
|
|
284 |
Append(FmtNeu,Tokens[itok]); (* Baue die Formatanweisung neu auf *)
|
|
|
285 |
IF debug THEN
|
|
|
286 |
TIO.WrLn; TIO.WrCard(itok,2); TIO.WrStr(" neu : '");
|
|
|
287 |
TIO.WrStr(FmtAlt); TIO.WrChar("'"); TIO.WrLn;
|
|
|
288 |
END;
|
|
|
289 |
END;
|
|
|
290 |
Copy(FmtAlt,FmtNeu);
|
|
|
291 |
END; (* IF X in der Formatanweisung *)
|
|
|
292 |
|
|
|
293 |
(* Pruefe ob wenigstens eine geklammerten Ausdrueck vorliegt *)
|
|
|
294 |
|
|
|
295 |
ip:=PosChar(FmtAlt,"(",0);
|
|
|
296 |
|
|
|
297 |
(* Keine geklammerten Ausdruecke, fertig ... *)
|
|
|
298 |
|
|
|
299 |
IF (ip = MAX(CARDINAL)) THEN RETURN; END;
|
|
|
300 |
|
|
|
301 |
(* Ermittel die Anzahl der geklammerten Ausdruecke *)
|
|
|
302 |
|
|
|
303 |
Trenner:="()";
|
|
|
304 |
StringTok(FmtAlt,Trenner,TRUE,Tokens,NToken,done);
|
|
|
305 |
nk := ((NToken-1) DIV 2);
|
|
|
306 |
|
|
|
307 |
(* Bearbeite die geklammerten Ausdruecke ... *)
|
|
|
308 |
|
|
|
309 |
k:=1;
|
|
|
310 |
IF debug THEN TIO.WrLn; END;
|
|
|
311 |
FOR itok:=1 TO NToken DO
|
|
|
312 |
IF (Tokens[itok][0] = ")") THEN Delete(Tokens[itok],0,1); END;
|
|
|
313 |
IF (Tokens[itok][0] = "(") THEN
|
|
|
314 |
IstInKlammer[itok] := TRUE;
|
|
|
315 |
Delete(Tokens[itok],0,1);
|
|
|
316 |
|
|
|
317 |
zahl[0] := Tokens[itok-1][LENGTH(Tokens[itok-1])-1];
|
|
|
318 |
zahl[1] := 0C;
|
|
|
319 |
StringToCard(zahl,zaehler,result);
|
|
|
320 |
IF (result # strAllRight) THEN
|
|
|
321 |
done := FALSE;
|
|
|
322 |
TIO.WrStr(" zahl (fehlerhaft) = "); TIO.WrStr(zahl); TIO.WrLn;
|
|
|
323 |
RETURN;
|
|
|
324 |
ELSE
|
|
|
325 |
Zahlen[k]:=zaehler;
|
|
|
326 |
END;
|
|
|
327 |
(* entferne Zaehler aus dem vorherigen Token *)
|
|
|
328 |
Delete(Tokens[itok-1],LENGTH(Tokens[itok-1])-1,1);
|
|
|
329 |
INC(k);
|
|
|
330 |
ELSE
|
|
|
331 |
IstInKlammer[itok] := FALSE;
|
|
|
332 |
END;
|
|
|
333 |
END;
|
|
|
334 |
IF debug THEN
|
|
|
335 |
TIO.WrLn;
|
|
|
336 |
TIO.WrStr("Anzahl Klammern ist "); TIO.WrCard(nk,1);
|
|
|
337 |
TIO.WrLn;
|
|
|
338 |
TIO.WrLn;
|
|
|
339 |
FOR itok:=1 TO NToken DO
|
|
|
340 |
TIO.WrCard(itok,3); TIO.WrChar(" ");
|
|
|
341 |
TIO.WrChar('"'); TIO.WrStr(Tokens[itok]); TIO.WrChar('"');
|
|
|
342 |
IF IstInKlammer[itok] THEN
|
|
|
343 |
TIO.WrStr(" * "); TIO.WrCard(Zahlen[k-1],1);
|
|
|
344 |
END;
|
|
|
345 |
TIO.WrLn;
|
|
|
346 |
END;
|
|
|
347 |
END;
|
|
|
348 |
|
|
|
349 |
FmtNeu[0]:=0C; ik:=1;
|
|
|
350 |
FOR itok:=1 TO NToken DO
|
|
|
351 |
IF NOT IstInKlammer[itok] THEN
|
|
|
352 |
Append(FmtNeu,Tokens[itok]);
|
|
|
353 |
ELSE
|
|
|
354 |
FOR iz:=1 TO Zahlen[ik] DO
|
|
|
355 |
Append(FmtNeu,Tokens[itok]);
|
|
|
356 |
IF (iz < Zahlen[ik]) THEN
|
|
|
357 |
AppendChar(FmtNeu,",");
|
|
|
358 |
END;
|
|
|
359 |
END;
|
|
|
360 |
INC(ik);
|
|
|
361 |
END;
|
|
|
362 |
IF debug THEN
|
|
|
363 |
TIO.WrCard(itok,2); TIO.WrStr(' "');
|
|
|
364 |
TIO.WrStr(FmtNeu); TIO.WrChar('"'); TIO.WrLn;
|
|
|
365 |
END;
|
|
|
366 |
END;
|
|
|
367 |
END PreParseFormat;
|
|
|
368 |
|
143 |
END FormAusLib.
|
369 |
END FormAusLib.
|