IMPLEMENTATION MODULE MyLongRealConversions;    
(*
  Created:   10.02.88
  Changed:   25.02.88/10.3.88/3.8.88 by 
             Stefan Salewski
             Stolper Weg 3
             2160 Stade   West-Germany
             Tel: 04141/61130
             
  Note: compiled with AMIGA Modula-2 System by AMSoft Verion from 5.5.88
   
  This Module may be freely copied. But please
  leave my name in. Thanks....Stefan 
*)    

FROM SYSTEM IMPORT ADR;
FROM Arts IMPORT Assert;
FROM MyUties IMPORT Max,Min,exp10,Nummer,Ziffer,AddOp,IsADigit,
  DeziNummer,DeziZiffer;
  
  CONST
    ExpoStellen=3;
    seven=7;
    
  PROCEDURE RealToStr(x:LONGREAL;VAR str:ARRAY OF CHAR;m,n:INTEGER);
  (* ABS(m) gibt die Anzahl der gueltigen Ziffern an,ABS(n) die Nachkomma-
  stellen. n ist eingeschraenkt durch m, m wiederum durch HIGH(str).
     Es sollte gelten: ABS(n) < ABS(m) < HIGH(str).
     Ist m negativ, so wird die Zahl linksbuendig, sonst rechtsbuendig in
     str eingetragen. Ist n negativ, so wird Exponetialdarstellung verwendet.
     Der String muss mindesten 10 Zeichen gross sein (-n.mE+abc), sonst
     bricht das Programm ab.
     Ist die Zahl in normaler Notation  zu gross fuer str, so wird die
     Exponentialdarstellung  gewaehlt.
     Beispiel:HIGH(str)=10
     x:=-123.456789 m= 6 n=2   ==> '  -123.45'
     x:=-123.456789 m=-6 n=2   ==> '-123.45  '
     x:=123.456789  m=-6 n=2   ==> ' 123.45  '
     x:=123.456789  m=6  n=-2  ==> ' 1.2E+002'
   *)
    VAR
      vk,nk,startpos,pos,i:INTEGER;
      point,leadzero:[-1..1];
      cardX:DeziNummer;
      ex:INTEGER;
      delta,z:LONGREAL;
      expo,neg,mNeg:BOOLEAN;
    
    PROCEDURE Norm(VAR x:LONGREAL;VAR ex:INTEGER;d:LONGREAL);
    (* x >=0.0   d >= 0.0!!!!!!!!!!!!!!!!!!! *)
    BEGIN
      ex:=0;
      IF x#0.0 THEN
        WHILE (x+d < 1.0E-19) DO
          DEC(ex,20);
          x:=x*1.0E20
        END;
        WHILE (x+d < 1.0) DO
          DEC(ex);
          x:=x*1.0E1
        END;
      END;
      WHILE (x+d)>=1.0E20 DO
        INC(ex,20);
        x:=x*1.0E-20
      END;
      WHILE (x+d)>=10.0 DO
        INC(ex);
        x:=x*0.1
      END
      (* oldx=x*10^ex *)
    END Norm;
  
  BEGIN (* RealToStr*)
    Assert(HIGH(str)>=9,ADR('RealToStr:str zu klein'));
    mNeg:=(m<0);
    m:=ABS(m);
    m:=Min(m,HIGH(str)-seven);
    m:=Max(m,2);
    FOR i:=0 TO HIGH(str) DO
      str[i]:=fillChar
    END;
    neg:=(x<0.0);
    x:=ABS(x);
    str[HIGH(str)]:=0C;
    expo:=(n<0) OR (x>=exp10(m));
    n:=ABS(n);
    n:=Min(n,m-1);
    IF expo THEN
      z:=x;
      nk:=Min(n+1,m);
      nk:=Max(nk,2);
      IF NOT mNeg THEN
        (* hier: nk= gesamtzifferrnzahl*)
        pos:=Max(m+2,n+1+seven)-(nk+seven);
      ELSE 
        pos:=0
      END;
      IF neg THEN
        str[pos]:='-'
      ELSE
        IF fillChar=' ' THEN
          str[pos]:=' '
        ELSE
          str[pos]:='+'
        END
      END;
      delta:=0.5*exp10(-nk+1);
      Norm(z,ex,delta);
      z:=z+delta;
      INC(pos);
      str[pos]:=Ziffer(CARDINAL(z));
      INC(pos);
      str[pos]:='.';
      INC(pos);
      z:=(z-LONGREAL(CARDINAL(z)))*10.0;
      FOR i:=pos TO pos+nk-2 DO
        cardX:=CARDINAL(z);
        str[i]:=Ziffer(cardX);
        z:=(z-LONGREAL(cardX))*10.0;
      END;
      pos:=pos+nk-1;
      str[pos]:='E';
      INC(pos);
      IF ex<0 THEN
        ex:=-ex;
        str[pos]:='-'
      ELSE
        str[pos]:='+'
      END;
      INC(pos);
      FOR i:=pos+ExpoStellen-1 TO pos BY (-1) DO
        str[i]:=Ziffer(ex MOD 10);
        ex:=ex DIV 10
      END;
      str[pos+ExpoStellen]:=0C
    ELSE
      z:=x;
      Norm(z,ex,0.0);
      nk:=Min(n,m-(ex+1));
      nk:=Max(nk,0);
      (* Annahme:es koennen nk nachkommastellen geschrieben werden
         Auf Grund dieser Annahme wird gerundet.erst dann koennen die
         vorkommastellen genau bestimmt werden. stellt sich heraus,
         stellt sich heraus,das wegen zu vieler vorkommastellen nicht
         alle nachkommastellen geschrieben werden koennen, so ist die
         rundung falsch, neuer versuch mit nk-1 nachkommastellen
       *)
       INC(nk);
    REPEAT
      DEC(nk);
      z:=x;
      delta:=(0.5)*exp10(-nk);(*delta<=1.0*)
      z:=z+delta;
      Norm(z,ex,0.0);
      vk:=Max(ex+1,0);(*Vorkommastellen*)
    UNTIL  (nk+vk <= m) OR (nk=0);
      IF nk>0 THEN
        point:=1
      ELSE
        point:=0
      END;
      IF ex<0 THEN
        leadzero:=1
      ELSE
        leadzero:=0
      END;
      IF NOT mNeg THEN
        pos:=Max(m+2,n+1+seven)-(vk+1+nk+point+leadzero)
      ELSE
        pos:=0
      END;
      startpos:=pos;
      IF neg THEN
        str[pos]:='-';
      ELSE
        IF fillChar=' ' THEN
          str[pos]:=' '
        ELSE
          str[pos]:='+'
        END
      END;
      INC(pos);
      IF ex > -1 THEN (*vorkomma*)
        WHILE (pos<vk+1+startpos) DO
          cardX:=CARDINAL(z);
          str[pos]:=Ziffer(cardX);
          z:=(z-LONGREAL(cardX))*10.0;
          DEC(ex);
          INC(pos);
        END;
      ELSE
        str[pos]:='0';
        INC(pos)
      END;
      IF nk#0 THEN
        str[pos]:='.';
        INC(pos);
      END;
      (* nachkomma*)
      startpos:=pos;
      WHILE (ex< -1) AND (pos< startpos+nk) DO
        str[pos]:='0';
        INC(pos);
        INC(ex)
      END;
      WHILE (pos< startpos+nk) DO
        cardX:=CARDINAL(z);
        str[pos]:=Ziffer(cardX);
        z:=(z-LONGREAL(cardX))*10.0;
        INC(pos);
      END;
      str[pos]:=0C;
    END;
  END RealToStr;
  
  PROCEDURE StrToReal(str:ARRAY OF CHAR;VAR x:LONGREAL;VAR error:BOOLEAN);
    VAR
      xNeg,expoNeg:BOOLEAN;
      i,k,hi,p,e,expo:INTEGER;
      w:LONGREAL;
      j:LONGCARD;
  BEGIN
    str[HIGH(str)]:=0C;
    x:=0.0;
    expo:=0;
    p:=-1;
    xNeg:=FALSE;
    expoNeg:=FALSE;
    error:=FALSE;
    i:=0;
    IF fillChar#'-' THEN
      WHILE str[i] = fillChar DO
        INC(i);
      END
    END;
    IF AddOp(str[i]) THEN
      xNeg:=(str[i]='-');
      INC(i)
    END;
    error:= error OR NOT IsADigit(str[i]);(* keine einzige Ziffer vor Komma *)
    IF error THEN
      RETURN
    END;
    WHILE IsADigit(str[i]) DO
      INC(i);
    END;
    IF str[i]='.' THEN
      p:=i;
      INC(i);
      error:= error OR NOT IsADigit(str[i])
    ELSE
      error:= error OR NOT((str[i]='E') OR (str[i]=0C));
      p:=-i
    END;
    WHILE IsADigit(str[i]) DO
      INC(i);
    END;
    e:=i; (* position des eventuell vorhandenen 'E' *)
    IF str[i]='E' THEN
      INC(i);
      IF AddOp(str[i]) THEN
        expoNeg:=(str[i]='-');
        INC(i)
      END;
      error:=error OR NOT IsADigit(str[i]);
      expo:=0;
      k:=0;
      WHILE IsADigit(str[i]) AND (k<ExpoStellen) DO
        expo:=expo*10 + INTEGER(Nummer(str[i]));
        INC(i);
        INC(k);
      END;
      error:= error OR (str[i]#0C);
      IF expoNeg THEN 
        expo:=-expo
      END;
    ELSE
      error:= error OR (str[i]#0C)
    END;
    IF p>0 THEN (* Nachkomma Anteil aufaddieren *)
      i:=e-1;
      w:=1.0E8;
      j:=1;
      k:=i;
      IF IsADigit(str[i]) THEN
        x:=x+ LONGREAL(Nummer(str[i]));
        DEC(i)
      END;
      WHILE IsADigit(str[i]) DO
        IF j<10000000 THEN
        (* Die mathIEEEDoubbas.library der WB1.2 liefert fuer
           LONGREAL(900000000) ein falsches Ergebnis !!!!!!!!!!!!!!! *)
          j:=j*10;
          x:=x+ LONGREAL(j* LONGCARD(Nummer(str[i])))
        ELSE
          x:=x + w*LONGREAL(Nummer(str[i]));
          w:=w*10.0
        END;
        DEC(i)
      END;
      x:=x*exp10(i-k);
    END;
    i:=ABS(p)-1; (* vorkomma Anteil addieren *)
    w:=1.0E8;
    j:=1;
    IF (i>-1) AND IsADigit(str[i]) THEN
      x:=x+ LONGREAL(Nummer(str[i]));
      DEC(i)
    END;
    WHILE (i>-1) AND IsADigit(str[i]) DO
      IF j<10000000 THEN
        (* Die mathIEEEDoubbas.library der WB1.2 liefert fuer
           LONGREAL(900000000) ein falsches Ergebnis !!!!!!!!!!!!!!! *)
        j:=j*10;
        x:=x+ LONGREAL(j* LONGCARD(Nummer(str[i])))
      ELSE
        x:=x + w*LONGREAL(Nummer(str[i]));
        w:=w*10.0 (*kein Fehler durch wiederholte Multiplikation, weil
                    zehnerpotenzen intern sehr genau dargestellt werden *)
      END;
      DEC(i)
    END;
    x:=x*exp10(expo);
    IF xNeg THEN
      x:=-x;
    END;
  END StrToReal; 
  
BEGIN
  fillChar:=' ';
END MyLongRealConversions.mod