Gold Fish 3/goldfish_volume_3.bin/files/dev/obero/oberon-a/source/library/in.mod

Text File | 1995-06-29 | 10.6 KB | 434 lines

(*************************************************************************

     $RCSfile: In.mod $
  Description: Formatted input from the standard input stream.

   Created by: fjc (Frank Copeland)
    $Revision: 1.3 $
      $Author: fjc $
        $Date: 1995/01/26 00:40:27 $

  Copyright © 1994-1995, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

*************************************************************************)

MODULE In;

(**
** Extracts from the Oakwood Report are enclosed in quotes.
**
** "Module In provides a set of basic routines for formatted input of
** characters, character sequences, numbers, and names. It assumes a
** standard input stream with a current position that can be reset to
** the beginning of the stream."
**
** This implementation uses the standard AmigaDOS input stream provided
** through the Input() system function as the source of characters.
*)

IMPORT SYS := SYSTEM, Dos, DosUtil, WbConsole, Reals, Sets;

(**
** "Done indicates the success of an input operation. If Done is TRUE
** after an input operation, the operation was successful and its result
** is valid. An unsuccessful input operation sets Done to FALSE; it
** remains FALSE until the next call to Open(). In particular, Done is set
** to FALSE if an attempt is made to read beyond the end of the input
** stream."
*)

VAR

  Done -: BOOLEAN;

(*
** eof is set by Read(), and is TRUE if an attempt to read from the
** standard input fails.
**
** nameChars is used in Scan() to determine which characters are legal in
** AmigaDos filenames.
*)

VAR

  eof : BOOLEAN;
  nameChars : Sets.CharSet;

CONST

  (* symbol classes *)

  inval  = 0; (* invalid symbol *)
  name   = 1; (* name s *)
  string = 2; (* literal string s *)
  int    = 3; (* integer i (decimal or hexadecimal) *)
  real   = 4; (* real number rval *)
  lreal  = 5; (* long real number lrval *)
  char   = 6; (* special character c *)

  TAB = 9X; CR = 0DX; LF = 0AX; (* Amiga end-of-line character *)
  maxStr = 256;

(* Results from Scan *)

VAR

  class : INTEGER;
  ival  : LONGINT;
  rval  : REAL;
  lrval : LONGREAL;
  cval  : CHAR;
  sval  : ARRAY maxStr OF CHAR;


PROCEDURE Read ( VAR ch : CHAR );

  VAR i : LONGINT;

BEGIN (* Read *)
  DosUtil.HaltIfBreak ({Dos.ctrlC});
  IF ~eof THEN
    i := Dos.FGetC (Dos.Input());
    IF i >= 0 THEN ch := CHR (i)
    ELSE ch := 0X; eof := TRUE
    END
  END
END Read;


PROCEDURE ScanName;

  VAR
    ch : CHAR;
    i : SHORTINT;
    ignore : LONGINT;

BEGIN (* ScanName *)
  Read (ch); i := 0;
  LOOP
    IF (ch # " ") & (ch # TAB) THEN EXIT END;
    Read (ch)
  END;
  IF (CAP (ch) >= "A") & (CAP (ch) <= "Z") THEN (* name *)
    (*
    ** AmigaDos filenames can include all printable characters. Full path
    ** names can include ":" and "/", but ":" can only appear once, and
    ** must come before any "/".
    *)
    nameChars.Clear;
    nameChars.InclChRange (" ", "~"); nameChars.InclChRange (0A1X, 0FFX);
    REPEAT
      IF (ch = ":") OR (ch = "/") THEN nameChars.ExclCh (":") END;
      sval [i] := ch; INC (i); Read (ch)
    UNTIL ~nameChars.ContainsCh (ch) OR (i = (maxStr - 1));
    sval [i] := 0X; class := name;
    IF ~eof & (ch # CR) & (ch # LF) THEN
      ignore := Dos.UnGetC (Dos.Input(), -1)
    END
  ELSIF  (ch = CR) OR (ch = LF) THEN
    sval := ""; class := name
  ELSE
    class := inval;
    IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END
  END
END ScanName;


PROCEDURE ScanStr;

  VAR ch : CHAR; i : SHORTINT; ignore : LONGINT;

BEGIN (* ScanStr *)
  Read (ch); i := 0;
  LOOP
    IF (ch # " ") & (ch # TAB) THEN EXIT END;
    Read (ch)
  END;
  IF ch = 22X THEN (* literal string *)
    Read (ch);
    WHILE (ch # 22X) & (ch >= " ") & (i # (maxStr - 1)) DO
      sval [i] := ch; INC (i); Read (ch)
    END;
    sval [i] := 0X; class := string;
    IF ch # 22X THEN Done := FALSE END
  ELSIF  (ch = CR) OR (ch = LF) THEN
    sval := ""; class := string
  ELSE
    class := inval;
    IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END
  END
END ScanStr;


PROCEDURE ScanNum;

  CONST
    maxD = 32;
    (* Limits for exponents *)
    MaxExp = 38; (* REAL : IEEE single-precision *)
    MaxLExp = 38; (* LONGREAL : IEEE single-precision *)

  VAR
    ch : CHAR;
    neg, negE, hex : BOOLEAN;
    i, j, h : SHORTINT;
    e : INTEGER; k, ignore : LONGINT;
    x, f : REAL; y, g : LONGREAL;
    d : ARRAY maxD OF CHAR;

  (*------------------------------------*)
  PROCEDURE ReadScaleFactor ();

  BEGIN (* ReadScaleFactor *)
    Read (ch);
    IF ch = "-" THEN negE := TRUE; Read (ch)
    ELSE negE := FALSE; IF ch = "+" THEN Read (ch) END;
    END;
    WHILE (ch >= "0") & (ch <= "9") DO
      e := e * 10 + ORD (ch) - 30H; Read (ch)
    END;
    IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END
  END ReadScaleFactor;

BEGIN (* ScanNum *)
  Read (ch); i := 0;
  LOOP
    IF (ch # CR) & (ch # LF) & (ch # " ") & (ch # TAB) THEN EXIT END;
    Read (ch)
  END;
  IF (CAP (ch) >= "A") & (CAP (ch) <= "Z") THEN (* name *)
    IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END;
    class := inval
  ELSIF ch = 22X THEN (* literal string *)
    IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END;
    class := inval
  ELSE
    IF ch = "-" THEN neg := TRUE; Read (ch) ELSE neg := FALSE END;
    IF (ch >= "0") & (ch <= "9") THEN (* number *)
      hex := FALSE; j := 0;
      LOOP
        d [i] := ch; INC (i); Read (ch);
        IF ch < "0" THEN EXIT END;
        IF "9" < ch THEN
          IF ("A" <= ch) & (ch <= "F") THEN
            hex := TRUE; ch := CHR (ORD (ch) - 7)
          ELSIF ("a" <= ch) & (ch <= "f") THEN
            hex := TRUE; ch := CHR (ORD (ch) - 27H)
          ELSE
            EXIT
          END
        END
      END;
      IF ch = "H" THEN (* hex number *)
        class := int;
        IF i - j > 8 THEN j := i - 8 END;
        k := ORD (d [j]) - 30H; INC (j);
        IF (i - j = 7) & (k >= 8) THEN DEC (k, 16) END;
        WHILE j < i DO k := k * 10H + (ORD (d [j]) - 30H); INC (j) END;
        IF neg THEN ival := -k ELSE ival := k END;
      ELSIF ch = "." THEN (* read real *)
        Read (ch); h := i;
        WHILE Done & ("0" <= ch) & (ch <= "9") DO
          d [i] := ch; INC (i); Read (ch)
        END;
        IF ch = "D" THEN
          e := 0; y := 0.0; g := 1.0;
          REPEAT y := y * 10.0 + (ORD (d [j]) - 30H); INC (j) UNTIL j = h;
          WHILE j < i DO
            g := g / 10.0; y := (ORD (d [j]) - 30H) * g + y; INC (j)
          END;
          ReadScaleFactor;
          IF negE THEN
            IF e <= MaxLExp THEN y := y / Reals.TenL (e) ELSE y := 0.0 END
          ELSIF e > 0 THEN
            IF e <= MaxLExp THEN y := y * Reals.TenL (e) ELSE HALT (40) END
          END;
          IF neg THEN y := -y END;
          class := lreal; lrval := y
        ELSE
          e := 0; x := 0.0; f := 1.0;
          REPEAT x := x * 10.0 + (ORD (d [j]) - 30H); INC (j) UNTIL j = h;
          WHILE j < i DO
            f := f / 10.0; x := (ORD (d [j]) - 30H) * f + x; INC (j)
          END;
          IF ch = "E" THEN ReadScaleFactor
          ELSIF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1)
          END;
          IF negE THEN
            IF e <= MaxExp THEN x := x / Reals.Ten (e) ELSE x := 0.0 END
          ELSIF e > 0 THEN
            IF e <= MaxExp THEN x := x * Reals.Ten (e) ELSE HALT (40) END
          END;
          IF neg THEN x := -x END;
          class := real; rval := x
        END; (* ELSE *)
        IF hex THEN class := inval END
      ELSE (* decimal integer *)
        IF ~eof THEN ignore := Dos.UnGetC (Dos.Input(), -1) END;
        class := int; k := 0;
        REPEAT k := k * 10 + (ORD (d [j]) - 30H); INC (j) UNTIL j = i;
        IF neg THEN ival := -k ELSE ival := k END;
        IF hex THEN class := inval ELSE class := int END
      END
    ELSE
      class := char;
      IF neg THEN cval := "-" ELSE cval := ch END
    END
  END
END ScanNum;


(**
** "Open() (re)sets the current position to the beginning of the input
** stream. Done indicates if the operation was successful."
*)

PROCEDURE Open*;

  VAR ignore : LONGINT; in : Dos.FileHandlePtr;

BEGIN (* Open *)
  Done := FALSE; in := Dos.Input();
  IF in # NIL THEN
    IF Dos.Flush (in) THEN
      ignore := Dos.Seek (in, 0, Dos.beginning);
      Done := TRUE; eof := FALSE
    END
  END
END Open;


(**
** "Char(ch) returns the character ch at the current position."
*)

PROCEDURE Char* ( VAR ch : CHAR );

BEGIN (* Char *)
  IF Done THEN Read (ch); Done := ~eof END
END Char;


(**
** "LongInt(n) and Int(n) return the (long) integer constant n at the
** current position according to the format:
**
**   IntConst = digit {digit} | digit {hexDigit} "H"."
*)

PROCEDURE LongInt* ( VAR n : LONGINT );

BEGIN (* LongInt *)
  IF Done THEN
    ScanNum;
    IF class = int THEN n := ival
    ELSE Done := FALSE
    END
  END;
END LongInt;


PROCEDURE Int* ( VAR n : INTEGER );

  VAR i : LONGINT;

BEGIN (* Int *)
  LongInt (i);
  IF Done THEN
    IF (i >= MIN (INTEGER)) & (i <= MAX (INTEGER)) THEN n := SHORT (i)
    ELSE Done := FALSE
    END
  END
END Int;


(*
** "Real(n) returns the real constant n at the current position according
** to the format:
**
**   RealConst =
**     digit {digit} ["." {digit} ["E" [("+"|"-")] digit {digit}]]."
*)

PROCEDURE Real* ( VAR num : REAL );

BEGIN (* Real *)
  IF Done THEN
    ScanNum;
    IF class = int THEN num := ival
    ELSIF class = real THEN num := rval
    ELSE Done := FALSE
    END
  END;
END Real;


(*
** "LongReal(n) returns the long real constant n at the current position
** according to the format:
**
**   LongRealConst =
**     digit {digit} ["." {digit} [("D"|"E") [("+"|"-")] digit {digit}]]."
*)

PROCEDURE LongReal* ( VAR num : LONGREAL );

BEGIN (* LongReal *)
  IF Done THEN
    ScanNum;
    IF class = int THEN num := ival
    ELSIF class = real THEN num := rval
    ELSIF class = lreal THEN num := lrval
    ELSE Done := FALSE
    END
  END;
END LongReal;


(*
** String(s) returns the string s at the current position according to the
** format:
**
**   StringConstant = '"' char {char} '"'."
**
** The string must not contain characters less than blank such as EOL or
** TAB.
*)

PROCEDURE String* ( VAR str : ARRAY OF CHAR );

BEGIN (* String *)
  IF Done THEN
    ScanStr;
    IF class = string THEN COPY (sval, str)
    ELSE Done := FALSE
    END
  END;
END String;


(*
** "Name(s) returns the name s at the current position according to the
** file name format of the underlying operating system (e.g.
** "lib/My.Mod" under Unix)."
*)

PROCEDURE Name* ( VAR n : ARRAY OF CHAR );

BEGIN (* Name *)
  IF Done THEN
    ScanName;
    IF class = name THEN COPY (sval, n)
    ELSE Done := FALSE
    END
  END;
END Name;


<*$ClearVars+*>
BEGIN
  nameChars.Init (0)
END In.