--- a/FormAusLib.mod
+++ b/FormAusLib.mod
@@ -1,7 +1,16 @@
IMPLEMENTATION MODULE FormAusLib;
(*------------------------------------------------------------------------*)
- (* Routinen die gemeinsam von {T|F|S}FormAus genutzt werden *)
+ (* [DE] Routinen die gemeinsam von {T|F|S}FormAus genutzt werden. *)
+ (* *)
+ (* Der Parameter "Laenge" gibt jeweils die Anzahl uebergebener Bytes an *)
+ (* wenn nicht explizit etwas anderes in der Prozedurebeschreibung ange- *)
+ (* geben ist. *)
+ (* *)
+ (* [EN] Routines used by {T|F|S}FormAus. NOT for direct use !!! *)
+ (* *)
+ (* The parameter "Laenge" defines the number of bytes handed over in all *)
+ (* procedures if not explicitly describes having another meaning *)
(*------------------------------------------------------------------------*)
(* Letzte Bearbeitung: *)
(* *)
@@ -10,6 +19,9 @@
(* 02.10.16, MRi: Aufsplitten der Module FormAus und SFormAus in *)
(* TFormAus,FFormAus,SFormAus *)
(* 02.12.16, MRi: In ByteToLngReal Umwandlung von 4-BYTE Reals eingefuegt *)
+ (* 28.06.18, MRi: Erstellen der ersten Version von PreParseFormat *)
+ (* 29.06.18, MRi: Korrekturen in PreParseFormat, erstellen von StrTok *)
+ (* 03.07.18, MRi: Ersetzen von StrTok durch StringTok *)
(*------------------------------------------------------------------------*)
(* Offene Punkte *)
(* *)
@@ -17,9 +29,10 @@
(* einen Fehler meldet so dass diese leichter gefunden werden kann. *)
(* - Durchsicht der Laengenparameter fuer Cardinal *)
(* - Ausschreiben einer LONGINT wie LONGCARD behandeln *)
- (* - Ausschreiben von REAL einfuegen - Mechanismus wie bei CARDINAL (OK) *)
- (*------------------------------------------------------------------------*)
- (* Licence : GNU Lesser General Public License (LGPL) *)
+ (* - Ausschreiben von REAL einfuegen - Mechanismus wie bei CARDINAL *)
+ (*------------------------------------------------------------------------*)
+ (* Implementation : Michael Riedl *)
+ (* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: FormAusLib.mod,v 1.2 2018/01/05 13:41:13 mriedl Exp mriedl $ *)
@@ -27,10 +40,14 @@
FROM SYSTEM IMPORT BYTE,TSIZE,ADR;
FROM Deklera IMPORT STRING;
FROM Errors IMPORT Fehler,ErrOut;
- IMPORT TestReal; (* Sollte IEEE.NAN sein *)
+ IMPORT Errors;
+FROM StringsLib IMPORT Length,Copy,Append,Delete,PosChar,AppendChar,
+ Stripped,SubString;
+FROM CharClass IMPORT IsNumeric;
+FROM NumConvert IMPORT StringToCard;
+FROM ConvTypes IMPORT ConvResults;
IMPORT TIO;
-VAR NAN : LONGREAL;
PROCEDURE WrByteStr(Str : ARRAY OF BYTE; (* F"ur Mocka *)
Laenge : CARDINAL);
@@ -116,7 +133,6 @@
END;
END ByteToLngCard;
-
PROCEDURE ByteToLngReal(x : ARRAY OF BYTE;
Laenge : CARDINAL) : LONGREAL;
@@ -127,7 +143,7 @@
IF (Laenge # TSIZE(LONGREAL)) AND (Laenge # TSIZE(REAL)) THEN
Fehler:=TRUE;
TIO.WrStr('Fehler in ByteToLngReal.');
- RETURN VAL(LONGREAL,NAN);
+ RETURN MAX(LONGREAL);
END;
IF (Laenge = TSIZE(LONGREAL)) THEN
R8:=ADR(x);
@@ -138,6 +154,216 @@
END;
END ByteToLngReal;
-BEGIN
- NAN := VAL(LONGREAL,TestReal.Real8NaNquite());
+PROCEDURE StringTok( Quelle : ARRAY OF CHAR;
+ Trenner : ARRAY OF CHAR;
+ include : BOOLEAN;
+ VAR Tokens : ARRAY OF ARRAY OF CHAR;
+ VAR NToken : CARDINAL;
+ VAR done : BOOLEAN);
+
+ (*----------------------------------------------------------------*)
+ (* Sehr einfacher Tokenisierer, faengt multiple Trennzeichen *)
+ (* zwischen einzelnen Token nicht ab, nur fuer speziellen Zweck. *)
+ (* *)
+ (* Simple tokenier, does not capture occurence of multiple *)
+ (* separators between tokens, not for general use. *)
+ (*----------------------------------------------------------------*)
+
+ VAR anz : CARDINAL;
+
+ PROCEDURE IstTrennZeichen(chr : CHAR) : BOOLEAN;
+
+ VAR gefunden : BOOLEAN;
+ itr : CARDINAL;
+ BEGIN
+ gefunden := (chr = 0C); itr:=0;
+ WHILE NOT gefunden AND (itr < anz) DO
+ gefunden := (chr = Trenner[itr]); INC(itr);
+ END;
+ RETURN gefunden;
+ END IstTrennZeichen;
+
+ VAR is,ie,len,ipos,itok : CARDINAL;
+BEGIN
+ done:=TRUE;
+ len:=Length(Quelle);
+ anz:=Length(Trenner);
+ is:=0; ipos:=0; itok:=0;
+ WHILE (ipos <= len+1) DO
+ IF IstTrennZeichen(Quelle[ipos]) THEN
+ IF (ipos > 0) THEN ie := ipos-1; ELSE ie:=0; END;
+ SubString(Quelle,is,ie,Tokens[itok]);
+ IF (Tokens[itok][0] # 0C) THEN INC(itok); END;
+ IF include THEN is:=ie+1; ELSE is:=ie+2; END;
+ END;
+ INC(ipos);
+ END;
+ NToken:=itok;
+END StringTok;
+
+PROCEDURE PreParseFormat( FmtAlt : ARRAY OF CHAR;
+ VAR FmtNeu : ARRAY OF CHAR;
+ VAR done : BOOLEAN);
+
+ CONST debug = (1 = 0);
+ X = "X";
+
+ VAR Trenner : ARRAY [0.. 7] OF CHAR;
+ tmpstr : ARRAY [0..15] OF CHAR;
+ zahl : ARRAY [0..15] OF CHAR;
+ Tokens : ARRAY [1..32] OF ARRAY [0..127] OF CHAR;
+ NToken,itok : CARDINAL;
+ zaehler,iz,ix: CARDINAL;
+ Zahlen : ARRAY [1..4] OF CARDINAL;
+ k,ik,nk,ip : CARDINAL;
+ s,e,len : CARDINAL;
+ result : ConvResults;
+ IstInKlammer : ARRAY [1..8] OF BOOLEAN;
+BEGIN
+ done:=TRUE;
+ Stripped(FmtAlt," ");
+ (* Ersetze nX durch Xn im Format *)
+ ip:=PosChar(FmtAlt,"X",0);
+ IF (ip # MAX(CARDINAL)) THEN (* nX in Format enthalten *)
+ Trenner:=",";
+ StringTok(FmtAlt,Trenner,TRUE,Tokens,NToken,done);
+ FmtNeu[0]:=0C;
+ FOR itok:=1 TO NToken DO
+ IF debug THEN
+ TIO.WrLn;
+ TIO.WrCard(itok,2);
+ TIO.WrStr(' "'); TIO.WrStr(Tokens[itok]); TIO.WrChar('"');
+ END;
+ len := Length(Tokens[itok]);
+ ix := PosChar(Tokens[itok],"X",0);
+ IF (ix = 0) THEN
+ Errors.ErrOut("Vorgaenger von X nicht vorhanden ()");
+ END;
+ IF (ix # MAX(CARDINAL)) THEN (* es gibt ein "nX" *)
+ IF NOT IsNumeric(Tokens[itok][ix-1]) THEN
+ Errors.ErrOut("Vorgaenger von X nicht numerisch ()");
+ END;
+ e:=ix-1; k:=e;
+ WHILE (k > 0) AND IsNumeric(Tokens[itok][k-1]) DO
+ (* Ermittel den Anfang "s" von n *)
+ DEC(k);
+ END;
+ s:=k;
+
+ IF debug THEN
+ TIO.WrStr(' Token = "');
+ TIO.WrStr(Tokens[itok]); TIO.WrStr('" s,e = ');
+ TIO.WrCard(s,3); TIO.WrCard(e,3); TIO.WrLn;
+ END;
+
+ (* Zeichen vor "n" *)
+ IF (s > 0) THEN
+ FOR k:=0 TO s-1 DO tmpstr[k]:=Tokens[itok][k]; END;
+ END;
+
+ tmpstr[s]:="X"; (* jetzt Xn *)
+ FOR k:=s TO e DO tmpstr[k+1]:=Tokens[itok][k]; END;
+
+ (* Was kommt hinter dem X ... *)
+ FOR k:=ix+1 TO len DO tmpstr[k]:=Tokens[itok][k]; END;
+ tmpstr[len+1]:=0C;
+
+ Copy(Tokens[itok],tmpstr); (* Ersetze alten Token *)
+ IF debug THEN
+ TIO.WrStr('tmpstr : "'); TIO.WrStr(tmpstr); TIO.WrChar('"');
+ TIO.WrLn;
+ TIO.WrStr(" x ");
+ END;
+ ELSE
+ IF debug THEN TIO.WrStr(" - "); END;
+ END;
+ IF debug THEN
+ TIO.WrStr(' = "'); TIO.WrStr(Tokens[itok]); TIO.WrChar('"');
+ TIO.WrLn;
+ END;
+ Append(FmtNeu,Tokens[itok]); (* Baue die Formatanweisung neu auf *)
+ IF debug THEN
+ TIO.WrLn; TIO.WrCard(itok,2); TIO.WrStr(" neu : '");
+ TIO.WrStr(FmtAlt); TIO.WrChar("'"); TIO.WrLn;
+ END;
+ END;
+ Copy(FmtAlt,FmtNeu);
+ END; (* IF X in der Formatanweisung *)
+
+ (* Pruefe ob wenigstens eine geklammerten Ausdrueck vorliegt *)
+
+ ip:=PosChar(FmtAlt,"(",0);
+
+ (* Keine geklammerten Ausdruecke, fertig ... *)
+
+ IF (ip = MAX(CARDINAL)) THEN RETURN; END;
+
+ (* Ermittel die Anzahl der geklammerten Ausdruecke *)
+
+ Trenner:="()";
+ StringTok(FmtAlt,Trenner,TRUE,Tokens,NToken,done);
+ nk := ((NToken-1) DIV 2);
+
+ (* Bearbeite die geklammerten Ausdruecke ... *)
+
+ k:=1;
+ IF debug THEN TIO.WrLn; END;
+ FOR itok:=1 TO NToken DO
+ IF (Tokens[itok][0] = ")") THEN Delete(Tokens[itok],0,1); END;
+ IF (Tokens[itok][0] = "(") THEN
+ IstInKlammer[itok] := TRUE;
+ Delete(Tokens[itok],0,1);
+
+ zahl[0] := Tokens[itok-1][LENGTH(Tokens[itok-1])-1];
+ zahl[1] := 0C;
+ StringToCard(zahl,zaehler,result);
+ IF (result # strAllRight) THEN
+ done := FALSE;
+ TIO.WrStr(" zahl (fehlerhaft) = "); TIO.WrStr(zahl); TIO.WrLn;
+ RETURN;
+ ELSE
+ Zahlen[k]:=zaehler;
+ END;
+ (* entferne Zaehler aus dem vorherigen Token *)
+ Delete(Tokens[itok-1],LENGTH(Tokens[itok-1])-1,1);
+ INC(k);
+ ELSE
+ IstInKlammer[itok] := FALSE;
+ END;
+ END;
+ IF debug THEN
+ TIO.WrLn;
+ TIO.WrStr("Anzahl Klammern ist "); TIO.WrCard(nk,1);
+ TIO.WrLn;
+ TIO.WrLn;
+ FOR itok:=1 TO NToken DO
+ TIO.WrCard(itok,3); TIO.WrChar(" ");
+ TIO.WrChar('"'); TIO.WrStr(Tokens[itok]); TIO.WrChar('"');
+ IF IstInKlammer[itok] THEN
+ TIO.WrStr(" * "); TIO.WrCard(Zahlen[k-1],1);
+ END;
+ TIO.WrLn;
+ END;
+ END;
+
+ FmtNeu[0]:=0C; ik:=1;
+ FOR itok:=1 TO NToken DO
+ IF NOT IstInKlammer[itok] THEN
+ Append(FmtNeu,Tokens[itok]);
+ ELSE
+ FOR iz:=1 TO Zahlen[ik] DO
+ Append(FmtNeu,Tokens[itok]);
+ IF (iz < Zahlen[ik]) THEN
+ AppendChar(FmtNeu,",");
+ END;
+ END;
+ INC(ik);
+ END;
+ IF debug THEN
+ TIO.WrCard(itok,2); TIO.WrStr(' "');
+ TIO.WrStr(FmtNeu); TIO.WrChar('"'); TIO.WrLn;
+ END;
+ END;
+END PreParseFormat;
+
END FormAusLib.