(* Copyright (C) 1989, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last modified on Tue Feb 13 15:37:57 1990 by kalsow         *)
(*      modified on Thu Jan 25 10:33:49 1990 by muller         *)


(* Next we describe a very simple implementation of text writers. A
fast implementation would probably import the private representation
of the Text interface. *)

MODULE TextWr;
IMPORT Wr, WrClass, Text;
FROM Wr IMPORT Failure;

REVEAL
  T = Wr.T BRANDED OBJECT text: TEXT END;
  
CONST BuffSize = 500; 

(* A single buffer of the given size is used; each time it fills up,
its characters are appended to text.  That is, the representation
invariant for a text writer wr is

	target(wr) = wr.text & SUBARRAY(wr.buff^, 0, wr.cur - wr.lo)

Notice that since wr is unseekable, len(wr) is always equal to wr.cur. *)

PROCEDURE New(): T =
  BEGIN
    RETURN
      NEW(T, 
        st := 0,
        lo := 0,
        cur := 0,
        hi := BuffSize,
        buff := NEW(REF ARRAY OF CHAR, BuffSize),
        closed := FALSE,
        seekable := FALSE,
        buffered := TRUE,
        seek := Seek, 
        close := Close, 
        text := "")
  END New;


PROCEDURE Seek(wr: T; n: CARDINAL) RAISES {Failure} =
  BEGIN
    IF wr.cur # n THEN
      RAISE Failure("This shouldn\'t happen");
    END;
    IF wr.cur # wr.lo THEN
      wr.text := wr.text & 
                 Text.FromChars (SUBARRAY (wr.buff^, 0, wr.cur - wr.lo)); END;
    wr.lo := wr.cur;
    wr.hi := wr.lo + NUMBER(wr.buff^)
  END Seek;


PROCEDURE Close(wr: T) RAISES {} =
  BEGIN wr.buff := NIL; wr.text := NIL END Close;


PROCEDURE ToText(wr: T): TEXT =
  VAR 
    result: Text.T;
  BEGIN
    WrClass.Lock(wr);
    TRY
      wr.seek(wr.cur);
      result := wr.text;
      wr.text := "";
      wr.cur := 0;
      wr.lo := 0;
      wr.hi := NUMBER(wr.buff^)
    FINALLY 
      WrClass.Unlock(wr)
    END;
    RETURN result
  END ToText;

BEGIN END TextWr.