IMPLEMENTATION MODULE Formelauswertung;
(*
  Created:   17.11.87
  Changed:   10.02.88/26.8.88/29.9.881/10/88 by
             Stefan Salewski
             Stolper Weg 3
             2160 Stade   West-Germany
             Tel: 04141/61130
  Note: compiled with AMIGA Modula-2 System by AMSoft Version from 5.5.88

*)
  FROM Arts IMPORT Error;
  FROM MyLongRealConversions IMPORT StrToReal;
  FROM MathTrans IMPORT Fieee,Tieee;
  FROM MyMathTrans IMPORT Abs,Fac,Sqr,Power,TAN,Cot,Sec,
    Cosec,Arcsin,Arccos,Arccot,EXP,Ln,LOG,SIN,COS,Arctan,SINH,Arcoth,Int,
    COSH,TANH,Coth,Arsinh,Arcosh,Artanh,SQRT;
  FROM MyMathLibLong IMPORT abs,fac,sqr,power,tan,cot,sec,
    cosec,arcsin,arccos,arccot,exp,ln,log,sin,cos,arctan,arcoth,int,
    sinh,cosh,tanh,coth,arsinh,arcosh,artanh,sqrt,
    errorNumber;
  FROM String IMPORT Insert,Occurs,Delete;
  FROM MyStrings IMPORT Assign,Length;
  FROM MyUties IMPORT Buchstabe,Operator,AddOp,IsADigit;
  FROM SYSTEM IMPORT FFP,ADR;
(*
  Der Bereich Char(1) bis Char(AnzFktn) dient zur Speicherung von
  Funktionssymbolen. z.B. arcsin=Char(1); sin=Char(18) usw.

  Char(58) bis Char(64) entspricht +,-,*,/,^,(,)

  Der Bereich 'A' .. 'z' enthaelt die Werte der definierten Variablen.

  Zeichen groesser 127 symbolisieren die Zahlen in der Formel

  Nach anwendung von DefFormel enthalt die Formel also nur noch Variablen(A..z),
  Zahlen(Char(128)..Char(255)), Funktionsymbole(Char(0)..Char(AnzFktn-1)
  und Plus,Minus,Mal,Durch,Hoch,Bra,Ket.
*)
  CONST
    MaxLongReal=MAX(LONGREAL);
    MaxFFP=MAX(FFP);
    Plus=CHAR(58);
    Minus=CHAR(59);
    Mal=CHAR(60);
    Durch=CHAR(61);
    Hoch=CHAR(62);
    Bra=CHAR(63);
    Ket=CHAR(64);
    AnzFktn=26;   (* sin,cos...						    *)
    ErsteZahl=CHAR(128);
    LetzteZahl=CHAR(255);
    FirstPos=128; (* Position des ersten zur Zahlenspeicherung            *)
                  (* verwendeten Zeichens
                     Die erste Zahl in der Formel wird ersetzt durch CHAR(128),
                     die zweite durch Char(129) usw bis maximal Char(255).
                     Gleichzeitig bekommt Char(128) den Zahlenwert der ersten
                     Zahl zugewiesen usw.
                   *)

  TYPE
    Zahlen=[ErsteZahl..LetzteZahl];
    FktnStr=ARRAY[0..6] OF CHAR;
    FFPFunktion=PROCEDURE(FFP):FFP;
    LongFunktion=PROCEDURE(LONGREAL):LONGREAL;
    Position=[0..StrLength-1];
  VAR
    zahlenspeicherLong:ARRAY Formelnummer,Zahlen OF LONGREAL;
    zahlenspeicherFFP:ARRAY Formelnummer,Zahlen OF FFP;
    formeln:ARRAY Formelnummer OF Formelstring;
    (*length:ARRAY Formelnummer OF CARDINAL;*)
    belegt:ARRAY['A'..'z'] OF BOOLEAN;
    funktionen:ARRAY[1..AnzFktn] OF FktnStr;
(**********************************************************************)
  PROCEDURE Init;
    VAR c: CHAR;
  BEGIN
    FOR c:='A' TO 'z' DO
      belegt[c]:=FALSE
    END;
    funktionen[1]:='arcsin';
    funktionen[2]:='arccos';
    funktionen[3]:='arctan';
    funktionen[4]:='arsinh';
    funktionen[5]:='arcosh';
    funktionen[6]:='artanh';
    funktionen[7]:='arcoth';
    funktionen[8]:='arccot';
    funktionen[9]:='cosec';
    funktionen[10]:='sinh';
    funktionen[11]:='cosh';
    funktionen[12]:='tanh';
    funktionen[13]:='coth';
    funktionen[14]:='sqrt';
    funktionen[15]:='sqr';
    funktionen[16]:='cot';
    funktionen[17]:='sec';
    funktionen[18]:='sin';
    funktionen[19]:='cos';
    funktionen[20]:='tan';
    funktionen[21]:='log';
    funktionen[22]:='exp';
    funktionen[23]:='fac';
    funktionen[24]:='abs';
    funktionen[25]:='int';
    funktionen[26]:='ln';
  END Init;
(**********************************************************************)
  PROCEDURE SoS(c:CHAR):BOOLEAN;
  BEGIN
    RETURN (c<=CHAR(AnzFktn)) AND (c#0C)
  END SoS;
  PROCEDURE Zahl(c:CHAR):BOOLEAN;
  BEGIN
    RETURN (c>CHAR(127)) OR ((c>='A') AND (c<='z'));
  END Zahl;
  PROCEDURE Gueltig(c:CHAR):BOOLEAN;
  BEGIN
    RETURN IsADigit(c) OR (Buchstabe(c)  OR Operator(c) OR (c='(') OR (c=')')
       OR (c='.'))
  END Gueltig;
  PROCEDURE ASet(c:CHAR):BOOLEAN;
  BEGIN
    RETURN ((c>=Plus) AND (c<=Hoch)) OR (c=Ket)
  END ASet;
  PROCEDURE CSet(c:CHAR):BOOLEAN;
  BEGIN
    RETURN (Zahl(c))  OR (c=Ket)
  END CSet;
  PROCEDURE DSet(c:CHAR):BOOLEAN;
  BEGIN
    RETURN (Zahl(c) OR (c=Bra) OR SoS(c))
  END DSet;

  PROCEDURE FormelOK(VAR str:Formelstring):BOOLEAN;
    VAR kl:INTEGER;
      i,l:CARDINAL;
  BEGIN
    l:=Length(str)-1;
    FOR i:=0 TO l DO
      IF NOT Gueltig(str[i]) THEN RETURN FALSE END
    END;
    kl:=0;
    FOR i:=0 TO l DO
      IF str[i]='(' THEN
        INC(kl)
      ELSIF str[i]=')' THEN
        DEC(kl)
      END;
      IF kl<0 THEN
        RETURN FALSE
      END
    END;
    RETURN kl=0
  END FormelOK;

  PROCEDURE SyntaxOK(VAR str:Formelstring):BOOLEAN;
    VAR i,len: CARDINAL;
      ok:BOOLEAN;
  BEGIN
    i:=0;
    ok:=TRUE;
    IF (str[i]=Ket) OR (str[i]=0C) OR (str[i]=Mal) OR (str[i]=Durch)
        OR (str[i]=Hoch) THEN
      RETURN FALSE
    ELSE
      len:=Length(str)-1;
      WHILE (i<len) AND ok DO
        IF str[i]=Bra THEN
          ok:=(str[i+1]#Ket) AND (str[i+1]#Mal) AND (str[i+1]#Durch)
                   AND (str[i+1]#Hoch)
        ELSIF (str[i]=Ket) OR Zahl(str[i]) THEN
          ok:=ASet(str[i+1])
        ELSIF SoS(str[i]) THEN
          ok:=(str[i+1]=Bra)
        ELSIF (str[i]>=Plus) AND (str[i]<=Hoch) THEN
          ok:=DSet(str[i+1])
        ELSE
          RETURN FALSE;
        END;
        INC(i);
      END;
    END;
    IF NOT ok THEN
      RETURN FALSE
    ELSE
      RETURN CSet(str[i])
    END;
  END SyntaxOK;

  PROCEDURE AssignLong(c:CHAR;x:LONGREAL):BOOLEAN;
  BEGIN
    IF (c>='A') AND (c<='z') THEN
      varListLong[c]:=x;
      varListFFP[c]:=Fieee(REAL(x));
      belegt[c]:=TRUE;
      RETURN TRUE
    ELSE
      RETURN FALSE
    END;
  END AssignLong;

  PROCEDURE AssignFFP(c:CHAR;x:FFP):BOOLEAN;
  BEGIN
    IF (c>='A') AND (c<='z') THEN
      varListLong[c]:=LONGREAL(Tieee(x));
      varListFFP[c]:=x;
      belegt[c]:=TRUE;
      RETURN TRUE
    ELSE
      RETURN FALSE
    END;
  END AssignFFP;

  PROCEDURE ClearVar(c:CHAR);
  BEGIN
    IF Buchstabe(c) THEN
      belegt[c]:=FALSE
    END
  END ClearVar;
(**********************************************************************)
  PROCEDURE GetLongValue(c:CHAR;VAR x:LONGREAL):BOOLEAN;
  BEGIN
    IF Buchstabe(c) AND belegt[c] THEN
      x:=varListLong[c];
      RETURN TRUE
    ELSE
      RETURN FALSE
    END
  END GetLongValue;
  (**********************************************************************)
  PROCEDURE GetFFPValue(c:CHAR;VAR x:FFP):BOOLEAN;
  BEGIN
    IF Buchstabe(c) AND belegt[c] THEN
      x:=varListFFP[c];
      RETURN TRUE
    ELSE
      RETURN FALSE
    END
  END GetFFPValue;
(**********************************************************************)
  PROCEDURE SetBrackets(VAR str:ARRAY OF CHAR):BOOLEAN;
    TYPE StrPos=[0..StrLength-1];
    VAR i,leftpos,rightpos,laenge:StrPos;
      lok:BOOLEAN;
      string:Formelstring;
      hi:CARDINAL;
    PROCEDURE Testelinks(c1,c2,c3,c4:CHAR;i:StrPos;
                         VAR bPos:StrPos;VAR noetig:BOOLEAN);
      VAR j: StrPos;
      PROCEDURE Jumpleft;
      BEGIN
        REPEAT
          DEC(j);
          IF string[j]=Ket THEN
            Jumpleft
          END;
        UNTIL string[j]=Bra;
        IF j>0 THEN
          DEC(j)
        END;
      END Jumpleft;
    BEGIN (* Testelinks *)
      j:=i;
      REPEAT
        DEC(j);
        IF string[j]=Ket THEN
          Jumpleft
         END;
        noetig:=(string[j]=c1) OR (string[j]=c3) OR (string[j]=c2) OR
          (string[j]=c4);
      UNTIL noetig OR (string[j]=Bra) OR (j=0);
      noetig:=noetig AND (j#0);
  (*noetig:=noetig AND NOT ((j=0) AND ((string[0]=Plus) OR (string[i]=Minus));*)
  (*    noetig:=noetig AND NOT((i>1) AND ((string[j])=Plus) OR
            (string[j]=Minus) AND (string[j-1]='E') AND IsADigit(string[j-2]));
   *)
      bPos:= j+1;
    END Testelinks;

    PROCEDURE Testerechts(c1,c2,c3,c4:CHAR;i:StrPos;
                          VAR bPos:StrPos);
      VAR j,strLaenge: StrPos;
        gesucht:BOOLEAN;
      PROCEDURE Jumpright;
      BEGIN
        REPEAT
          INC(j);
          IF string[j]=Bra THEN
            Jumpright
          END;
        UNTIL string[j]=Ket;
        INC(j);
      END Jumpright;
    BEGIN
      strLaenge:=Length(string);
      j:=i;
      REPEAT
        INC(j);
        IF string[j]=Bra THEN
          Jumpright
        END;
        gesucht:=(string[j]=c1) OR (string[j]=c3) OR (string[j]=c2) OR
                 (string[j]=c4);
      UNTIL (j>=strLaenge) OR gesucht OR (string[j]=Ket);
      bPos:=j;
      IF j=strLaenge THEN
        INC(bPos)
      END;
    END Testerechts;

    PROCEDURE Set(lk,rk:StrPos);
    (* Setzt Klammern an die Positionen lk und rk *)
    BEGIN
      Insert(string,lk,Bra);
      IF rk=Length(string) THEN
        string[rk]:=Ket;
        string[rk+1]:=0C
      ELSE
        Insert(string,rk+1,Ket)
      END;
    END Set;
  BEGIN
    hi:=HIGH(str);
    laenge:=Length(str);
    IF laenge< StrLength-1 THEN
      Assign(string,str);
      string[laenge]:=0C;
      string[laenge+1]:=0C;
      string[laenge+2]:=0C;
      i:=0;
      REPEAT
        IF string[i]=Hoch THEN
          Testelinks(Mal,Durch,Plus,Minus,i,leftpos,lok);
          IF lok THEN
          Testerechts(Mal,Durch,Plus,Minus,i,rightpos);
       (*   IF lok THEN *)
            Set(leftpos,rightpos);
            INC(laenge,2)
           END
        END;
        INC(i);
      UNTIL (i=laenge) OR (laenge>hi);
      IF laenge>hi THEN
        RETURN FALSE
      END;
      i:=0;
      REPEAT
        IF (string[i]=Mal) OR (string[i]=Durch) THEN
          Testelinks(Plus,Plus,Minus,Minus,i,leftpos,lok);
          IF lok THEN
          Testerechts(Plus,Plus,Minus,Minus,i,rightpos);
          (* IF lok THEN *)
            Set(leftpos,rightpos);
            INC(laenge,2)
          END
        END;
        INC(i);
      UNTIL (i=laenge) OR (laenge>hi);
      IF laenge>hi THEN
        RETURN FALSE
      END;
      Assign(str,string);
      RETURN TRUE
    ELSE
      RETURN FALSE
    END;
  END SetBrackets;
(**********************************************************************)
  PROCEDURE FFPBerechnung(nummer:Formelnummer;
		      VAR ergebnis:FFP;
                      VAR fehlernummer:CARDINAL);
    VAR pos: CARDINAL;
      ch:CHAR;

    PROCEDURE Ausdruck():FFP; FORWARD;
    PROCEDURE Neuezahl():FFP;
      VAR helpChr:CHAR;
    BEGIN
      IF formeln[nummer,pos]=Bra THEN
        INC(pos);
        RETURN Ausdruck()
      ELSE
        helpChr:=formeln[nummer,pos];
        INC(pos);
        IF (helpChr>='A') AND (helpChr<='z') THEN
	  RETURN varListFFP[helpChr]
        ELSE
	  RETURN zahlenspeicherFFP[nummer,helpChr]
        END
      END
    END Neuezahl;

    PROCEDURE Ausdruck():FFP;
      VAR func:FFPFunktion;
        oper:CHAR;
        argument,ergebnis:FFP;
    BEGIN
      ergebnis:=0.0;
      WHILE (formeln[nummer,pos]#Ket) AND (formeln[nummer,pos]#0C)
                                      AND (errorNumber=0) DO
        IF (formeln[nummer,pos]>=Plus) AND (formeln[nummer,pos]<=Hoch) THEN
          oper:=formeln[nummer,pos];
          INC(pos)
        ELSE
          oper:=Plus
        END;
        IF formeln[nummer,pos]<=CHAR(AnzFktn) THEN (* Funktionsberechnung *)
          CASE formeln[nummer,pos] OF
            01C:func:=Arcsin|
            02C:func:=Arccos|
            03C:func:=Arctan|
            04C:func:=Arsinh|
            05C:func:=Arcosh|
            06C:func:=Artanh|
            07C:func:=Arcoth|
            10C:func:=Arccot|
            11C:func:=Cosec|
            12C:func:=SINH|
            13C:func:=COSH|
            14C:func:=TANH|
            15C:func:=Coth|
            16C:func:=SQRT|
            17C:func:=Sqr|
            20C:func:=Cot|
            21C:func:=Sec|
            22C:func:=SIN|
            23C:func:=COS|
            24C:func:=TAN|
            25C:func:=LOG|
            26C:func:=EXP|
            27C:func:=Fac|
            30C:func:=Abs|
            31C:func:=Int|
            32C:func:=Ln|
          ELSE
            Error(ADR('FFPBerechnung'),ADR('Case Formel... Error'))
          END;(* Case *)
          INC(pos);
          argument:=func(Neuezahl());
        ELSE
          argument:=Neuezahl();
        END;
        IF errorNumber=0 THEN
          CASE oper OF
            Plus:ergebnis:=ergebnis+argument;
                IF ABS(ergebnis)>=MaxFFP THEN
                  errorNumber:=104
                END|
            Minus:ergebnis:=ergebnis-argument;
                IF ABS(ergebnis)>=MaxFFP THEN
                  errorNumber:=105
                END|
            Hoch:ergebnis:=Power(ergebnis,argument)|
            Mal:ergebnis:=ergebnis*argument;
                IF ABS(ergebnis)>=MaxFFP THEN
                  errorNumber:=103
                END|
            Durch:IF argument=0.0 THEN
                  errorNumber:=101
                ELSE
                  ergebnis:=ergebnis/argument;
                  IF ABS(ergebnis)>=MaxFFP THEN
                    errorNumber:=102 (*overflov*)
                  END;
                END|
            ELSE
              Error(ADR('FFPBerechnung'),ADR('Operator... Error'))
          END
        END
      END;
      IF formeln[nummer,pos]=Ket THEN INC(pos);END;
      RETURN ergebnis
    END Ausdruck;
  BEGIN (* Auswertung *)
    IF formeln[nummer,0]#0C THEN
      pos:=0;
      errorNumber:=0;
      ergebnis:=Ausdruck();
      fehlernummer:=errorNumber
    ELSE
      ergebnis:=0.0;
      fehlernummer:=31
    END
  END FFPBerechnung;
(**********************************************************************)
  PROCEDURE LongBerechnung(nummer:Formelnummer;
		           VAR ergebnis:LONGREAL;
                           VAR fehlernummer:CARDINAL);
    VAR
      pos: CARDINAL;
      ch:CHAR;

    PROCEDURE Ausdruck():LONGREAL; FORWARD;
    PROCEDURE Neuezahl():LONGREAL;
      VAR helpChr:CHAR;
    BEGIN
      IF formeln[nummer,pos]=Bra THEN
        INC(pos);
        RETURN Ausdruck()
      ELSE
        helpChr:=formeln[nummer,pos];
        INC(pos);
        IF (helpChr>='A') AND (helpChr<='z') THEN
	  RETURN varListLong[helpChr]
        ELSE
	  RETURN zahlenspeicherLong[nummer,helpChr]
        END
      END
    END Neuezahl;

    PROCEDURE Ausdruck():LONGREAL;
      VAR func: LongFunktion;
        oper: CHAR;
        argument,ergebnis:LONGREAL;
    BEGIN
      ergebnis:=0.0;
      WHILE (formeln[nummer,pos]#Ket) AND (formeln[nummer,pos]#0C)
                                      AND (errorNumber=0) DO
        IF (formeln[nummer,pos]>=Plus) AND (formeln[nummer,pos]<=Hoch) THEN
          oper:=formeln[nummer,pos];
          INC(pos)
        ELSE
          oper:=Plus
        END;
        IF formeln[nummer,pos]<=CHAR(AnzFktn) THEN (* Funktionsberechnung *)
          CASE formeln[nummer,pos] OF
            01C:func:=arcsin|
            02C:func:=arccos|
            03C:func:=arctan|
            04C:func:=arsinh|
            05C:func:=arcosh|
            06C:func:=artanh|
            07C:func:=arcoth|
            10C:func:=arccot|
            11C:func:=cosec|
            12C:func:=sinh|
            13C:func:=cosh|
            14C:func:=tanh|
            15C:func:=coth|
            16C:func:=sqrt|
            17C:func:=sqr|
            20C:func:=cot|
            21C:func:=sec|
            22C:func:=sin|
            23C:func:=cos|
            24C:func:=tan|
            25C:func:=log|
            26C:func:=exp|
            27C:func:=fac|
            30C:func:=abs|
            31C:func:=int|
            32C:func:=ln|
          ELSE
            Error(ADR('LongBerechnung'),ADR('Case Formel... Error'))
          END;(* Case *)
          INC(pos);
          argument:=func(Neuezahl());
        ELSE
          argument:=Neuezahl();
        END;
        IF errorNumber=0 THEN
          CASE oper OF
            Plus:ergebnis:=ergebnis+argument;
                IF ABS(ergebnis)>=MaxLongReal THEN
                  errorNumber:=104
                END|
            Minus:ergebnis:=ergebnis-argument;
                IF ABS(ergebnis)>=MaxLongReal THEN
                  errorNumber:=105
                END|
            Hoch:ergebnis:=power(ergebnis,argument)|
            Mal:ergebnis:=ergebnis*argument;
                IF ABS(ergebnis)>=MaxLongReal THEN
                  errorNumber:=103
                END|
            Durch:IF argument=0.0 THEN
                    errorNumber:=101
                  ELSE
                    ergebnis:=ergebnis/argument;
                    IF ABS(ergebnis)>=MaxLongReal THEN
                      errorNumber:=102 (*overflov*)
                    END
                  END|
          ELSE
            Error(ADR('LongBerechnung'),ADR('Operator... Error'))
          END
        END
      END;
      IF formeln[nummer,pos]=Ket THEN INC(pos) END;
      RETURN ergebnis
    END Ausdruck;
  BEGIN (* Auswertung *)
    IF formeln[nummer,0]#0C THEN
      pos:=0;
      errorNumber:=0;
      ergebnis:=Ausdruck();
      fehlernummer:=errorNumber
    ELSE
      ergebnis:=0.0;
      fehlernummer:=31
    END
  END LongBerechnung;
(**********************************************************************)
  PROCEDURE DefFormel(nummer:Formelnummer;VAR str:ARRAY OF CHAR;
                      korrekt,onlyLong:BOOLEAN):CARDINAL;
    VAR
      testStr:Formelstring;
      i,soOft:CARDINAL;
      synOK,vD:BOOLEAN;
      fehlernummer:CARDINAL;
      zeichen:CHAR;
    PROCEDURE VarDef(VAR str:Formelstring):BOOLEAN;
      VAR i:CARDINAL;
    BEGIN
      FOR i:=0 TO Length(str)-1 DO
        IF ((str[i]>='A') AND (str[i]<='z')) AND NOT belegt[str[i]] THEN
          RETURN FALSE
        END
      END;
      RETURN TRUE;
    END VarDef;

    PROCEDURE Transform(VAR str:Formelstring;VAR wieOft:CARDINAL):BOOLEAN;
    (* Substituiert Zahlen im String durch Zeichen
       und weist den entsprechenden Feldvariablen den Zahlenwert zu        *)
    (* 7.98 ==> CHAR(128); zahlenspeicherLong[Char(128)]:=7.98             *)
      VAR
        i,zahllaenge:Position;
        x:LONGREAL;
        zeichen:CHAR;
        help: ARRAY[0..0] OF CHAR;
        vorzZahlmoegl,getOK: BOOLEAN;

      PROCEDURE GetNumber(pos:Position; VAR l:Position;VAR x:LONGREAL):BOOLEAN;
      (* weist den Wert der Zahl, die an der Position pos im String Str
         Steht und l Zeichen lang ist x zu                                 *)
        VAR s:Formelstring;
          k,i:CARDINAL;
          error,zifORadop:BOOLEAN;
      BEGIN
        error:=FALSE;
        i:=pos;
        l:=0;
        IF (str[i]='+') OR (str[i]='-')  THEN
          s[0]:=str[i];
          INC(l)
        END;
        WHILE IsADigit(str[i+l]) DO
          s[l]:=str[i+l];
          INC(l)
        END;
        IF str[i+l] ='.' THEN
          s[l]:=str[i+l];
          INC(l);
          WHILE IsADigit(str[i+l]) DO
            s[l]:=str[i+l];
            INC(l);
          END
        END;
        IF str[i+l]='E' THEN
          zifORadop:=IsADigit(str[i+1+l]) OR (AddOp(str[i+1+l]) AND
            IsADigit(str[i+2+l]));
          IF zifORadop THEN
            s[l]:= str[i+l];
            INC(l);
            IF AddOp(str[i+l]) THEN
              s[l]:=str[i+l];INC(l)
            END;
            k:=0;
            WHILE IsADigit(str[i+l]) AND (k<3) DO
              s[l]:= str[i+l];
              INC(l);
              INC(k);
            END;
            onlyLong:=(k=3) OR ((k=2) AND NOT((s[l-2]='0') OR (s[l-2]='1')));
            error:= (k<3) OR ((k=3) AND ((s[l-3]='0') OR (s[l-3]='1') OR
              (s[l-3]='2')));
            error:=NOT error
          END
        END;
        s[l]:=0C;
        IF NOT error THEN
          StrToReal(s,x,error)
        END;
        RETURN NOT error
      END GetNumber;
    BEGIN (* Transform*)
      i:=0;
      wieOft:=0;
      getOK:=TRUE;
      WHILE (i<=Length(str)) AND getOK DO
        vorzZahlmoegl:=(i=0) OR (str[i-1]='(');
        IF IsADigit(str[i]) OR (AddOp(str[i]) AND vorzZahlmoegl AND
           IsADigit(str[i+1])) THEN
          getOK:=GetNumber(i,zahllaenge,x);
          IF getOK THEN
            zeichen:=CHR(FirstPos+wieOft);
            zahlenspeicherLong[0,zeichen]:=x;
            Delete(str,i,zahllaenge);
            help[0]:= CHR(FirstPos+wieOft);
            IF i= Length(str) THEN
              str[i]:=help[0];
              str[i+1]:=0C
            ELSE
              Insert(str,i,help)
            END;
            INC(wieOft)
          END
        END;
        INC(i)
      END;
      RETURN getOK
    END Transform;
    PROCEDURE Substitute(VAR str:Formelstring);
      VAR i: CARDINAL;
        position:INTEGER;
        s:ARRAY[0..1] OF CHAR;
    BEGIN
      s[1]:=0C;
      FOR i:=1 TO AnzFktn DO
        position:=0;
        REPEAT
          position:=Occurs(str,position,funktionen[i],TRUE);
          IF position#-1 THEN
            Delete(str,position,Length(funktionen[i]));
            s[0]:=CHAR(i);
            Insert(str,position,s);
            INC(position)
          END
        UNTIL position=-1
      END
    END Substitute;
  BEGIN
    IF (str[0]#0C) AND (HIGH(str)<=StrLength) AND (Length(str)<StrLength-2) THEN
      Assign(testStr,str);
      fehlernummer:=Length(str);
      testStr[fehlernummer]:=0C;
      testStr[fehlernummer+1]:=0C;
      testStr[fehlernummer+2]:=0C;
      fehlernummer:=0; (* Kein Fehler *)
      IF FormelOK(testStr) THEN
        (* Substitute und Transform arbeiten noch mit +,-,...),
           danach wird mit Plus,....Ket gearbeitet
        *)
        Substitute(testStr);
        IF Transform(testStr,soOft) THEN
          FOR i:=0 TO Length(testStr)-1 DO
            CASE testStr[i] OF
              '+':testStr[i]:=Plus|
              '-':testStr[i]:=Minus|
              '*':testStr[i]:=Mal|
              '/':testStr[i]:=Durch|
              '^':testStr[i]:=Hoch|
              '(':testStr[i]:=Bra|
              ')':testStr[i]:=Ket
            ELSE
            END
          END;
          synOK:=SyntaxOK(testStr);
          vD:=VarDef(testStr);
          IF NOT vD THEN
            fehlernummer:=32
          ELSIF NOT synOK THEN
            fehlernummer:=33
          END
        ELSE
          fehlernummer:=35
        END
      ELSE
        fehlernummer:=34
      END;
      IF fehlernummer#0  THEN
        FOR i:=0 TO StrLength-1 DO formeln[nummer,i]:=0C END
      END
    ELSIF str[0]=0C THEN
      fehlernummer:=31
    ELSE
      Error(ADR('DefFormel'),ADR('Es muss gelten:Len(str)<StrLength-2'))
    END;

    IF (fehlernummer=0) AND korrekt THEN
      IF NOT SetBrackets(testStr) THEN
        fehlernummer:=36
      END
    END;
    IF fehlernummer=0 THEN
      Assign(formeln[nummer],testStr);
      (*length[nummer]:=Length(testStr);*)
      FOR zeichen:= CHR(FirstPos) TO CHR(FirstPos+soOft-1) DO
        zahlenspeicherLong[nummer,zeichen]:=zahlenspeicherLong[0,zeichen];
        zahlenspeicherFFP[nummer,zeichen]:=
                                Fieee(REAL(zahlenspeicherLong[0,zeichen]))
      END
    END;
    RETURN fehlernummer;
  END DefFormel;
(**********************************************************************)
BEGIN
  Init;
END Formelauswertung.mod