(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(*  Last modified on Thu Nov 19 10:26:57 MET 1992 by preschern               *)

MODULE DOSTextWr;

IMPORT Wr, WrClass;

CONST
  BUFFSIZE = 4096;

EXCEPTION Error;
<* FATAL Error *>

REVEAL
  T = Wr.T BRANDED "DOSTextWr.T" OBJECT
        wr: Wr.T;
      OVERRIDES
        seek   := Seek;
        close  := Close;
        flush  := Flush;
      END;

PROCEDURE New (wr: Wr.T): T =
  VAR buf: REF ARRAY OF CHAR;
  BEGIN
    buf := NEW (REF ARRAY OF CHAR, BUFFSIZE);
    RETURN (NEW (T, st:= 0, lo := 0, cur := 0, hi := BUFFSIZE, buff := buf,
                    closed := FALSE, seekable := FALSE, buffered := TRUE,
                    wr := wr)); 
  END New;

PROCEDURE Seek (wr: T; n: CARDINAL) RAISES {Wr.Failure} =
  VAR buffered, i: INTEGER := 0;
      ch: CHAR;
  BEGIN
  (* Note: DOSTextWr.T's are not seekable because it would be a lot
   * of work to map a "Unix text file" position to a "DOS binary file"
   * position (means counting all CR/LF ...). Most applications do
   * just sequential writing. Therefore it is like it is.
   *)
    IF (wr.closed) THEN RAISE Error (*Closed*) END (* if *);
    buffered := wr.cur - wr.lo;
    WHILE (buffered > 0) DO
      ch := wr.buff [i]; INC (i); DEC (buffered);
      IF (ch = '\n') THEN Wr.PutChar (wr.wr, '\r') END (* if *);
      Wr.PutChar (wr.wr, ch);
    END (* while *);

    wr.wr.seek (wr.wr.cur);   (* just to enable writing in wr.wr *)
    wr.lo  := n;
    wr.cur := n;
    wr.hi  := wr.lo + NUMBER (wr.buff^);
  END Seek;

PROCEDURE Flush (wr: T) RAISES {Wr.Failure} =
  VAR buffered, i: INTEGER := 0;
      ch: CHAR;
  BEGIN
    IF (wr.closed) THEN RAISE Error (*Closed*) END (* if *);
    buffered := wr.cur - wr.lo;
    WHILE (buffered > 0) DO
      ch := wr.buff [i]; INC (i); DEC (buffered);
      IF (ch = '\n') THEN Wr.PutChar (wr.wr, '\r') END (* if *);
      Wr.PutChar (wr.wr, ch);
    END (* while *);

    wr.wr.flush ();
    wr.lo := wr.cur;
    wr.hi := wr.cur + NUMBER (wr.buff^);
  END Flush;

PROCEDURE Close (wr: T) RAISES {Wr.Failure} =
  BEGIN
    wr.buff   := NIL;
    wr.closed := TRUE;
    Wr.Close (wr.wr);
  END Close;

BEGIN
END DOSTextWr.