<* PRAGMA LL *>

MODULE ReactivityVBT;

IMPORT Cursor, PaintOp, MouseSplit, VBT, VBTClass, FilterClass,
         Batch, BatchUtil, BatchRep, ETAgent, Rect, Region, Point,
         ScrnPixmap, Pixmap;

REVEAL
  T = Public BRANDED OBJECT
        newState: State;
        newCursor: Cursor.T;
        newOp   : PaintOp.ColorScheme;
        (* state, cursor, op are protected by both VBT.mu and ch, if any: *)
        state: State;
        cursor: Cursor.T;
        op   : PaintOp.ColorScheme;
        (* lastFocus is protected by v *)
        lastFocus: VBT.T := NIL
      OVERRIDES
      (* of ReactivityVBT methods: *)
        init         := Init;
        paintDormant := PaintDormant;
      (* of VBT methods: *)
        capture    := Capture;
        paintbatch := PaintBatch;
        reshape    := Reshape;
        redisplay  := Redisplay;
        repaint    := Repaint;
        locate     := Locate;
        key        := Key;
        misc       := Misc;
        acquire    := Acquire;
      END;

PROCEDURE Init (v: T; ch: VBT.T; colors: PaintOp.ColorScheme := NIL): T =
  BEGIN
    EVAL ETAgent.T.init (v, ch);
    v.state := State.Active;
    v.newState := State.Active;
    v.cursor := Cursor.DontCare;
    v.newCursor := Cursor.DontCare;
    IF colors = NIL THEN colors := PaintOp.bgFg END;
    v.op := colors;
    v.newOp := colors;
    RETURN v
  END Init;

PROCEDURE PaintDormant (v: T; r: Rect.T; colors: PaintOp.ColorScheme) =
  BEGIN
    VBT.PaintTexture (v, r, colors.transparentBg, Pixmap.Gray, Point.Origin)
  END PaintDormant;

PROCEDURE Set (v: T; state: State; cursor: Cursor.T) =
  BEGIN
    v.newState := state;
    v.newCursor := cursor;
    IF v.state # state OR v.cursor # cursor THEN VBT.Mark (v) END
  END Set;

PROCEDURE Get (v: T): State =
  BEGIN
    RETURN v.newState
  END Get;

PROCEDURE GetCursor (v: T): Cursor.T =
  BEGIN
    RETURN v.newCursor
  END GetCursor;

PROCEDURE SetColors (v: T; colors: PaintOp.ColorScheme) =
  BEGIN
    v.newOp := colors;
    IF v.newOp # v.op AND v.state >= State.Dormant THEN VBT.Mark (v) END
  END SetColors;

PROCEDURE Capture (               v : T;
                   <* UNUSED *> ch  : VBT.T;
                       READONLY rect: Rect.T;
                       VAR      br  : Region.T): ScrnPixmap.T =
  BEGIN
    IF v.state = State.Active THEN
      RETURN VBT.Capture(v, rect, br)
    ELSE
      br := Region.FromRect(rect);
      RETURN NIL
    END
  END Capture;

PROCEDURE UpdateStateAndFixCursor (    v            : T;
                                   VAR state, ostate: State;
                                   VAR op, oop      : PaintOp.ColorScheme) =
  VAR cursor := v.newCursor;
      ocursor := v.cursor;
  BEGIN
    state := v.newState;
    ostate := v.state;
    op := v.newOp;
    oop := v.op;
    IF v.ch # NIL THEN
      LOCK v.ch DO
        v.op := v.newOp;
        v.cursor := v.newCursor;
        v.state := v.newState
      END
    ELSE
      v.op := v.newOp;
      v.cursor := v.newCursor;
      v.state := v.newState
    END;
    IF state # ostate THEN
      IF state = State.Active OR ostate = State.Active THEN
        MouseSplit.InvalidateCache(v)
      END
    END;
    IF cursor # ocursor THEN
      VBT.SetCursor(v, cursor);
    END
  END UpdateStateAndFixCursor;

PROCEDURE Redisplay (v: T) =
  VAR
    cdP          : VBT.ReshapeRec;
    state, ostate: State;
    op, oop      : PaintOp.ColorScheme;
  BEGIN
    IF (v.ch = NIL) OR NOT Rect.Equal(VBT.Domain(v.ch), VBT.Domain(v)) THEN
      cdP.new := VBT.Domain(v);
      cdP.prev := cdP.new;
      cdP.saved := Rect.Empty;
      cdP.marked := TRUE;
      Reshape(v, cdP);
      RETURN
    END;
    UpdateStateAndFixCursor(v, state, ostate, op, oop);
    IF ((state >= State.Dormant) OR (ostate >= State.Dormant))
         AND ((state # ostate) OR (op # oop)) THEN
      IF (state = State.Dormant) AND (ostate # State.Vanish) THEN
        v.paintDormant (Rect.Full, op)
      ELSIF state = State.Vanish THEN
        VBT.PaintTexture(v, Rect.Full, op.bg, Pixmap.Solid, Point.Origin)
      ELSE
        VBTClass.Repaint(v, Region.FromRect(VBT.Domain(v)))
      END
    END
  END Redisplay;

PROCEDURE Reshape (v: T; READONLY cd: VBT.ReshapeRec) =
  VAR
    cdP          : VBT.ReshapeRec;
    state, ostate: State;
    op, oop      : PaintOp.ColorScheme;
  BEGIN
    cdP := cd;
    UpdateStateAndFixCursor (v, state, ostate, op, oop);
    IF state >= State.Dormant THEN cdP.saved := Rect.Empty END;
    ETAgent.T.reshape (v, cdP);
    IF state = State.Vanish THEN
      VBT.PaintTexture (v, Rect.Full, op.bg, Pixmap.Solid, Point.Origin)
    END
  END Reshape;

PROCEDURE Repaint (v: T; READONLY bad: Region.T) =
  BEGIN
    IF v.state = State.Vanish THEN
      VBT.PaintTexture (v, bad.r, v.op.bg, Pixmap.Solid, Point.Origin)
    ELSE
      ETAgent.T.repaint (v, bad)
    END
  END Repaint;

PROCEDURE Locate (v: T; READONLY pt: Point.T; VAR (* out*) r: Rect.T):
  VBT.T =
  BEGIN
    IF v.state # State.Active THEN
      r := Rect.Full;
      RETURN NIL
    ELSE
      RETURN ETAgent.T.locate (v, pt, r)
    END
  END Locate;

PROCEDURE PaintBatch (v: T; ch: VBT.T; ba: Batch.T) =
  VAR rect: Rect.T;
  BEGIN
    IF v.state < State.Dormant THEN
      VBTClass.PaintBatch(v, ba)
    ELSIF v.state = State.Vanish THEN
      Batch.Free(ba)
    ELSE
      BatchUtil.Tighten(ba);
      IF Rect.IsEmpty(ba.scrollSource) THEN
        rect := ba.clip;
	VBT.BeginGroup(v);
        VBTClass.PaintBatch(v, ba);
        v.paintDormant (rect, v.op);
	VBT.EndGroup(v)
      ELSE
        VBTClass.ForceRepaint(ch, Region.FromRect(ba.clip))
      END
    END
  END PaintBatch;

PROCEDURE Key (v: T; READONLY cd: VBT.KeyRec) =
  BEGIN
    IF v.state = State.Active THEN ETAgent.T.key (v, cd) END
  END Key;

PROCEDURE Acquire(v: T; ch: VBT.T; w: VBT.T;
  s: VBT.Selection; ts: VBT.TimeStamp)
  RAISES {VBT.Error} = <* LL.sup = ch *>
  BEGIN
    ETAgent.T.acquire(v, ch, w, s, ts);
    IF s = VBT.KBFocus THEN
      LOCK v DO v.lastFocus := w END
    END
  END Acquire;

PROCEDURE Misc (v: T; READONLY cd: VBT.MiscRec) =
  <* LL.sup = VBT.mu *>
  VAR lastFocus, parent: VBT.T;
  BEGIN
    IF cd.type = VBT.TakeSelection AND cd.selection = VBT.KBFocus THEN
      LOCK v DO lastFocus := v.lastFocus END;                 (* CHANGED *)
      IF lastFocus # NIL THEN
        (* Is it still our descendant? *)
        parent := VBT.Parent (lastFocus); (* REQUIRES LL.sup < lastFocus *)
        WHILE parent # NIL AND parent # v DO
          parent := VBT.Parent (parent)   (* REQUIRES LL.sup < parent *)
        END;
        IF parent = NIL THEN   (* No. *)
          LOCK v DO v.lastFocus := NIL END                    (* CHANGED *)
        ELSE                   (* Yes. *)
          VBTClass.Misc (lastFocus, cd); RETURN
        END
      END
    END;
    ETAgent.T.misc (v, cd)
  END Misc;

BEGIN
END ReactivityVBT.