(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Fri Jan  1 16:37:08 PST 1993 by meehan     *)
(*      modified on Tue Jun 16 13:08:05 PDT 1992 by muller     *)
(*      modified on Thu Jul 11 12:55:24 PDT 1991 by mhb        *)
(*      modified on Thu Apr  4 15:55:03 PST 1991 by brooks     *)
(*      modified on Thu May 17  9:54:12 PDT 1990 by mcjones    *)
<* PRAGMA LL *>

MODULE TypescriptVBT;

(** Here's how the typescript works:

    The vtext holds the underlying text.
    0 <= outputEnd <= typeinStart <= len(vtext).

    vtext[0 .. outputEnd-1] is the "history".  It is accessible to
    neither the reader nor the writer.  ClearHistory "erases" this, i.e.,
    deletes that section of the vtext and decrements outputEnd and
    typeinStart accordingly.

    Wr.Flush inserts characters at outputEnd, in the "middle" of the
    vtext.  After the insertion, outputEnd and typeinStart are
    incremented by the number of inserted characters.

    vtext[outputEnd .. typeinStart-1] is the section that's accessible
    to the reader.  RSeek copies characters from this part of the vtext.
    If outputEnd = typeinStart (i.e., if there are no characters
    available) and dontBlock is false, then RSeek calls Wr.Flush and
    waits for inputReady to be signaled.

    vtext[typeinStart .. len(vtext) - 1] contains typed-in characters.
    That is, keyboard input is appended to the end of the vtext.  This
    segment is editable.  When Return is typed, a Newline is appended,
    typeinStart is set to len(vtext), and inputReady is signaled, thus
    making the input line accessible to the reader.

**)

IMPORT Font, PaintOp, Rd, RdClass, Shadow, Text, TextEditVBT, TextPort,
       TextPortClass, Thread, VBT, Wr, WrClass;

REVEAL
  T = Public BRANDED OBJECT
        mu        : MUTEX;
        <* LL = mu *>
        rd        : Reader;
        wr        : Writer;
        lastReader: Thread.T;          (* whom to alert on ^C *)
        inputReady: Thread.Condition;
        terminated: BOOLEAN;
        outputEnd : CARDINAL;
      OVERRIDES
        init            := Init;
        interrupt       := Interrupt;
        handleInterrupt := HandleInterrupt;
        setThread       := SetThread;
        terminate       := Terminate;
      END;
  Port = PublicPort BRANDED "TypescriptVBT.Port" OBJECT
           v: T
         OVERRIDES
           init         := InitPort;
           returnAction := ReturnAction;
         END;
  Reader = PublicReader BRANDED "Typescript.Reader" OBJECT
             v: T
           OVERRIDES
             seek       := RSeek;
             typescript := RdTypescript
           END;
  Writer = PublicWriter BRANDED OBJECT
             v: T
           OVERRIDES
             seek       := WSeek;
             flush      := WFlush;
             typescript := WrTypescript
           END;
        
PROCEDURE Init (v     : T;
                shadow: Shadow.T     := NIL;
                style : Shadow.Style := Shadow.Style.Flat): T =
  CONST
    TerminalReaderBuffSize = 4096;
    TerminalWriterBuffSize = 4096;
  VAR port: Port;
  BEGIN
    IF shadow = NIL THEN shadow := Shadow.None END;
    TYPECASE v.port OF
    | NULL => port := NEW (Port).init (colorScheme := shadow); v.port := port
    | Port (p) => port := p
    ELSE                         <* ASSERT FALSE *>
    END;
    port.v := v;
    EVAL TextEditVBT.T.init (v, shadow := shadow, style := style);
    v.inputReady := NEW (Thread.Condition);
    v.rd := NEW (Reader, v := v, lo := 0, cur := 0, hi := 0, st := 0,
                 buff := NEW (REF ARRAY OF CHAR, TerminalReaderBuffSize),
                 closed := FALSE, seekable := FALSE, intermittent := TRUE);
    v.wr :=
      NEW (Writer, v := v, lo := 0, cur := 0, hi := TerminalWriterBuffSize,
           st := 0, buff := NEW (REF ARRAY OF CHAR, TerminalWriterBuffSize),
           closed := FALSE, seekable := FALSE, buffered := TRUE);
    v.terminated := FALSE;
    v.outputEnd := 0;
    v.mu := NEW (MUTEX);
    RETURN v
  END Init;

PROCEDURE InitPort (p               : Port;
                    hMargin, vMargin                      := 1.5;
                    font                                  := Font.BuiltIn;
                    colorScheme     : PaintOp.ColorScheme := NIL;
                    wrap                                  := TRUE;
                    readOnly                              := FALSE;
                    turnMargin                            := 2.0           ):
  Port =
  BEGIN
    EVAL TextPort.T.init (p, FALSE, hMargin, vMargin, font, colorScheme,
                          FALSE, wrap, readOnly, turnMargin);
    RETURN p
  END InitPort;

(***********************  Typescript-specific code  ***********************)

PROCEDURE WSeek (wr: Writer; <* UNUSED *> n: CARDINAL)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    wr.flush ()
  END WSeek;

PROCEDURE WFlush (wr: Writer) RAISES {Wr.Failure, Thread.Alerted} =
  VAR
    v      := wr.v;
    port   := v.port;
    normP  := TextPort.IsVisible (port, TextPort.Index (port));
    nchars := wr.cur - wr.lo;
  BEGIN
    LOCK v.mu DO
      TextPort.Replace (port, v.outputEnd, v.outputEnd,
                        Text.FromChars (SUBARRAY (wr.buff^, 0, nchars)));
      INC (v.outputEnd, nchars)
    END;
    INC (port.typeinStart, nchars);
    wr.lo := wr.cur;
    wr.hi := wr.lo + NUMBER (wr.buff^);
    IF normP THEN
      TextPort.Normalize (port)
    ELSE
      TextPort.MarkAndUpdate (port)
    END;
    IF Thread.TestAlert () THEN RAISE Thread.Alerted END
  END WFlush;

PROCEDURE RSeek (rd: Reader; dontBlock: BOOLEAN): RdClass.SeekResult
  RAISES {Rd.Failure, Thread.Alerted} =
  VAR
    nchars: CARDINAL;
    v                := rd.v;
    p                := v.port;
  BEGIN
    LOCK v.mu DO
      v.lastReader := Thread.Self ();
      nchars := p.typeinStart - v.outputEnd;
      IF nchars > 0 THEN
      ELSIF v.terminated THEN
        rd.buff := NIL;
        RETURN RdClass.SeekResult.Eof
      ELSIF dontBlock THEN
        RETURN RdClass.SeekResult.WouldBlock
      ELSE
        REPEAT
          Thread.Release (v.mu);
          TRY
            TRY Wr.Flush (v.wr) EXCEPT | Wr.Failure => END
          FINALLY
            Thread.Acquire (v.mu)
          END;
          Thread.AlertWait (v.mu, v.inputReady);
          nchars := p.typeinStart - v.outputEnd
        UNTIL nchars > 0
      END;
      WITH n   = MIN (nchars, NUMBER (rd.buff^)),
           txt = TextPort.GetText (p, v.outputEnd, v.outputEnd + n) DO
        Text.SetChars (rd.buff^, txt);
        INC (v.outputEnd, n);
        rd.lo := rd.cur;
        rd.hi := rd.lo + n;      (* NOT v.outputEnd! *)
        RETURN RdClass.SeekResult.Ready
      END                        (* WITH n *)
    END                          (* LOCK *)
  END RSeek;

PROCEDURE ReturnAction (p: Port; READONLY event: VBT.KeyRec) =
  (* Input action, called when the user presses Return in the input area.
     Unblocks RSeek if it was blocked. *)
  BEGIN
    IF event.modifiers = VBT.Modifiers {} AND NOT p.getReadOnly () THEN
      TextPort.Seek (p, TextPort.Length (p));
      TextPort.Insert (p, "\n");
      p.typeinStart := TextPort.Length (p);
      (* activate the reading client *)
      Thread.Signal (p.v.inputReady);
      TextPort.Normalize (p)
    END
  END ReturnAction;

PROCEDURE Interrupt (v: T; time: VBT.TimeStamp) =
  (* Interrupt.  It flushes (ignores) all pending typein, then calls the
     interrupt handler. *)
  VAR
    p      := v.port;
    length := TextPort.Length (p);
  BEGIN
    TextPort.Seek (p, length);
    TextPort.Insert (p, "^C");
    LOCK v.mu DO v.outputEnd := length + 2 END; (* flush all pending typein *)
    p.typeinStart := length + 2;
    v.handleInterrupt (time)
  END Interrupt;

PROCEDURE HandleInterrupt (v: T; <* UNUSED *> time: VBT.TimeStamp) =
  BEGIN
    LOCK v.mu DO
      IF v.lastReader # NIL THEN Thread.Alert (v.lastReader) END
    END
  END HandleInterrupt;

PROCEDURE GetRd (v: T): Reader =
  BEGIN
    RETURN v.rd
  END GetRd;

PROCEDURE GetWr (v: T): Writer =
  BEGIN
    RETURN v.wr
  END GetWr;

PROCEDURE RdTypescript (r: Reader): T =
  BEGIN 
    RETURN r.v
  END RdTypescript;
  
PROCEDURE WrTypescript (r: Writer): T =
  BEGIN 
    RETURN r.v
  END WrTypescript;
  
PROCEDURE GetHistory (v: T): TEXT =
  BEGIN
    LOCK v.mu DO RETURN TextPort.GetText (v.port, 0, v.outputEnd) END
  END GetHistory;

PROCEDURE ClearHistory (v: T) =
  BEGIN
    LOCK v.mu DO
      TextPort.Replace (v.port, 0, v.outputEnd, "");
      DEC (v.port.typeinStart, v.outputEnd);
      v.outputEnd := 0
    END;
    TextPort.MarkAndUpdate (v.port)
  END ClearHistory;

  
(**************************  Special controls  **************************)

PROCEDURE SetThread (v: T; thread: Thread.T := NIL) =
  BEGIN
    LOCK v.mu DO
      IF thread = NIL THEN
        v.lastReader := Thread.Self ()
      ELSE
        v.lastReader := thread
      END
    END
  END SetThread;

PROCEDURE Terminate (v: T) =
  BEGIN
    LOCK v.mu DO v.terminated := TRUE END;
    v.port.setReadOnly (TRUE);
    Thread.Signal (v.inputReady)
  END Terminate;

BEGIN
END TypescriptVBT.