IMPLEMENTATION MODULE FpuIO ;
FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
FROM StrLib IMPORT StrLen, StrRemoveWhitePrefix ;
FROM ASCII IMPORT nul ;
CONST
MaxLineLength = 100 ;
MaxDigits = 100 ;
PROCEDURE Max (i, j: INTEGER) : INTEGER ;
BEGIN
IF i>j
THEN
RETURN( i )
ELSE
RETURN( j )
END
END Max ;
PROCEDURE ToThePower10 (v: LONGREAL; power: CARDINAL) : LONGREAL;
VAR
i: CARDINAL;
BEGIN
i := 0 ;
WHILE i<power DO
v := v * 10.0 ;
INC(i)
END ;
RETURN( VAL(REAL, v) )
END ToThePower10 ;
PROCEDURE DetermineSafeTruncation () : CARDINAL ;
VAR
MaxPowerOfTen: REAL ;
LogPower : CARDINAL ;
BEGIN
MaxPowerOfTen := 1.0 ;
LogPower := 0 ;
WHILE MaxPowerOfTen*10.0<FLOAT(MAX(INTEGER) DIV 10) DO
MaxPowerOfTen := MaxPowerOfTen * 10.0 ;
INC(LogPower)
END ;
RETURN( LogPower )
END DetermineSafeTruncation ;
PROCEDURE ReadReal (VAR x: REAL) ;
VAR
a: ARRAY [0..MaxLineLength] OF CHAR ;
BEGIN
ReadString(a) ;
StrToReal(a, x)
END ReadReal ;
PROCEDURE WriteReal (x: REAL; TotalWidth, FractionWidth: CARDINAL) ;
VAR
a: ARRAY [0..MaxLineLength] OF CHAR ;
BEGIN
RealToStr(x, TotalWidth, FractionWidth, a) ;
WriteString(a)
END WriteReal ;
PROCEDURE StrToReal (a: ARRAY OF CHAR ; VAR x: REAL) ;
VAR
lr: LONGREAL ;
BEGIN
StrToLongReal(a, lr) ;
x := lr
END StrToReal ;
PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
VAR
a: ARRAY [0..MaxLineLength] OF CHAR ;
BEGIN
ReadString( a ) ;
StrToLongReal( a, x )
END ReadLongReal ;
PROCEDURE WriteLongReal (x: LONGREAL; TotalWidth, FractionWidth: CARDINAL) ;
VAR
a: ARRAY [0..MaxLineLength] OF CHAR ;
BEGIN
LongRealToStr(x, TotalWidth, FractionWidth, a) ;
WriteString(a)
END WriteLongReal ;
PROCEDURE StrToLongReal (a: ARRAY OF CHAR ; VAR x: LONGREAL) ;
VAR
i, high : CARDINAL ;
IsNegative: BOOLEAN ;
Fraction : LONGREAL ;
Exponent : LONGREAL ;
BEGIN
StrRemoveWhitePrefix(a, a) ;
high := StrLen(a) ;
i := 0 ;
IF (i<high) AND (a[i]='-')
THEN
IsNegative := TRUE ;
INC(i)
ELSE
IsNegative := FALSE
END ;
x := 0.0 ;
WHILE (i<high) AND (a[i]>='0') AND (a[i]<='9') DO
x := x*10.0+FLOAT(ORD(a[i])-ORD('0')) ;
INC(i)
END ;
IF i<high
THEN
IF a[i]='.'
THEN
Exponent := 10.0 ;
Fraction := 0.0 ;
INC(i) ;
WHILE (i<high) AND (a[i]>='0') AND (a[i]<='9') DO
Fraction := Fraction+FLOAT(ORD(a[i])-ORD('0'))/Exponent ;
Exponent := Exponent*10.0 ;
INC(i)
END ;
x := x+Fraction
END
END ;
IF IsNegative
THEN
x := -x
END
END StrToLongReal ;
PROCEDURE Add (VAR a: ARRAY OF CHAR; High: CARDINAL; i: CARDINAL; ch: CHAR) ;
BEGIN
IF i<High
THEN
a[i] := ch
END
END Add ;
PROCEDURE IntegerToStr (i: INTEGER; VAR a: ARRAY OF CHAR; index: CARDINAL) : CARDINAL ;
VAR
start,
high,
added: CARDINAL ;
ch : CHAR ;
BEGIN
added := 0 ;
high := HIGH(a) ;
start := index ;
REPEAT
a[index] := CHR(CARDINAL(i MOD 10)+ORD('0')) ;
i := i DIV 10 ;
INC(index) ;
INC(added)
UNTIL (i=0) OR (index>high) ;
DEC(index) ;
WHILE start<index DO
ch := a[start] ;
a[start] := a[index] ;
a[index] := ch ;
DEC(index) ;
INC(start)
END ;
RETURN( added )
END IntegerToStr ;
PROCEDURE RealToStr (x: REAL; TotalWidth, FractionWidth: CARDINAL; VAR a: ARRAY OF CHAR) ;
VAR
lr: LONGREAL ;
BEGIN
lr := x ;
LongRealToStr(lr, TotalWidth, FractionWidth, a)
END RealToStr ;
PROCEDURE LongRealToStr (x: LONGREAL; TotalWidth, FractionWidth: CARDINAL; VAR a: ARRAY OF CHAR) ;
VAR
TruncedX : INTEGER;
NonTruncedDigits: CARDINAL ;
i,
aIndex,
BufIndex : CARDINAL ;
Buffer : ARRAY [0..MaxDigits] OF CHAR;
IsNegative : BOOLEAN;
IntegerWidth : CARDINAL ;
LogPower : CARDINAL ;
MaxPower : LONGREAL ;
High : CARDINAL ;
BEGIN
High := HIGH(a) ;
LogPower := DetermineSafeTruncation() ;
MaxPower := ToThePower10(1.0, LogPower) ;
IF x<0.0
THEN
x := -x ;
IsNegative := TRUE
ELSE
IsNegative := FALSE
END ;
BufIndex := 0 ;
REPEAT
NonTruncedDigits := 0 ;
WHILE x/ToThePower10(1.0, NonTruncedDigits) >= FLOAT(MAX(INTEGER) DIV 10) DO
INC(NonTruncedDigits)
END ;
IF NonTruncedDigits>0
THEN
x := x / ToThePower10(1.0, NonTruncedDigits)
END ;
TruncedX := TRUNC(x) ;
x := x - VAL(LONGREAL, TruncedX) ;
INC(BufIndex, IntegerToStr(TruncedX, Buffer, BufIndex)) ;
IF NonTruncedDigits>0
THEN
x := ToThePower10(x, NonTruncedDigits)
END
UNTIL NonTruncedDigits = 0 ;
IntegerWidth := Max(INTEGER(BufIndex), INTEGER(TotalWidth)-INTEGER(FractionWidth)) ;
aIndex := 0 ;
WHILE aIndex<IntegerWidth-BufIndex DO
Add(a, High, aIndex, ' ') ;
INC(aIndex)
END ;
i := 0 ;
WHILE i<BufIndex DO
Add(a, High, aIndex, Buffer[i]) ;
INC(i) ;
INC(aIndex)
END ;
IF IntegerWidth<TotalWidth
THEN
Add(a, High, aIndex, '.') ;
INC(aIndex) ;
WHILE aIndex<=TotalWidth DO
x := x * MaxPower ;
TruncedX := TRUNC(x) ;
x := x - VAL(LONGREAL, TruncedX) ;
BufIndex := IntegerToStr(TruncedX, Buffer, 0) ;
i := BufIndex ;
WHILE (i<LogPower) AND (aIndex<High) DO
Add(a, High, aIndex, '0') ;
INC(aIndex) ;
INC(i)
END ;
i := 0 ;
REPEAT
Add(a, High, aIndex, Buffer[i]) ;
INC(i) ;
INC(aIndex)
UNTIL i=BufIndex
END
END ;
Add(a, High, aIndex, nul)
END LongRealToStr ;
PROCEDURE ReadLongInt (VAR x: LONGINT) ;
VAR
a : ARRAY [0..MaxLineLength] OF CHAR ;
BEGIN
ReadString( a ) ;
StrToLongInt( a, x )
END ReadLongInt ;
PROCEDURE WriteLongInt (x: LONGINT; n: CARDINAL) ;
VAR
a : ARRAY [0..MaxLineLength] OF CHAR ;
BEGIN
LongIntToStr( x, n, a ) ;
WriteString( a )
END WriteLongInt ;
PROCEDURE LongIntToStr (x: LONGINT; n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
VAR
i, j,
Higha : CARDINAL ;
buf : ARRAY [1..MaxDigits] OF CARDINAL ;
Negative : BOOLEAN ;
BEGIN
IF x<0
THEN
Negative := TRUE ;
IF n>0
THEN
DEC(n)
END ;
x := -x
ELSE
Negative := FALSE ;
END ;
i := 0 ;
REPEAT
INC(i) ;
IF i>MaxDigits
THEN
WriteString('increase MaxDigits in FpuIO') ; WriteLn ;
HALT
END ;
buf[i] := VAL(CARDINAL, x MOD 10) ;
x := x DIV 10 ;
UNTIL x=0 ;
j := 0 ;
Higha := HIGH(a) ;
WHILE (n>i) AND (j<=Higha) DO
a[j] := ' ' ;
INC(j) ;
DEC(n)
END ;
IF Negative
THEN
a[j] := '-' ;
INC(j)
END ;
WHILE (i#0) AND (j<=Higha) DO
a[j] := CHR( buf[i] + ORD('0') ) ;
INC(j) ;
DEC(i)
END ;
IF j<=Higha
THEN
a[j] := nul
END
END LongIntToStr ;
PROCEDURE StrToLongInt (a: ARRAY OF CHAR ; VAR x: LONGINT) ;
VAR
i : CARDINAL ;
finished,
Negative : BOOLEAN ;
higha : CARDINAL ;
BEGIN
StrRemoveWhitePrefix(a, a) ;
higha := StrLen(a) ;
i := 0 ;
Negative := FALSE ;
finished := FALSE ;
REPEAT
IF i<higha
THEN
IF a[i]='-'
THEN
INC(i) ;
Negative := NOT Negative
ELSIF (a[i]<'0') OR (a[i]>'9')
THEN
INC(i)
END
ELSE
finished := TRUE
END
UNTIL finished ;
x := 0 ;
IF i<=higha
THEN
finished := FALSE ;
REPEAT
IF Negative
THEN
x := 10*x - INTEGER(ORD(a[i])-ORD('0'))
ELSE
x := 10*x + INTEGER(ORD(a[i])-ORD('0'))
END ;
IF i<higha
THEN
INC(i) ;
IF (a[i]<'0') OR (a[i]>'9')
THEN
finished := TRUE
END
ELSE
finished := TRUE
END
UNTIL finished
END
END StrToLongInt ;
END FpuIO.