IMPLEMENTATION MODULE Streams;

(** ------------------------------------------------------------------

                 Commodore Amiga standard streams module

      (c) Copyright 1986 Modula-2 Software Ltd.  All Rights Reserved
      (c) Copyright 1986 TDI Software, Inc.      All Rights Reserved

    ------------------------------------------------------------------ **)


(* VERSION FOR COMMODORE AMIGA

     Original Author : Paul Curtis, Modula-2 Software Ltd.  12-Dec-85

     Version         : 0.02a  30-Dec-86  Martin Fisher, Modula-2 Software Ltd.
                         Added check for eof error to Read functions - DOS
                         doesn't return an error number
                       0.01a  27-May-86  Paul Curtis, Modula-2 Software Ltd.
                         Fixes suggested by Les.
                         Made eof reflect true state of file.
                       0.00a  12-Dec-85  Paul Curtis, Modula-2 Software Ltd.
                         Original based upon ETH standard.

  *)


(*$S-,$T-,$Q+*)


  FROM SYSTEM IMPORT WORD, ADR;
  FROM Libraries IMPORT OpenLibrary;
  FROM DOSLibrary IMPORT DOSBase, DOSName;
  FROM DOSFiles IMPORT FileHandle, Read, Write, OffsetBeginning,
    OffsetCurrent, OffsetEnd, Seek, IoErr, IsInteractive;

  CONST NotDone = -1;

  PROCEDURE Connect(VAR s: STREAM; f: FileHandle);
    (* connect stream s with open file f.
       f is a filehandle returned by DOS *)
  VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF f = 0 THEN res := NotDone                              (*0.01a*)
      ELSE
        handle := f;
        IF IsInteractive(f) THEN
          eof := FALSE;
        ELSE
          lc := Seek(f,0,OffsetEnd);                            (*0.01a*)
          endpos := Seek(f,0,OffsetBeginning);  (* reset file, get end pos *)
          eof := (endpos = 0)
        END;
        res := Done
      END
    END
  END Connect;


  PROCEDURE Disconnect(VAR s: STREAM);
    (* terminate association of s with f. DOS is left to close f. *)
  BEGIN
    s.handle := 0; (* invalid file handle *)
    s.res := Done;
  END Disconnect;


  PROCEDURE WriteWord(VAR s: STREAM; w: WORD);
    (* Write a word to the stream. *)
  VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        lc := Write(handle,ADR(w),2);
        IF lc # 2 THEN
          res := INTEGER(IoErr());
          eof := TRUE                                           (*0.01a*)
        ELSE
          res := Done;
          eof := FALSE                                          (*0.01a*)
        END
      ELSE                                                      (*0.01a*)
        res := NotDone                                          (*0.01a*)
      END
    END
  END WriteWord;


  PROCEDURE WriteChar(VAR s: STREAM; c: CHAR);
    (* Write a character to the stream. *)
  VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        lc := Write(handle,ADR(c),1);
        IF lc # 1 THEN
          res := INTEGER(IoErr());                              (*0.01a*)
          eof := TRUE
        ELSE
          res := Done;
          eof := FALSE                                          (*0.01a*)
        END
      ELSE res := NotDone;                                      (*0.01a*)
      END
    END
  END WriteChar;


  PROCEDURE WriteString(VAR s: STREAM; VAR str: ARRAY OF CHAR);
  VAR lc: LONGCARD; i: CARDINAL;
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        i := 0;
        WHILE (i <= HIGH(str)) & (str[i] # 0C) DO
          INC(i)
        END;
        lc := Write(handle,ADR(str),LONGCARD(i));
        IF lc # LONGCARD(i) THEN
          res := INTEGER(IoErr());
          eof := TRUE
        ELSE
          res := Done;
          eof := FALSE                                          (*0.01a*)
        END
      ELSE res := NotDone                                       (*0.01a*)
      END
    END
  END WriteString;


  PROCEDURE ReadString(VAR s: STREAM; VAR str: ARRAY OF CHAR);
  VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        lc := Read(handle,ADR(str),LONGCARD(HIGH(str)));
        IF (lc # LONGCARD(HIGH(str))) & (NOT IsInteractive(handle)) THEN
          res := INTEGER(IoErr());
          IF res=0 THEN res:=-1 END ; (* EOF error *)
          eof := TRUE
        ELSE
          IF lc > 0 THEN str[CARDINAL(lc)-1] := 0C ELSE str[0] := 0C END;
          res := Done;
          eof := LONGCARD(Seek(handle,0,OffsetCurrent)) >= endpos  (*0.01a*)
        END
      ELSE res := NotDone                                       (*0.01a*)
      END
    END;
  END ReadString;


  PROCEDURE ReadWord(VAR s: STREAM; VAR w: WORD);
    (* Read a word from the stream. *)
   VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF s.handle > 0 THEN
        lc := Read(handle,ADR(w),2);                            (*0.01a*)
        IF lc # 2 THEN
          w := WORD(0);
          eof := TRUE;
          res := INTEGER(IoErr());
          IF res=0 THEN res:=-1 END     (* EOF error *)
        ELSE
          res := Done;
          eof := LONGCARD(Seek(handle,0,OffsetCurrent)) >= endpos (*0.01a*)
        END;
      ELSE res := NotDone                                       (*0.01a*)
      END
    END;
  END ReadWord;


  PROCEDURE ReadChar(VAR s: STREAM; VAR c: CHAR);
    (* Read a character from the stream. *)
  VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        lc := Read(handle,ADR(c),1);
        IF lc # 1 THEN
          c := 0C;
          eof := TRUE;
          res := INTEGER(IoErr());
          IF res=Done THEN res := -1 END   (* EOF error *)
        ELSE
          res := Done;
          eof := LONGCARD(Seek(handle,0,OffsetCurrent)) >= endpos (*0.01a*)
        END
      ELSE                                                      (*0.01a*)
        res := NotDone                                          (*0.01a*)
      END
    END
  END ReadChar;


  PROCEDURE Reset(VAR s: STREAM);
    (* Position stream to beginning of file. *)
  BEGIN
    SetPos(s,0);
  END Reset;


  PROCEDURE SetPos(VAR s: STREAM; pos: LONGCARD);
    (* Set file cursor of s, pos bytes from beginning of file. *)
  VAR lc: LONGCARD;
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        lc := Seek(handle,pos,OffsetBeginning);                 (*0.01a*)
        eof := (endpos = 0);
        res := Done;                                            (*0.01a*)
      ELSE res := NotDone                                       (*0.01a*)
      END
    END;
  END SetPos;


  PROCEDURE GetPos(VAR s: STREAM; VAR pos: LONGCARD);
    (* Return current file cursor. *)
  BEGIN
    WITH s DO
      IF handle > 0 THEN
        pos := Seek(handle,OffsetCurrent,0);
      END;
    END;
  END GetPos;


BEGIN
  IF DOSBase = 0 THEN
    DOSBase := OpenLibrary(DOSName,0);
  END;
END Streams.