language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/realinout.mod
IMPLEMENTATION MODULE RealInOut;
(* see the definition module for details *)
(* Implemented by J. Andrea, Aug.8/91 *)
(* This code may be freely used and distributed, it may not be sold. *)
IMPORT InOut;
FROM FortranFormat IMPORT For$FFormat, For$EFormat;
VAR string :ARRAY [0..132] OF CHAR;
(* ---------------------------------------------------------------- *)
PROCEDURE ReadReal( VAR x :REAL );
BEGIN
InOut.ReadReal( x ); Done := InOut.Done;
END ReadReal;
(* ---------------------------------------------------------------- *)
PROCEDURE WriteReal( x :REAL; width :CARDINAL );
BEGIN
InOut.WriteReal( x, width ); Done := InOut.Done;
END WriteReal;
(* ---------------------------------------------------------------- *)
PROCEDURE FWriteReal( x :REAL; width, decimals :CARDINAL);
BEGIN (* FWriteReal *)
ToFString( x, width, decimals, string );
InOut.WriteString( string ); Done := InOut.Done;
END FWriteReal;
(* ---------------------------------------------------------------- *)
PROCEDURE EWriteReal( x :REAL; width, decimals :CARDINAL);
BEGIN (* EWriteReal *)
ToEString( x, width, decimals, string );
InOut.WriteString( string ); Done := InOut.Done;
END EWriteReal;
(* ---------------------------------------------------------------- *)
PROCEDURE ToFString( x :REAL; width, decimals :CARDINAL;
VAR string :ARRAY OF CHAR );
VAR
len :CARDINAL;
BEGIN (* ToFString *)
IF width = 0 THEN
(* impossible width, return nothing *)
string[0] := 0C;
ELSE
len := HIGH( string );
(* this set of code is an attempt to give something to the *)
(* user, even if the user has specified an invalid set of parameters *)
(* so the values of width and decimals which get used may may be *)
(* different here, from what was passed in as parameters *)
IF width > len THEN
(* if the specified width is longer than the output string *)
(* then choose a smaller width *)
width := len;
END;
IF decimals >= width THEN
(* decimal places can't be more than the total width *)
(* and there has to be one place for the decimal point too *)
decimals := width - 1;
END;
For$FFormat( x, width, decimals, string );
(* if possible, add a proper end to the output string *)
IF width < len THEN
string[width] := 0C;
END;
END;
Done := TRUE;
END ToFString;
(* ---------------------------------------------------------------- *)
PROCEDURE ToEString( x :REAL; width, decimals :CARDINAL;
VAR string :ARRAY OF CHAR );
VAR
len :CARDINAL;
BEGIN (* ToEString *)
IF width = 0 THEN
(* impossible width, return nothing *)
string[0] := 0C;
ELSE
len := HIGH( string );
(* this set of code is an attempt to give something to the *)
(* user, even if the user has specified an invalid set of parameters *)
(* so the values of width and decimals which get used may may be *)
(* different here, from what was passed in as parameters *)
IF width > len THEN
(* if the specified width is longer than the output string *)
(* then choose a smaller width *)
width := len;
END;
(* allow the lower level routine to handle an invalid 'decimals' *)
For$EFormat( x, width, decimals, string );
(* if possible, add a proper end to the output string *)
IF width < len THEN
string[width] := 0C;
END;
END;
Done := TRUE;
END ToEString;
BEGIN (* RealInOut *)
END RealInOut.