(*********************************************************************
  :Module.      Term.mod
  :Author.      Alexander Benner [anb]
  :Address.     Ed.-Steinle-34 , 70619 Stuttgart, Germany
  :EMail.       Internet_> zcf41122@rpool1.rus.uni-stuttgart.de
  :Phone.       0711 / 47 56 32
  :Date.        16-Nov-1993
  :Copyright.   FreeWare.
  :Language.    Oberon-2
  :Translator.  Amiga Oberon 3.00d
  :Contents.    Berechnet Funktion die als String übergeben wird
  :Support.     Das Prinziep hab ich von meinem Info-Lehrer Herr Six
  :History.     v1.0 [anb] 20-Nov-1993 erste veröfentlichte Version
*********************************************************************)
MODULE Term;

IMPORT btp:BasicTypes,
       lst:LinkedLists,
       mtt:MathTrans,
       rnd:Random,
       str:Strings;

CONST flen * = 16;

TYPE fname * = ARRAY 3 OF CHAR;
     flist * = ARRAY flen OF fname;

CONST avf  * = flist (
                      ("ASN"),("ACS"),("ATN"),("COS"),("HCS"),
                      ("EXP"),("LOG"),("ABS"),("HSN"),("SQR"),
                      ("TAN"),("HTN"),("INT"),("SIN"),("RND"),
                      ("NOT")
                     );

CONST (* fehler meldungen *)
     ok           * = 0 ;
     unknownfunk  * = 1 ;
     misbrakclose * = 2 ;
     misbrakopen  * = 3 ;
     divzero      * = 4 ;
     wrongend     * = 5 ;

TYPE string = RECORD (lst.NodeDesc)
                a:btp.DynString END;

     stp    = POINTER TO string;

     function     * = POINTER TO functionDesc;
     functionDesc * = RECORD
                    a     : stp;
                    code -: INTEGER END;

VAR allfunction : lst.List;


PROCEDURE Inifunc * (a:ARRAY OF CHAR) : function;
(* $CopyArrays- *)
VAR f : function;
    i : LONGINT;
BEGIN
  NEW(f);
  NEW(f.a);
  NEW(f.a.a,LEN(a)+1);
  i:=0;
  WHILE a[i]#00X DO
    f.a.a[i]:=a[i];
    INC(i)
  END;
  f.a.a[i]:=";";
  f.a.a[i+1]:=00X;
  allfunction.Add(f.a);
  RETURN f
END Inifunc;


PROCEDURE (f:function) Calc * (x:REAL) : REAL;

VAR pos:INTEGER;symbol:CHAR;wert:REAL;

  PROCEDURE hole(VAR zeichen:CHAR);
  BEGIN
    REPEAT zeichen:=f.a.a[pos];INC(pos) UNTIL zeichen#" ";
  END hole;


  PROCEDURE HoleSumme(VAR summe:REAL);
  VAR summand:REAL;op:CHAR;

    PROCEDURE HoleProdukt(VAR produkt:REAL);
    VAR faktor:REAL;op:CHAR;

      PROCEDURE HoleTerm(VAR term:REAL);

        PROCEDURE HoleZahl(VAR zahl:REAL);
        VAR i:INTEGER;
        BEGIN
          zahl:=0;
          WHILE (symbol>="0") AND (symbol<="9") DO
            zahl:=zahl*10;
            zahl:=zahl+ORD(symbol)-48;
            hole(symbol)
          END;
          IF (symbol=".") OR (symbol=",") THEN
            i:=0;
            hole(symbol);
            WHILE (symbol>="0") AND (symbol<="9") DO
              zahl:=zahl*10;
              zahl:=zahl+ORD(symbol)-48;
              DEC(i);
              hole(symbol)
            END;
            zahl:=zahl*mtt.Pow(i,10);
          END
        END HoleZahl;

        PROCEDURE HoleFunktion(VAR y:REAL);
        VAR fn:fname;
            i :INTEGER;
        BEGIN
          i:=0;
          WHILE i<3 DO
            fn[i]:=CAP(symbol);
            hole(symbol);
            INC(i)
          END;
          i:=0;
          WHILE (i<flen) AND (fn#avf[i]) DO INC(i) END;
          CASE i OF
            0 : HoleTerm(y);y:=mtt.Asin(y) |
            1 : HoleTerm(y);y:=mtt.Acos(y) |
            2 : HoleTerm(y);y:=mtt.Atan(y) |
            3 : HoleTerm(y);y:=mtt.Cos(y)  |
            4 : HoleTerm(y);y:=mtt.Cosh(y) |
            5 : HoleTerm(y);y:=mtt.Exp(y)  |
            6 : HoleTerm(y);y:=mtt.Log(y)  |
            7 : HoleTerm(y);y:=ABS(y)      |
            8 : HoleTerm(y);y:=mtt.Sinh(y) |
            9 : HoleTerm(y);y:=mtt.Sqrt(y) |
            10 : HoleTerm(y);y:=mtt.Tan(y) |
            11 : HoleTerm(y);y:=mtt.Tanh(y)|
            12 : HoleTerm(y);y:=ENTIER(y)  |
            13 : HoleTerm(y);y:=mtt.Sin(y) |
            14 : HoleTerm(y);IF y#0 THEN y:=rnd.RND(SHORT(ENTIER(y))) END |
            15 : HoleTerm(y);IF y=0 THEN y:=1 ELSE y:=0 END
          ELSE f.code:=unknownfunk END
        END HoleFunktion;

      BEGIN (* HoleTerm *)
        CASE symbol OF
          "x" : term:=x;hole(symbol) |
          "0" .. "9",".","," : HoleZahl(term) |
          "a".."w" : HoleFunktion(term) |
          "-" : hole(symbol);HoleTerm(term);term:=-term |
          "(" : hole(symbol);HoleSumme(term);
                IF symbol=")" THEN hole(symbol)
                ELSE f.code:=misbrakclose END
        ELSE f.code:=misbrakopen END
      END HoleTerm;

    BEGIN (* HoleProdukt *)
      HoleTerm(produkt);
      WHILE (symbol="*") OR (symbol="/") OR (symbol="%") OR (symbol="\\") DO
        op:=symbol;hole(symbol);HoleTerm(faktor);
        IF op="*" THEN
          produkt:=produkt*faktor
        ELSE
          IF faktor#0 THEN
            IF op="/" THEN
              produkt:=produkt/faktor
            ELSE
              IF op="%" THEN
                produkt:=ENTIER(produkt/faktor)
              ELSE
                produkt:=ENTIER(produkt) MOD ENTIER(faktor)
              END
            END
          ELSE
            f.code:=divzero
          END
        END
      END
    END HoleProdukt;

  BEGIN (* HoleSumme *)
    HoleProdukt(summe);
    WHILE (symbol="+") OR (symbol="-") DO
      op:=symbol;hole(symbol);HoleProdukt(summand);
      IF op="+" THEN summe:=summe+summand
      ELSE summe:=summe-summand END
    END
  END HoleSumme;

BEGIN (* calc *)
  pos:=0;hole(symbol);f.code:=ok;
  HoleSumme(wert);
  IF symbol#";" THEN f.code:=wrongend END;
RETURN wert
END Calc;

PROCEDURE (f:function) Dispose;
BEGIN
  allfunction.Remove(f.a);
  f.a:=NIL;
  f.code:=ok
END Dispose;

BEGIN
  allfunction:=lst.Create()
END Term.