(*****************************************************************
   :Program.    FInOut.mod
   :Contents.   InOut Schnittstelle für Dateien
   :Author.     Michael Frieß
   :Address.    Mühlhaldenweg 16
   :Phone.      (0)7157 / 9614
   :Shortcut.   [mif]
   :Version.    1.0
   :Date.       26.11.89
   :Copyright.  PD
   :Language.   Modula-2
   :Translator. M2Amiga
*****************************************************************)

(* $R- $V- $S- $F- *)

IMPLEMENTATION MODULE FInOut;

FROM SYSTEM IMPORT ADR, CAST;
IMPORT Dos;
FROM MemSystem IMPORT Allocate, Deallocate;
FROM ASCII IMPORT eof, eol, vt, ht, sp, cr;
FROM InOut   IMPORT WriteString, WriteLn;
FROM Conversions IMPORT StrToVal, ValToStr;
FROM Str IMPORT Length, FirstPos, noOccur;

CONST BUFFERSIZE = 1024; (* Größe des internen Textpuffers *)

TYPE sizeIndex = [0..BUFFERSIZE-1];

TYPE file = POINTER TO RECORD
              fp    : Dos.FileHandlePtr;
              Error : error;
              IOErr : LONGINT;
              Buf   : [0..1];
              Off   : sizeIndex;
              Valid : BOOLEAN;
              Buffer: ARRAY [0..1], sizeIndex OF CHAR;
            END;

(*****************************************************************)
PROCEDURE FOpen (VAR f: file;
                 FileName: ARRAY OF CHAR; Mode: CHAR) : error;
 VAR i: LONGINT;

 BEGIN (* Open *)
  (* examine parameters *)
  CASE Mode OF
    "r", "R": i := Dos.readOnly;
(* not yet implemented:
  | "w", "W": i := Dos.readWrite;
*)
  | "n", "N": i := Dos.newFile;
  ELSE
    f := NIL;
    RETURN ERRxInvalidParameters;
  END;

  (* get some memory *)
  Allocate (f, SIZE(f^));
  IF f = NIL THEN RETURN ERRxNotEnoughMemory END;

  (* get a DOS file *)
  f^.fp := Dos.Open (ADR(FileName[0]), i);
  IF f^.fp = NIL THEN
    Deallocate( f);
    RETURN ERRxIOError;
  END;

  (* initialize buffer *)
  WITH f^ DO
    i := Dos.Read (fp, ADR(Buffer[0,0]), LONGINT(BUFFERSIZE-1));
    Buf := 0;
    Off := 0;
    IF i < BUFFERSIZE THEN Buffer[0, i] := eof END;
    Valid := TRUE;
    Error := ERRxNone;
  END;

  RETURN ERRxNone;
 END FOpen;

(*****************************************************************)
PROCEDURE FClose (VAR f: file): BOOLEAN;
 VAR i : LONGINT;
 BEGIN
  WITH f^ DO
    IF NOT Valid THEN
      (* buffer must be saved *)
      i := Dos.Write (fp, ADR(Buffer[Buf, 0]), Off+1);
      IF i < LONGINT(Off+1) THEN
        (* error while saving buffer *)
        IOErr := Dos.IoErr();
        Error := ERRxIOError;
        RETURN FALSE;
      END;
    END;
  END;
  (* okay, close DOS file *)
  Dos.Close (f^.fp);
  Deallocate (f);
  RETURN TRUE;
 END FClose;

(*****************************************************************)
PROCEDURE FError (f: file): error;
 BEGIN
   RETURN f^.Error;
 END FError;

(*****************************************************************)
PROCEDURE IOError (f: file): LONGINT;
 BEGIN
   (* if no io error occured ... *)
   IF f^.Error # ERRxIOError THEN
     RETURN 0;
   END;
   (* return saved IOError *)
   RETURN f^.IOErr;
 END IOError;

(*****************************************************************)
PROCEDURE FSkip (f: file): LONGINT;
 VAR ReadCt, i : LONGINT;
 BEGIN (* FSkip *)
  f^.Error := ERRxNone;
   WITH f^ DO
     i := - LONGINT(Off);
     (* M2Amiga does not handle character sets *)
     WHILE (Buffer[Buf, Off] = eol) OR
           (Buffer[Buf, Off] = cr)  OR
           (Buffer[Buf, Off] = sp)  OR
           (Buffer[Buf, Off] = ht)  OR
           (Buffer[Buf, Off] = vt)  DO
       IF Off < BUFFERSIZE-1 THEN
         (* not end of buffer *)
         INC(Off);
       ELSE
         (* end of buffer reached *)
         i := i + BUFFERSIZE;
         (* switch buffer *)
         Buf := 1-Buf;
         Off := 0;
         ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
         IF ReadCt <= 0 THEN
           Buffer[Buf, 0] := eof
         ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
         END;
       END;
     END;
     i := i + LONGINT(Off);
   END;
   RETURN i;
 END FSkip;

(*****************************************************************)
PROCEDURE FRead (f: file): CHAR;
 VAR Ch: CHAR;
      ReadCt: LONGINT;
 BEGIN (* FRead *)
  f^.Error := ERRxNone;
  WITH f^ DO
    Ch := Buffer[Buf, Off];
    IF Ch # eof THEN
      IF Off < BUFFERSIZE-1 THEN
        INC (Off);
      ELSE
        Buf := 1-Buf;
        Off := 0;
        ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
        IF ReadCt <= 0 THEN
          Buffer[Buf, 0] := eof
        ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
        END;
      END;
    END;
  END;
  RETURN Ch;
 END FRead;

(*****************************************************************)
PROCEDURE FReadString (f: file; VAR Str: ARRAY OF CHAR): LONGINT;
 VAR ReadCt, i: LONGINT;

 BEGIN (* ReadString *)
  f^.Error := ERRxNone;
   i := 0;
   WITH f^ DO
     WHILE (Buffer[Buf, Off] # eof) AND
           (i < HIGH (Str))         DO
       Str[i] := Buffer[Buf, Off];
       INC(i);
       IF Off < BUFFERSIZE-1 THEN
         INC(Off);
       ELSE
        Buf := 1-Buf;
        Off := 0;
        ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
        IF ReadCt <= 0 THEN
          Buffer[Buf, 0] := eof
        ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
        END;
       END;
     END;
   END;
   IF i = HIGH (Str) THEN
     RETURN -1;
   ELSE
     Str[i] := 00C;
     RETURN i;
   END;
 END FReadString;

(*****************************************************************)
PROCEDURE FReadWord (f: file; VAR Word: ARRAY OF CHAR): LONGINT;
 VAR ReadCt, i: LONGINT;

 BEGIN (* ReadWord *)
   ReadCt := FSkip (f);
   i := 0;
   WITH f^ DO
     WHILE (Buffer[Buf, Off] # eof) AND
           (Buffer[Buf, Off] # eol) AND
           (Buffer[Buf, Off] # cr)  AND
           (Buffer[Buf, Off] # sp)  AND
           (Buffer[Buf, Off] # ht)  AND
           (Buffer[Buf, Off] # vt)  AND
           (i < HIGH (Word))         DO
       Word[i] := Buffer[Buf, Off];
       INC(i);
       IF Off < BUFFERSIZE-1 THEN
         INC(Off);
       ELSE
        Buf := 1-Buf;
        Off := 0;
        ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
        IF ReadCt <= 0 THEN
          Buffer[Buf, 0] := eof
        ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
        END;
       END;
     END;
   END;
   IF i = HIGH (Word) THEN
     RETURN -1;
   ELSE
     Word[i] := 00C;
     RETURN i;
   END;
 END FReadWord;

(*****************************************************************)
PROCEDURE FReadLine (f: file; VAR Line: ARRAY OF CHAR): LONGINT;
 VAR ReadCt, i: LONGINT;

 BEGIN (* ReadLine *)
  f^.Error := ERRxNone;
   i := 0;
   WITH f^ DO
     WHILE (Buffer[Buf, Off] # eof) AND
           (Buffer[Buf, Off] # eol) AND
           (Buffer[Buf, Off] # cr)  AND
           (i < HIGH (Line))         DO
       Line[i] := Buffer[Buf, Off];
       INC(i);
       IF Off < BUFFERSIZE-1 THEN
         INC(Off);
       ELSE
        Buf := 1-Buf;
        Off := 0;
        ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
        IF ReadCt <= 0 THEN
          Buffer[Buf, 0] := eof
        ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
        END;
       END;
     END;
   END;
   IF i = HIGH (Line) THEN
     RETURN -1;
   ELSE
     Line[i] := 00C;
     RETURN i;
   END;
 END FReadLine;

(*****************************************************************)
PROCEDURE FReadToken (f: file; VAR Token: ARRAY OF CHAR;
                      Alphabet: ARRAY OF CHAR): LONGINT;
 VAR ReadCt, i: LONGINT;
     Ok : BOOLEAN;

 BEGIN (* ReadToken *)
   ReadCt := FSkip (f);
   i := 0;
   Ok := TRUE;
   WITH f^ DO
     WHILE (Buffer[Buf, Off] # eof) AND
           (Buffer[Buf, Off] # eol) AND
           (Buffer[Buf, Off] # cr)  AND
           (Buffer[Buf, Off] # sp)  AND
           (Buffer[Buf, Off] # ht)  AND
           (Buffer[Buf, Off] # vt)  AND
           (i < HIGH (Token))       AND
           Ok                       DO
       IF (FirstPos( Alphabet, 0, Buffer[ Buf, Off]) = noOccur) THEN
         Error := ERRxInvalidChar;
         Ok    := FALSE;
       ELSE
         Token[i] := Buffer[Buf, Off];
         INC(i);
         IF Off < BUFFERSIZE-1 THEN
           INC(Off);
         ELSE
          Buf := 1-Buf;
          Off := 0;
          ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
          IF ReadCt <= 0 THEN
            Buffer[Buf, 0] := eof
          ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
          END;
         END;
       END;
     END;
   END;
   IF i = HIGH (Token) THEN
     RETURN -1;
   ELSE
     Token[i] := 00C;
     RETURN i;
   END;
 END FReadToken;

(*****************************************************************)
PROCEDURE FReadLongInt (f: file): LONGINT;
 VAR Str : ARRAY [1..16] OF CHAR;
     n   : LONGINT;
     Signed, Err: BOOLEAN;
     i, Len   : INTEGER;
 BEGIN (* FReadLongInt *)
  n   := FSkip( f);
  Len := INTEGER(FReadWord (f, Str));
  i := 1;
  IF (Str[i] = "+") OR (Str[i] = "-") THEN INC(i) END;
  WHILE i <= Len DO
    IF (Str[i] >= "0") AND (Str[i] <= "9") THEN
      INC(i);
    ELSE
      f^.Error := ERRxInvalidChar;
      Str[i] := 00C;
      Len := i-1;
    END;
  END;
  StrToVal ( Str, n, Signed, 10, Err);
  IF NOT Err AND ((n > 0) OR Signed) THEN
    RETURN n
  ELSE
    f^.Error := ERRxConversionError;
    RETURN 0
  END;
 END FReadLongInt;

(*****************************************************************)
PROCEDURE FReadInt (f: file): INTEGER;
 VAR i : LONGINT;

 BEGIN (* FReadInt *)
  i := FReadLongInt (f);
  IF (MIN(INTEGER) <= i) AND (i <= MAX(INTEGER)) THEN
    RETURN INTEGER(i)
  ELSE
    f^.Error := ERRxRangeError;
    RETURN 0
  END;
 END FReadInt;

(*****************************************************************)
PROCEDURE FReadCard (f: file): CARDINAL;
 VAR i : LONGINT;
 BEGIN (* FReadCard *)
  i := FReadLongInt( f);
  IF (MIN(CARDINAL) <= i) AND (i <= MAX(CARDINAL)) THEN
    RETURN CARDINAL(i)
  ELSE
    f^.Error := ERRxRangeError;
    RETURN 0
  END;
 END FReadCard;

(*****************************************************************)
PROCEDURE FReadLongCard (f: file): LONGCARD;
 VAR Str : ARRAY [1..16] OF CHAR;
     n   : LONGINT;
     Signed, Err: BOOLEAN;
     i, Len : INTEGER;
 BEGIN (* FReadLongCard *)
  f^.Error := ERRxNone;
  n   := FSkip( f);
  Len := INTEGER(FReadWord (f, Str));
  i := 1;
  IF (Str[i] = "+") OR (Str[i] = "-") THEN INC(i) END;
  WHILE i <= Len DO
    IF (Str[i] >= "0") AND (Str[i] <= "9") THEN
      INC(i);
    ELSE
      f^.Error := ERRxInvalidChar;
      Len := i-1;
      Str[i] := 00C;
    END;
  END;
  StrToVal ( Str, n, Signed, 10, Err);
  IF NOT Err THEN
    IF n < 0 THEN
      IF Signed THEN
        f^.Error := ERRxConversionError;
        RETURN 0;
      ELSE
        RETURN CAST(LONGCARD, n);
      END;
    END;
    RETURN LONGCARD(n);
  ELSE
    f^.Error := ERRxConversionError;
    RETURN 0;
  END;
 END FReadLongCard;

(*****************************************************************)
PROCEDURE FWrite (f: file; Ch: CHAR);
 VAR i : LONGINT;
 BEGIN
  f^.Error := ERRxNone;
  WITH f^ DO
    Buffer[Buf, Off] := Ch;
    IF Off < BUFFERSIZE-1 THEN
      INC (Off);
      Valid := FALSE;
    ELSE
      i := Dos.Write (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
      IF i < BUFFERSIZE THEN
        Error := ERRxIOError;
        IOErr := Dos.IoErr();
      END;
      Buf := 1-Buf;
      Off := 0;
      Valid := TRUE;
    END;
  END;
 END FWrite;

(*****************************************************************)
PROCEDURE FWriteString (f: file; Str: ARRAY OF CHAR);
 VAR i, Len: LONGINT;

 BEGIN (* WriteString *)
  f^.Error := ERRxNone;
   i := 0;
   Len := Length( Str);
   WITH f^ DO
     WHILE i < Len DO
       Buffer[Buf, Off] := Str[i];
       INC( i);
       IF Off < BUFFERSIZE-1 THEN
         INC( Off);
         Valid := FALSE;
       ELSE
         i := Dos.Write (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
         IF i < BUFFERSIZE THEN
           Error := ERRxIOError;
           IOErr := Dos.IoErr();
         END;
         Buf := 1-Buf;
         Off := 0;
         Valid := TRUE;
       END;
     END;
   END;
 END FWriteString;

(*****************************************************************)
PROCEDURE FWriteLongInt (f: file; n: LONGINT; Width: INTEGER);
 VAR Str : ARRAY [1..16] OF CHAR;
     Err : BOOLEAN;
 BEGIN (* FWriteLongInt *)
  f^.Error := ERRxNone;
  ValToStr (n, (n < 0), Str, 10, Width, " ", Err);
WriteString ("TEST: "); WriteString( Str); WriteLn;
  IF Err THEN
    f^.Error := ERRxConversionError;
  ELSE
    FWriteString( f, Str);
  END;
 END FWriteLongInt;

(*****************************************************************)
PROCEDURE FWriteInt (f: file; n, Width: INTEGER);
 BEGIN (* FWriteInt *)
  FWriteLongInt( f, LONGINT( n), Width);
 END FWriteInt;

(*****************************************************************)
PROCEDURE FWriteCard (f: file; n: CARDINAL; Width: INTEGER);
 BEGIN (* FWriteCard *)
  FWriteLongInt( f, LONGINT( n), Width);
 END FWriteCard;

(*****************************************************************)
PROCEDURE FWriteLongCard (f: file; n: LONGCARD; Width: INTEGER);
 VAR Str : ARRAY [1..16] OF CHAR;
     Err : BOOLEAN;
     i   : LONGINT;
 BEGIN (* FWriteLongCard *)
  f^.Error := ERRxNone;
  ValToStr (LONGINT( n), FALSE, Str, 10, Width, " ", Err);
WriteString ("TEST: "); WriteString( Str); WriteLn;
  IF Err THEN
    f^.Error := ERRxConversionError;
  ELSE
    FWriteString( f, Str);
  END;
 END FWriteLongCard;

(*****************************************************************)
PROCEDURE FWriteLn(f: file);
 BEGIN
  f^.Error := ERRxNone;
  FWrite( f, eol);
 END FWriteLn;

(*****************************************************************)
PROCEDURE Eof (f: file) : BOOLEAN;
 BEGIN (* Eof *)
  WITH f^ DO
    RETURN Buffer[Buf, Off] = eof
  END;
 END Eof;

END FInOut.