(* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* *) (* Last modified on Mon Dec 21 17:45:28 PST 1992 by meehan *) (* modified on Tue Jun 16 13:08:23 PDT 1992 by muller *) (* modified on Sat Jun 13 08:05:12 1992 by mhb *) (* modified on Fri Mar 27 02:33:52 1992 by steveg *) (* modified on Sun Aug 4 5:18:19 PDT 1991 by msm *) <* 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; newOp : PaintOp.ColorScheme; (* state and op are protected by both VBT.mu and ch, if any: *) state: State; 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; VAR passiveCursor := Cursor.NotReady; 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; IF colors = NIL THEN colors := PaintOp.bgFg END; v.op := colors; v.newOp := colors; RETURN v END Init; PROCEDURE New (ch: VBT.T; colors: PaintOp.ColorScheme := NIL): T = BEGIN RETURN NEW(T).init (ch, colors) END New; 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) = BEGIN v.newState := state; IF v.state # state THEN VBT.Mark (v) END END Set; PROCEDURE Get (v: T): State = BEGIN RETURN v.state END Get; 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) = 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.state := v.newState END ELSE v.op := v.newOp; v.state := v.newState END; IF state # ostate THEN IF state = State.Active OR ostate = State.Active THEN MouseSplit.InvalidateCache(v) END; IF state = State.Passive THEN VBT.SetCursor(v, passiveCursor) ELSIF ostate = State.Passive THEN VBT.SetCursor(v, Cursor.DontCare) END 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; VBTClass.PaintBatch(v, ba); v.paintDormant (rect, v.op) 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) = VAR lastFocus, parent: VBT.T; BEGIN IF cd.type = VBT.TakeSelection AND cd.selection = VBT.KBFocus THEN LOCK v DO lastFocus := v.lastFocus; (* Is it still our descendant? *) IF lastFocus # NIL THEN parent := VBT.Parent (lastFocus); LOOP IF parent = NIL THEN (* No. *) v.lastFocus := NIL; lastFocus := NIL; EXIT ELSIF parent = v THEN (* Yes. *) EXIT ELSE parent := VBT.Parent (parent) END END END END; IF lastFocus # NIL THEN VBTClass.Misc (lastFocus, cd); RETURN END END; ETAgent.T.misc (v, cd) END Misc; BEGIN END ReactivityVBT.