IMPLEMENTATION MODULE FormAusLib;
(*------------------------------------------------------------------------*)
(* [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 *)
(*------------------------------------------------------------------------*)
(* 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 $ *)
FROM SYSTEM IMPORT BYTE,TSIZE,ADR;
FROM Deklera IMPORT STRING;
FROM Errors IMPORT Fehler,ErrOut;
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;
PROCEDURE WrByteStr(Str : ARRAY OF BYTE; (* F"ur Mocka *)
Laenge : CARDINAL);
VAR String : StrPrt;
BEGIN
String:=ADR(Str);
IF (Laenge > TSIZE(STRING)) THEN
ErrOut("Zeichenkette zu lang (TFormAus.ByteToStr) !");
Laenge:=TSIZE(STRING) - 1;
END;
String^[Laenge]:=0C;
TIO.WrStr(String^);
END WrByteStr;
PROCEDURE WrByteStrN(Str : ARRAY OF BYTE; (* F"ur Mocka *)
Laenge : CARDINAL);
VAR String : StrPrt;
BEGIN
String:=ADR(Str);
IF (Laenge > TSIZE(STRING)) THEN
ErrOut("Zeichenkette zu lang (TFormAus.ByteToStr) !");
Laenge:=TSIZE(STRING) - 1;
END;
String^[Laenge]:=0C;
TIO.WrStrForm(String^,-VAL(INTEGER,Laenge));
END WrByteStrN;
PROCEDURE ByteToStr(Str : ARRAY OF BYTE;
Laenge : CARDINAL) : StrPrt;
VAR String : StrPrt;
BEGIN
String:=ADR(Str);
IF (Laenge > TSIZE(STRING)) THEN
ErrOut("Zeichenkette zu lang (TFormAus.ByteToStr) !");
Laenge:=TSIZE(STRING) - 1;
END;
String^[Laenge]:=0C; (* Hier ausschreiben klappt noch mit Mocka *)
RETURN String;
END ByteToStr;
PROCEDURE ByteToInt(i : ARRAY OF BYTE;
Laenge : CARDINAL) : INTEGER;
VAR I : POINTER TO INTEGER;
BEGIN
IF (Laenge # TSIZE(INTEGER)) THEN
Fehler:=TRUE;
TIO.WrStr('Fehler in ByteToInt.');
RETURN MAX(INTEGER);
ELSE
I:=ADR(i); RETURN I^;
END;
END ByteToInt;
PROCEDURE ByteToCard(i : ARRAY OF BYTE;
Laenge : CARDINAL) : CARDINAL;
VAR I : POINTER TO CARDINAL;
BEGIN
IF (Laenge # TSIZE(CARDINAL)) THEN
Fehler:=TRUE;
TIO.WrStr('Fehler in ByteToCard.');
RETURN MAX(CARDINAL);
ELSE
I:=ADR(i); RETURN I^;
END;
END ByteToCard;
PROCEDURE ByteToLngCard(i : ARRAY OF BYTE;
Laenge : CARDINAL) : LONGCARD;
VAR I : POINTER TO LONGCARD;
BEGIN
IF (Laenge # TSIZE(LONGCARD)) THEN
Fehler:=TRUE;
TIO.WrStr('Fehler in ByteToLngCard.');
RETURN MAX(LONGCARD);
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 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
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.