323 lines
6.6 KiB
Modula-2
323 lines
6.6 KiB
Modula-2
(*$R-*)
|
|
IMPLEMENTATION MODULE RealConversions;
|
|
|
|
FROM EM IMPORT FIF;
|
|
|
|
PROCEDURE RealToString(arg: REAL;
|
|
width, digits: INTEGER;
|
|
VAR str: ARRAY OF CHAR;
|
|
VAR ok: BOOLEAN);
|
|
BEGIN
|
|
LongRealToString(LONG(arg), width, digits, str, ok);
|
|
END RealToString;
|
|
|
|
PROCEDURE LongRealToString(arg: LONGREAL;
|
|
width, digits: INTEGER;
|
|
VAR str: ARRAY OF CHAR;
|
|
VAR ok: BOOLEAN);
|
|
VAR pointpos: INTEGER;
|
|
i: CARDINAL;
|
|
ecvtflag: BOOLEAN;
|
|
r, intpart, fractpart: LONGREAL;
|
|
ind1, ind2 : CARDINAL;
|
|
sign: BOOLEAN;
|
|
tmp : CHAR;
|
|
ndigits: CARDINAL;
|
|
dummy, dig: LONGREAL;
|
|
|
|
BEGIN
|
|
r := arg;
|
|
IF digits < 0 THEN
|
|
ecvtflag := TRUE;
|
|
ndigits := -digits;
|
|
ELSE
|
|
ecvtflag := FALSE;
|
|
ndigits := digits;
|
|
END;
|
|
IF (HIGH(str) < ndigits + 3) THEN
|
|
str[0] := 0C; ok := FALSE; RETURN
|
|
END;
|
|
pointpos := 0;
|
|
sign := r < 0.0D;
|
|
IF sign THEN r := -r END;
|
|
r := FIF(r, 1.0D, intpart);
|
|
fractpart := r;
|
|
pointpos := 0;
|
|
ind1 := 0;
|
|
ok := TRUE;
|
|
(*
|
|
Do integer part, which is now in "intpart". "r" now contains the
|
|
fraction part.
|
|
*)
|
|
IF intpart # 0.0D THEN
|
|
ind2 := 0;
|
|
WHILE intpart # 0.0D DO
|
|
IF ind2 > HIGH(str) THEN
|
|
IF NOT ecvtflag THEN
|
|
str[0] := 0C;
|
|
ok := FALSE;
|
|
RETURN;
|
|
END;
|
|
FOR ind1 := 1 TO HIGH(str) DO
|
|
str[ind1-1] := str[ind1];
|
|
END;
|
|
DEC(ind2);
|
|
END;
|
|
dummy := FIF(FIF(intpart, 0.1D, intpart),10.0D, dig);
|
|
IF (dummy > 0.5D) AND (dig < 9.0D) THEN
|
|
dig := dig + 1.0D;
|
|
END;
|
|
str[ind2] := CHR(TRUNC(dig+0.5D) + ORD('0'));
|
|
INC(ind2);
|
|
INC(pointpos);
|
|
END;
|
|
i := 0;
|
|
ind1 := ind2;
|
|
WHILE ind2 > i DO
|
|
DEC(ind2);
|
|
tmp := str[i];
|
|
str[i] := str[ind2];
|
|
str[ind2] := tmp;
|
|
INC(i);
|
|
END;
|
|
ELSE
|
|
INC(pointpos);
|
|
IF r > 0.0D THEN
|
|
WHILE r < 1.0D DO
|
|
fractpart := r;
|
|
r := r * 10.0D;
|
|
DEC(pointpos);
|
|
END;
|
|
END;
|
|
END;
|
|
ind2 := ndigits;
|
|
IF NOT ecvtflag THEN
|
|
IF INTEGER(ind2) + pointpos < 0 THEN
|
|
ind2 := ndigits;
|
|
FOR i := 0 TO ndigits DO str[i] := '0'; END;
|
|
ind1 := ndigits+1;
|
|
ELSE
|
|
ind2 := INTEGER(ind2) + pointpos
|
|
END;
|
|
END;
|
|
IF ind2 > HIGH(str) THEN
|
|
ok := FALSE;
|
|
str[0] := 0C;
|
|
RETURN;
|
|
END;
|
|
WHILE ind1 <= ind2 DO
|
|
fractpart := FIF(fractpart, 10.0D, r);
|
|
str[ind1] := CHR(TRUNC(r)+ORD('0'));
|
|
INC(ind1);
|
|
END;
|
|
ind1 := ind2;
|
|
str[ind2] := CHR(ORD(str[ind2])+5);
|
|
WHILE str[ind2] > '9' DO
|
|
str[ind2] := '0';
|
|
IF ind2 > 0 THEN
|
|
DEC(ind2);
|
|
str[ind2] := CHR(ORD(str[ind2])+1);
|
|
ELSE
|
|
str[ind2] := '1';
|
|
INC(pointpos);
|
|
IF NOT ecvtflag THEN
|
|
IF ind1 > 0 THEN str[ind1] := '0'; END;
|
|
INC(ind1);
|
|
END;
|
|
END;
|
|
END;
|
|
IF ecvtflag THEN
|
|
FOR i := ind1 TO 2 BY -1 DO
|
|
str[i] := str[i-1];
|
|
END;
|
|
str[1] := '.';
|
|
INC(ind1);
|
|
IF sign THEN
|
|
FOR i := ind1 TO 1 BY -1 DO
|
|
str[i] := str[i-1];
|
|
END;
|
|
INC(ind1);
|
|
str[0] := '-';
|
|
END;
|
|
IF (ind1 + 4) > HIGH(str) THEN
|
|
str[0] := 0C;
|
|
ok := FALSE;
|
|
RETURN;
|
|
END;
|
|
str[ind1] := 'E'; INC(ind1);
|
|
DEC(pointpos);
|
|
IF pointpos < 0 THEN
|
|
pointpos := -pointpos;
|
|
str[ind1] := '-';
|
|
ELSE
|
|
str[ind1] := '+';
|
|
END;
|
|
INC(ind1);
|
|
str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 100));
|
|
pointpos := pointpos MOD 100;
|
|
INC(ind1);
|
|
str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 10));
|
|
INC(ind1);
|
|
str[ind1] := CHR(ORD('0') + CARDINAL(pointpos MOD 10));
|
|
ELSE
|
|
IF pointpos <= 0 THEN
|
|
FOR i := ind1 TO 1 BY -1 DO
|
|
str[i+CARDINAL(-pointpos)] := str[i-1];
|
|
END;
|
|
FOR i := 0 TO CARDINAL(-pointpos) DO
|
|
str[i] := '0';
|
|
END;
|
|
ind1 := ind1 + CARDINAL(1 - pointpos);
|
|
pointpos := 1;
|
|
END;
|
|
FOR i := ind1 TO CARDINAL(pointpos+1) BY -1 DO
|
|
str[i] := str[i-1];
|
|
END;
|
|
IF ndigits = 0 THEN
|
|
str[pointpos] := 0C;
|
|
ELSE
|
|
str[pointpos] := '.';
|
|
END;
|
|
IF sign THEN
|
|
FOR i := ind1 TO 0 BY -1 DO
|
|
str[i+1] := str[i];
|
|
END;
|
|
str[0] := '-';
|
|
INC(ind1);
|
|
END;
|
|
END;
|
|
IF (ind1+1) <= HIGH(str) THEN str[ind1+1] := 0C; END;
|
|
IF ind1 >= CARDINAL(width) THEN
|
|
ok := FALSE;
|
|
RETURN;
|
|
END;
|
|
IF width > 0 THEN
|
|
DEC(width);
|
|
END;
|
|
IF (width > 0) AND (ind1 < CARDINAL(width)) THEN
|
|
FOR i := ind1 TO 0 BY -1 DO
|
|
str[i + CARDINAL(width) - ind1] := str[i];
|
|
END;
|
|
FOR i := 0 TO CARDINAL(width)-(ind1+1) DO
|
|
str[i] := ' ';
|
|
END;
|
|
ind1 := CARDINAL(width);
|
|
IF (ind1+1) <= HIGH(str) THEN
|
|
FOR ind1 := ind1+1 TO HIGH(str) DO
|
|
str[ind1] := 0C;
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
END LongRealToString;
|
|
|
|
|
|
PROCEDURE StringToReal(str: ARRAY OF CHAR;
|
|
VAR r: REAL; VAR ok: BOOLEAN);
|
|
VAR x: LONGREAL;
|
|
BEGIN
|
|
StringToLongReal(str, x, ok);
|
|
IF ok THEN
|
|
r := x;
|
|
END;
|
|
END StringToReal;
|
|
|
|
PROCEDURE StringToLongReal(str: ARRAY OF CHAR;
|
|
VAR r: LONGREAL; VAR ok: BOOLEAN);
|
|
CONST BIG = 1.0D17;
|
|
TYPE SETOFCHAR = SET OF CHAR;
|
|
VAR pow10 : INTEGER;
|
|
i : INTEGER;
|
|
e : LONGREAL;
|
|
ch : CHAR;
|
|
signed: BOOLEAN;
|
|
signedexp: BOOLEAN;
|
|
iB: CARDINAL;
|
|
|
|
BEGIN
|
|
r := 0.0D;
|
|
pow10 := 0;
|
|
iB := 0;
|
|
ok := TRUE;
|
|
signed := FALSE;
|
|
WHILE (str[iB] = ' ') OR (str[iB] = CHR(9)) DO
|
|
INC(iB);
|
|
IF iB > HIGH(str) THEN
|
|
ok := FALSE;
|
|
RETURN;
|
|
END;
|
|
END;
|
|
IF str[iB] = '-' THEN signed := TRUE; INC(iB)
|
|
ELSIF str[iB] = '+' THEN INC(iB)
|
|
END;
|
|
ch := str[iB]; INC(iB);
|
|
IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
|
|
REPEAT
|
|
IF r>BIG THEN INC(pow10) ELSE r:= 10.0D*r+FLOATD(ORD(ch)-ORD('0')) END;
|
|
IF iB <= HIGH(str) THEN
|
|
ch := str[iB]; INC(iB);
|
|
END;
|
|
UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
|
|
IF (ch = '.') AND (iB <= HIGH(str)) THEN
|
|
ch := str[iB]; INC(iB);
|
|
IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
|
|
REPEAT
|
|
IF r < BIG THEN
|
|
r := 10.0D * r + FLOATD(ORD(ch)-ORD('0'));
|
|
DEC(pow10);
|
|
END;
|
|
IF iB <= HIGH(str) THEN
|
|
ch := str[iB]; INC(iB);
|
|
END;
|
|
UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
|
|
END;
|
|
IF (ch = 'E') THEN
|
|
IF iB > HIGH(str) THEN
|
|
ok := FALSE;
|
|
RETURN;
|
|
ELSE
|
|
ch := str[iB]; INC(iB);
|
|
END;
|
|
i := 0;
|
|
signedexp := FALSE;
|
|
IF (ch = '-') OR (ch = '+') THEN
|
|
signedexp := ch = '-';
|
|
IF iB > HIGH(str) THEN
|
|
ok := FALSE;
|
|
RETURN;
|
|
ELSE
|
|
ch := str[iB]; INC(iB);
|
|
END;
|
|
END;
|
|
IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
|
|
REPEAT
|
|
i := i*10 + INTEGER(ORD(ch) - ORD('0'));
|
|
IF iB <= HIGH(str) THEN
|
|
ch := str[iB]; INC(iB);
|
|
END;
|
|
UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
|
|
IF signedexp THEN i := -i END;
|
|
pow10 := pow10 + i;
|
|
END;
|
|
IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END;
|
|
e := 1.0D;
|
|
DEC(i);
|
|
WHILE i >= 10 DO
|
|
e := e * 10000000000.0D;
|
|
DEC(i,10);
|
|
END;
|
|
WHILE i >= 0 DO
|
|
e := e * 10.0D;
|
|
DEC(i)
|
|
END;
|
|
IF pow10<0 THEN
|
|
r := r / e;
|
|
ELSE
|
|
r := r * e;
|
|
END;
|
|
IF signed THEN r := -r; END;
|
|
IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END
|
|
END StringToLongReal;
|
|
|
|
END RealConversions.
|