(*---------------------------------------------------------------------------
    :Program.     ???
    :Author.      ??? 
    :Address.     ???
    :Phone.       ??? 
    :Shortcut.   [???]
    :Version.     ???
    :Date.        ???
    :Copyright.   ???
    :Language.   Modula-II
    :Translator. M2Amiga
    :Imports.     ???
    :UpDate.      ???
    :Contents.    String to LongReal
---------------------------------------------------------------------------*)
IMPLEMENTATION MODULE LRealConvert;


CONST maxexp = 308;
      minexp = -306;

PROCEDURE StrToLReal(str: ARRAY OF CHAR;  (* in diesem String ist Die zahl *)
                     StartPos: CARDINAL;  (* Ab dieser Position, meist 0 *)
                     VAR index: CARDINAL; (* Bis hierhin ist Real *)
                     VAR r: LONGREAL      (* Resultat der Berechnungen   *)
                    ): BOOLEAN;           (* TRUE falls OK gelesen,
                    			   * FALSE die Zahl ist nicht 
                    			   * 	  korrekt
                    			   *)
TYPE State = (start, numsign, before, dot, after, exp, expsign, expnum, stop);
CONST maxdig = 15;

VAR
   state: State;
   ch, lastChar: CHAR;
   c: CARDINAL;
   negNum, negExp, dotappeared: BOOLEAN;
   expVal, expCorr, nrofDigits, test, i: INTEGER;
   okay : BOOLEAN; (* Das gibt die Procedur zurück *)


                    			  
BEGIN
   okay := FALSE;
   lastChar := 0C;
   r := 0.0;
   index := StartPos;
   negNum := FALSE;
   negExp := FALSE;
   expVal := 0;
   expCorr := 0;
   state := start;
   nrofDigits := 0;
   dotappeared := FALSE;
   
   LOOP (* THE main loop *)
      IF (index <= CARDINAL(HIGH(str))) THEN 
         ch := str[index]
       
      ELSE
         ch := 0C;
      END;
      IF ((ch = '+') OR (ch = '-')) AND (state # stop) THEN
         IF (state = start) OR (state = exp) THEN
            INC(state);
            IF state = numsign THEN
               negNum := ch = '-'
            ELSE
               negExp := ch = '-'
            END;
         ELSE
            state := stop;
         END;
      ELSIF (ch = '.') AND (state # stop) THEN
         IF state <= before THEN
            state := dot;
            dotappeared := TRUE
         ELSE
            state := stop
         END
      ELSIF (CAP(ch) = 'E') AND (state # stop) THEN
         IF state <= after THEN
            state := exp
         ELSE
            state := stop
         END
      ELSIF ('0' <= ch) AND (ch <= '9') AND (state # stop) THEN
         CASE state OF
            start:
               state := before;
               IF (ch # 0C) AND ((ch # '0') OR (nrofDigits # 0)) THEN
                  INC(nrofDigits)
               END
            |numsign:
               INC(state);
               IF (ch # 0C) AND ((ch # '0') OR (nrofDigits # 0)) THEN
                  INC(nrofDigits)
               END
            |before:
               IF (ch # 0C) AND ((ch # '0') OR (nrofDigits # 0)) THEN
                  INC(nrofDigits)
               END
            |dot:
               INC(state);
               INC(expCorr);
               IF (ch # 0C) AND ((ch # '0') OR (nrofDigits # 0)) THEN
                  INC(nrofDigits)
               END
            |after:
               INC(expCorr);
               IF (ch # 0C) AND ((ch # '0') OR (nrofDigits # 0)) THEN
                  INC(nrofDigits)
               END
            |exp:
               state := expnum;
               expVal := expVal * 10 + INTEGER(ORD(ch) - ORD("0"));
               IF nrofDigits = 0 THEN nrofDigits := 1 END;
               (* unsichtbare Eins in E10 == 1E10 *)
            |expsign:
               INC(state);
               expVal := expVal * 10 + INTEGER(ORD(ch) - ORD("0"));
               IF nrofDigits = 0 THEN nrofDigits := 1 END;
            |expnum:
               test := expVal * 10 + INTEGER(ORD(ch) - ORD("0"));
               IF negExp AND (( -test - expCorr) + nrofDigits < minexp) THEN
                  state := stop
               ELSIF NOT negExp AND(( test-expCorr) + nrofDigits >maxexp)THEN
                  state := stop
               ELSE
                  expVal := test;
               END  
         END (* CASE *)
      ELSE 
         IF (state = start) AND (ch = ' ') THEN
            (* überspringe Leerschläge *)
         ELSIF((before<=state)AND(state<=after))
            OR (state =expnum) OR (state = stop) 
         THEN
            state := stop;
            IF negExp THEN
               expVal := - expVal;
            END;
            expVal := expVal - expCorr;
            negExp := expVal < 0;
            expVal := ABS(expVal);
            r := 0.0;
            c := StartPos;
            REPEAT
               ch := str[c];
               IF('0' <= ch) AND (ch <= '9') THEN
                  r := r * 10.0 + LONGREAL(ORD(ch) - ORD('0'));
               END;
               INC(c)
            UNTIL (c = index + 1) OR (CAP(str[c-1]) = 'E');
            IF (CAP(str[c-1]) = 'E') AND
               ((c = 1) OR ('0' > str[c-2]) OR (str[c-2]>'9')) THEN
               r := 1.0
            END;
            IF negExp THEN
               FOR i := 1 TO expVal DO
                  r := r / 10.0
               END
            ELSE
               FOR i := 1 TO expVal DO
                  r := r * 10.0
               END
            END;
            IF negNum THEN r := -r END;
            okay := TRUE;
            EXIT
         ELSE
            EXIT
         END
      END; (* IF Elsif, Elsif,... sort of a case *)
      IF state # stop THEN  INC(index) END
   END; (* Loop *)
   RETURN okay
END StrToLReal;


BEGIN (* LRealConvert *)
END LRealConvert.
