(* Copyright 1992 Digital Equipment Corporation.               *)
(* Distributed only by permission.                             *)
(* Last modified on Wed Oct 28 13:52:50 PST 1992 by johnh *)
(*      modified on Mon Oct 26 15:49:18 PST 1992 by mhb *)


MODULE View;
<* PRAGMA LL *>

IMPORT Fmt, List, Point, Rd, ReactivityVBT, Rect, StableVBT, Sx, Thread,
       Trestle, TrestleComm, VBT, ViewClass, Wr, ZeusClass,
       ZeusPanelPrivate, ZeusUtil;

REVEAL
  T = ViewClass.T BRANDED OBJECT
      OVERRIDES
        init       := DefaultInit;
        install    := DefaultInstall;
        delete     := DefaultDelete;
        snapshot   := DefaultSnapshot;
        restore    := DefaultRestore;
        startrun   := DefaultStartrun;
        endrun     := DefaultEndrun;
        reactivity := DefaultReactivity;
      END;

TYPE
  Waiter =
    Thread.Closure OBJECT v: T;  OVERRIDES apply := WaiterThread; END;

<*FATAL TrestleComm.Failure, Wr.Failure, Thread.Alerted, Rd.Failure, 
    Rd.EndOfFile, Sx.ReadError*>

PROCEDURE DefaultInit (v: T; ch: VBT.T): T =
  <* LL = VBT.mu *>
  BEGIN
    v.evtCond := NEW(Thread.Condition);
    EVAL ReactivityVBT.T.init(v, ch);
    v.reactivity(FALSE);
    RETURN v;
  END DefaultInit;

PROCEDURE DefaultInstall (v: T) = 
<* LL = VBT.mu *>
  BEGIN
    Trestle.Attach (v);
    Trestle.Decorate (v, applName := "Zeus View", windowTitle := v.name);
    Trestle.MoveNear (v, NIL);
    EVAL Thread.Fork(NEW(Waiter, v := v));
  END DefaultInstall;

PROCEDURE WaiterThread (waiter: Waiter): REFANY RAISES {} =
<* LL = {} *>
  BEGIN
    WITH v = waiter.v DO
      Trestle.AwaitDelete (v);
      LOCK VBT.mu DO
        ZeusPanelPrivate.DetachView (v);
        VBT.Discard (v);
      END
    END;
    RETURN NIL
  END WaiterThread;


PROCEDURE DefaultDelete (v: T) = 
<* LL = VBT.mu *>
  BEGIN
    Trestle.Delete (v);
  END DefaultDelete;

PROCEDURE DefaultSnapshot (v: T; wr: Wr.T) RAISES {ZeusClass.Error} =
<* LL = VBT.mu *>
  VAR
    dom := VBT.Domain(v);
    nw  := Trestle.ScreenOf(v, Rect.NorthWest(dom));
    se  := Trestle.ScreenOf(v, Rect.SouthEast(dom));
  BEGIN
    IF nw.id # Trestle.NoScreen THEN
      Wr.PutText(wr, "(ScreenPos " & Fmt.Int(nw.id) & " " & Fmt.Int(nw.q.h)
                       & " " & Fmt.Int(nw.q.v) & " " & Fmt.Int(se.q.h)
                       & " " & Fmt.Int(se.q.v) & ")\n");
    END;
  END DefaultSnapshot;

PROCEDURE DefaultRestore (v: T; list: List.T)
  RAISES {ZeusClass.Error} =
  <* LL = VBT.mu *>
  VAR
    id    : Trestle.ScreenID;
    nw, se: Point.T;
  PROCEDURE NarrowToInt (a: REFANY): INTEGER
    RAISES {ZeusClass.Error} =
    BEGIN
      IF ISTYPE(a, REF INTEGER) THEN
        RETURN NARROW(a, REF INTEGER)^;
      ELSE
        RAISE ZeusClass.Error(
                "NARROW failed in View.DefaultRestore");
      END;
    END NarrowToInt;
  BEGIN
    IF list = NIL THEN
      Trestle.MoveNear(v, NIL);
    ELSE
      list := List.First(list); (* Snapshot brackets w/ parens *)
      IF List.Length(list) # 6 THEN
        RAISE
          ZeusClass.Error("View.DefaultRestore: bad ScreenPos");
      END;
      TRY
        ZeusUtil.KeywordCheck(list, "ScreenPos")
      EXCEPT
        ZeusUtil.BadSnapshot (msg) =>
          RAISE ZeusClass.Error(
                  "View.DefaultRestore: bad ScreenPos: " & msg);
      END;
      EVAL List.Pop(list);      (* first elem is ScreenPos *)
      id := NarrowToInt(List.Pop(list));
      nw.h :=
        NarrowToInt(List.Pop(list)) - ZeusPanelPrivate.XDRIFT;
      nw.v :=
        NarrowToInt(List.Pop(list)) - ZeusPanelPrivate.YDRIFT;
      se.h :=
        NarrowToInt(List.Pop(list)) - ZeusPanelPrivate.XDRIFT;
      se.v :=
        NarrowToInt(List.Pop(list)) - ZeusPanelPrivate.YDRIFT;
      StableVBT.SetShape(v, ABS(se.h - nw.h), ABS(se.v - nw.v));
      IF ZeusUtil.ScreenPosOK(id, nw) THEN
        Trestle.Overlap(v, id, nw);
      ELSE
        (* leave alone; already installed *)
      END;
    END;
  END DefaultRestore;

PROCEDURE DefaultStartrun (<*UNUSED*>v: T) = 
<* LL = {} *>
  BEGIN
    (* should the default method repaint the VBT with the bg color? *)
  END DefaultStartrun;

PROCEDURE DefaultEndrun (<*UNUSED*> v: T) = 
<* LL = {} *>
  BEGIN
  END DefaultEndrun;


PROCEDURE DefaultReactivity (v: T; on: BOOLEAN) =
<* LL <= VBT.mu *>
  BEGIN
    IF on THEN
      ReactivityVBT.Set(v, ReactivityVBT.State.Active);
    ELSE
      ReactivityVBT.Set(v, ReactivityVBT.State.Passive);
    END;
  END DefaultReactivity;

BEGIN
END View.