OS/2 Shareware BBS: 10 Tools/10-Tools.zip/pmos2002.zip/SRC/REALIO.MOD

Text File | 1996-09-04 | 9KB | 253 lines

IMPLEMENTATION MODULE RealIO;

        (********************************************************)
        (*                                                      *)
        (*              Real I/O using windows.                 *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Last edited:        4 September 1996                *)
        (*  Status:             Working                         *)
        (*      More care needed in handling the case where     *)
        (*       the field size is too small.                   *)
        (*      Seems to be a loss of accuracy when writing     *)
        (*       E-format numbers; for example 123.456E7 is     *)
        (*       written as 1234559999.  I'm not yet sure       *)
        (*       where this is happening, but suspect that it   *)
        (*       involves some deep error analysis.             *)
        (*                                                      *)
        (********************************************************)

FROM Windows IMPORT
    (* type *)  Window, ColumnRange,
    (* proc *)  SaveCursor, SetCursor, EditString, ReadChar, LookaheadChar,
                ReadCharWithoutEcho, WriteString;

FROM Conversions IMPORT
    (* proc *)  LongRealToString, StringToLongReal;

FROM Keyboard IMPORT
    (* proc *)  InKey, PutBack;

(************************************************************************)

CONST
    EndMarker = CHR(0);  tab = CHR(9);  CR = CHR(13);

TYPE
    CharSet = SET OF CHAR;

(************************************************************************)
(*                              REAL OUTPUT                             *)
(************************************************************************)

PROCEDURE WriteLongReal (w: Window;  number: LONGREAL;  places: CARDINAL);

    (* Writes the second argument as a decimal number, right-justified  *)
    (* in a field of "places" places.                                   *)

    VAR buffer: ARRAY [0..79] OF CHAR;

    BEGIN
        LongRealToString (number, buffer, places);
        WriteString (w, buffer);
    END WriteLongReal;

(************************************************************************)

PROCEDURE WriteReal (w: Window;  number: REAL;  places: CARDINAL);

    (* Like WriteLongReal, except for argument type.    *)

    BEGIN
        WriteLongReal (w, VAL(LONGREAL,number), places);
    END WriteReal;

(************************************************************************)
(*                      REAL INPUT FROM KEYBOARD                        *)
(************************************************************************)

PROCEDURE ReadRealString (w: Window;  VAR (*OUT*) string: ARRAY OF CHAR);

    (* Reads in a character string from the keyboard, stopping at the   *)
    (* first character which cannot form part of the external           *)
    (* representation of an unsigned real number.  Leading blanks are   *)
    (* skipped and not echoed.                                          *)

    CONST Blanks = CharSet {" ", tab, CR};

    VAR nextchar: CHAR;
        position: CARDINAL;

    (********************************************************************)

    PROCEDURE GetNextChar;

        (* Stores nextchar, reads new nextchar from keyboard.  Returns  *)
        (* result = EndMarker if we run out of space.                   *)

        BEGIN
            IF position <= HIGH(string) THEN
                ReadChar (w, nextchar);
                string[position] := nextchar;  INC (position);
                nextchar := LookaheadChar(w);
            ELSE
                nextchar := EndMarker;
            END (*IF*);
        END GetNextChar;

    (********************************************************************)

    BEGIN
        position := 0;

        (* Skip leading spaces and tabs.        *)

        WHILE LookaheadChar(w) IN Blanks DO
            ReadCharWithoutEcho (w, nextchar);
        END (*WHILE*);
        nextchar := LookaheadChar(w);

        (* Read the sign, if present.  We also permit spaces or tabs    *)
        (* after the sign.                                              *)

        IF (nextchar = '-') OR (nextchar = '+') THEN
            REPEAT
                GetNextChar;
            UNTIL (nextchar <> " ") AND (nextchar <> tab);
        END (*IF*);

        (* Read the part before the decimal point.      *)

        WHILE nextchar IN CharSet {"0".."9"} DO
            GetNextChar;
        END (*WHILE*);

        (* Now the part after the decimal point, if any.        *)

        IF nextchar = "." THEN
            GetNextChar;
            WHILE nextchar IN CharSet {"0".."9"} DO
                GetNextChar;
            END (*WHILE*);
        END (*IF*);

        (* Check for Ennn part. *)

        IF (nextchar = "E") OR (nextchar = "e") THEN
            GetNextChar;
            IF (nextchar = "+") OR (nextchar = "-") THEN
                GetNextChar;
            END (*IF*);
            WHILE nextchar IN CharSet {"0".."9"} DO
                GetNextChar;
            END (*WHILE*);
        END (*IF*);

        (* Ensure that string is properly terminated.  *)

        IF position <= HIGH(string) THEN
            string[position] := EndMarker;
        END (*IF*);

    END ReadRealString;

(************************************************************************)

PROCEDURE ReadLongReal (w: Window): LONGREAL;

    (* Reads and converts an unsigned numeric string from the keyboard. *)

    VAR InputString: ARRAY [0..79] OF CHAR;

    BEGIN
        ReadRealString (w, InputString);
        RETURN StringToLongReal (InputString);
    END ReadLongReal;

(************************************************************************)

PROCEDURE ReadReal (w: Window): REAL;

    (* Like ReadLongReal, except for argument type.     *)

    BEGIN
        RETURN VAL(REAL, ReadLongReal (w));
    END ReadReal;

(************************************************************************)

PROCEDURE ReadBufferedLongReal (w: Window;  fieldsize: CARDINAL): LONGREAL;

    (* Like ReadLongReal, but allows the user to edit within a field of *)
    (* the specified size.                                              *)

    VAR buffer: ARRAY ColumnRange OF CHAR;
        row, column: CARDINAL;
        value: LONGREAL;

    BEGIN
        SaveCursor (w, row, column);
        buffer := "";
        EditString (w, buffer, fieldsize);
        value := StringToLongReal (buffer);
        SetCursor (w, row, column);
        WriteLongReal (w, value, fieldsize);
        RETURN value;
    END ReadBufferedLongReal;

(************************************************************************)

PROCEDURE ReadBufferedReal (w: Window;  fieldsize: CARDINAL): REAL;

    (* Like ReadBufferedLongReal, except for argument type.     *)

    BEGIN
        RETURN VAL(REAL, ReadBufferedLongReal (w, fieldsize));
    END ReadBufferedReal;

(************************************************************************)

PROCEDURE EditLongReal (w: Window;  VAR (*INOUT*) variable: LONGREAL;
                                                        width: CARDINAL);

    (* Displays the current value of "variable" at the current cursor   *)
    (* position in window w, using a field width of "width" characters, *)
    (* and gives the user the option of altering the value.             *)

    CONST Esc = CHR(27);

    VAR buffer: ARRAY ColumnRange OF CHAR;
        row, column: CARDINAL;  ch: CHAR;

    BEGIN
        SaveCursor (w, row, column);
        LongRealToString (variable, buffer, width);
        EditString (w, buffer, width);
        ch := InKey();  PutBack(ch);
        IF ch <> Esc THEN
            variable := StringToLongReal (buffer);
        END (*IF*);
        SetCursor (w, row, column);
        WriteLongReal (w, variable, width);
    END EditLongReal;

(************************************************************************)

PROCEDURE EditReal (w: Window;  VAR (*INOUT*) variable: REAL;
                                                        width: CARDINAL);

    (* Like EditLongReal, except for argument type.     *)

    VAR temp: LONGREAL;

    BEGIN
        temp := VAL(LONGREAL,variable);
        EditLongReal (w, temp, width);
        variable := VAL(REAL,temp);
    END EditReal;

(************************************************************************)

END RealIO.