-a/FormAusLib.mod
+b/FormAusLib.mod
 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:                                                    *)
   (*                                                                        *)
   (* 05.09.94, MRi: Durchsicht                                              *)
   (* 22.06.15, MRi: Einf"uhren des "An"-Formats in WriteN,dWriteN           *)
   (* 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                                                          *)
   (*                                                                        *)
   (* - Eventuell die Formatanweisung ausgeben wenn eine ByteToXXX Routinen  *)
   (*   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)  *)
+  (* - Ausschreiben von REAL einfuegen - Mechanismus wie bei CARDINAL       *)
   (*------------------------------------------------------------------------*)
+  (* Implementation : Michael Riedl                                         *)
-  (* Licence : GNU Lesser General Public License (LGPL)                     *)
+  (* Licence        : GNU Lesser General Public License (LGPL)              *)
   (*------------------------------------------------------------------------*)
   (* $Id: FormAusLib.mod,v 1.2 2018/01/05 13:41:13 mriedl Exp mriedl $ *)
 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);
           VAR String : StrPrt;
 ...
       ELSE
         I:=ADR(i); RETURN I^;
       END;
 END ByteToLngCard;
 PROCEDURE ByteToLngReal(x      : ARRAY OF BYTE;
                         Laenge : CARDINAL) : LONGREAL;
           VAR R8 : POINTER TO LONGREAL;
               R4 : POINTER TO REAL;
               r8 : LONGREAL;
 BEGIN
       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);
         RETURN R8^;
       ELSE
         R4:=ADR(x); r8:=VAL(LONGREAL,R4^);
         RETURN r8;
       END;
 END ByteToLngReal;
+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
-      NAN := VAL(LONGREAL,TestReal.Real8NaNquite());
+      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.