<* PRAGMA LL *> MODULEA; IMPORT Filter, FilterClass, VBTClass, VBT, VBTRep, Point, Rect, Region, Trestle, TrestleComm, InstalledVBT, Batch, BatchUtil, ScrnPixmap, MouseSplit, DblBufferUtil, PaintOp, HighlightVBT; DblBufferVBT
DblBufferVBT.T
v
is implemented by creating a VBT offscreen(v)
that
is installed off-screen. The paintbatch
method is overridden to forward
paint batches to offscreen(v)
. The operation VBT.Sync(v)
updates the
on-screen VBT from the portion of offscreen(v)
that has changed since the
last update.
Because offscreen(v)
is installed off screen, the northwest corner of its
domain has the coordinates (0, 0)
. The reshape
method arranges for the
double-buffer's child's domain to agree with the domain of offscreen(v)
.
The double-buffer maintains a vector delta(v)
, which is the difference
between the parent's and child's coordinate systems. In practice, delta(v)
= Rect.Northwest(VBT.Domain(v))
.
The double-buffer maintains two rectangles screenDiff(v)
and
savedDiff(v)
that satisfy the following invariants:
I1: (A p: offscreen(v)(p) # screen(v)(p) => p IN screenDiff(v)) I2: (A p: offscreen(v)(p) # savedBuff(v)(p) => p IN savedDiff(v))savedBuff(v) = NIL represents the state where the saved buffer is all background.
If either offScreen(v)
or savedBuff(v)
are non-NIL, their domains are
congruent to v
's domain.
REVEAL T = Filter.T BRANDED OBJECT <* LL >= { VBT.mu.SELF, SELF } *> delta := Point.Origin; (* child coord + delta = parent coord. *) screenId: VBT.ScreenID := -1; <* LL >= { SELF } *> offScreen, savedBuff: VBT.T := NIL; screenDiff, savedDiff: Rect.T; (* both in child coordinates *) OVERRIDES (* split methods *) <* LL >= {VBT.mu, SELF, ch} *> beChild := BeChild; (* VBT down methods *) <* LL.sup = VBT.mu.SELF *> reshape := Reshape; repaint := Repaint; rescreen := Rescreen; <* LL.sup = VBT.mu *> mouse := Mouse; position := Position; (* VBT up methods *) <* LL.sup = ch *> setcage := SetCage; setcursor := SetCursor; paintbatch := PaintBatch; sync := Sync; capture := Capture; screenOf := ScreenOf; END; VAR showSyncRect := FALSE;
For debugging: when showSyncRect
is true, a highlight rectangle is drawn
to frame the rectangle that is copied when the on-screen VBT is updated
from the off-screen VBT.
Split Method Implementations --------------------------------------------
PROCEDUREDown Method Implementations ---------------------------------------------BeChild (v: T; ch: VBT.T) RAISES {} = <* LL >= {VBT.mu, v, ch} *> BEGIN Filter.T.beChild(v, ch); VBTClass.ClearShortCircuit(ch) END BeChild;
In the down direction, argument points and rectangles must be translated
from the parent's coordinate system to the child's coordinate system. This
is accomplished by subtracting delta(prnt)
.
PROCEDUREReshape (prnt: T; READONLY cd: VBT.ReshapeRec) RAISES {} =
Create and install a new off-screen VBT withprnt
's width and height, set the new valuedelta(prnt)
, and recursively reshape the child so it has the same domain asoffscreen(prnt)
.
<* LL.sup = VBT.mu.prnt *> VAR child := prnt.ch; delta := Rect.NorthWest(cd.new); BEGIN LOCK prnt DO prnt.delta := delta END; IF Rect.Congruent(cd.new, cd.prev) AND NOT Rect.IsEmpty(cd.new) THEN VAR offScreen: VBT.T; BEGIN LOCK prnt DO offScreen := prnt.offScreen END; PaintVBTtoVBT(prnt, cd.new, offScreen, delta); LOCK prnt DO prnt.screenDiff := Rect.Empty END END ELSE ReshapeOffScreen(prnt); ReshapeSavedBuff(prnt); IF child # NIL THEN VBTClass.Reshape(child, Rect.Sub(cd.new, delta), Rect.Empty) END END END Reshape; PROCEDURERepaint (prnt: T; READONLY rgn: Region.T) RAISES {} =
Mergergn
withscreenDiff(prnt)
, and then update the on-screen VBT.
<* LL.sup = VBT.mu.prnt *> BEGIN LOCK prnt DO prnt.screenDiff := Rect.Join(prnt.screenDiff, Rect.Sub(rgn.r, prnt.delta)) END; Update(prnt) END Repaint; PROCEDURERescreen (prnt: T; READONLY cd: VBT.RescreenRec) =
Cache the current screen-id, and then call the parent type's rescreen
method.
<* LL.sup = VBT.mu.prnt *> VAR screen := Trestle.ScreenOf(prnt, Point.Origin); BEGIN LOCK prnt DO prnt.screenId := screen.id END; Filter.T.rescreen(prnt, cd) END Rescreen; PROCEDUREMouse (prnt: T; READONLY cd: VBT.MouseRec) RAISES {} =
IfNOT cd.cp.gone
, invoke the parent type'smouse
method with the mouse location translated by-delta(prnt)
.
<* LL.sup = VBT.mu *> VAR cdP: VBT.MouseRec; child := prnt.ch; BEGIN IF prnt.ch # NIL THEN cdP := cd; IF NOT cd.cp.gone THEN cdP.cp.pt := Point.Sub(cdP.cp.pt, prnt.delta) END; VBTClass.Mouse(child, cdP) END END Mouse; PROCEDUREPosition (prnt: T; READONLY cd: VBT.PositionRec) RAISES {} =
IfNOT cd.cp.offScreen
, invoke the parent type'sposition
method with the mouse location translated by-delta(prnt)
.
<* LL.sup = VBT.mu *> VAR cdP: VBT.PositionRec; child := prnt.ch; BEGIN IF prnt.ch # NIL THEN cdP := cd; IF NOT cd.cp.offScreen THEN cdP.cp.pt := Point.Sub(cd.cp.pt, prnt.delta) END; VBTClass.Position(child, cdP) END END Position;Up Method Implementations -----------------------------------------------
In the up direction, argument points and rectangles must be translated
from the child's coordinate system to the parent's coordinate system. This
is accomplished by adding delta(prnt)
.
PROCEDURESetCage (prnt: T; ch: VBT.T) RAISES {} =
If the childch
's cage is non-trivial and refers to the same screen as that of its parentprnt
, then translate the cage to parent coordinates and recursively propagate the message up the VBT tree.
<* LL.sup = ch *> VAR cg := VBTClass.Cage(ch); BEGIN LOCK prnt DO IF cg.rect # Rect.Full AND prnt.screenId = cg.screen THEN cg.rect := Rect.Add(cg.rect, prnt.delta) END; VBTClass.SetCage(prnt, cg) END END SetCage; PROCEDURESetCursor (prnt: T; ch: VBT.T) RAISES {} = VAR cs := ch.getcursor(); BEGIN (* LL=ch *) LOCK prnt DO IF cs # prnt.effectiveCursor THEN prnt.effectiveCursor := cs; IF prnt.parent # NIL THEN prnt.parent.setcursor(prnt) END END END END SetCursor; PROCEDUREPaintBatch (prnt: T; <*UNUSED*> ch: VBT.T; ba: Batch.T) RAISES {} =
MergescreenDiff(prnt)
with a bounding box of the painting commandsba
; then forward the paint batch tooffscreen(prnt)
.
<* LL.sup = ch *> VAR offScreen: VBT.T; clip: Rect.T; BEGIN DblBufferUtil.Tighten(ba); clip := BatchUtil.GetClip(ba); LOCK prnt DO offScreen := prnt.offScreen; prnt.screenDiff := Rect.Join(prnt.screenDiff, clip); prnt.savedDiff := Rect.Join(prnt.savedDiff, clip) END; VBTClass.PaintBatch(offScreen, ba) END PaintBatch; PROCEDURESync (prnt: T; <*UNUSED*> ch: VBT.T; wait: BOOLEAN) =
Update the on-screen VBT from offscreen(prnt)
.
<* LL.sup = ch *> BEGIN Update(prnt, wait) END Sync; PROCEDURECapture ( prnt: T; <*UNUSED*> ch: VBT.T; READONLY rect: Rect.T; VAR (*OUT*) br: Region.T) : ScrnPixmap.T RAISES {} =
The rectanglerect
is inch
's coordinate system. Capture the rectanglerect
from the VBToffscreen(prnt)
.
<* LL.sup = ch *> VAR offScreen: VBT.T; BEGIN LOCK prnt DO offScreen := prnt.offScreen END; RETURN VBT.Capture(offScreen, rect, br) END Capture; PROCEDUREScreenOf ( prnt: T; <*UNUSED*> ch: VBT.T; READONLY pt: Point.T) : Trestle.ScreenOfRec RAISES {} =
The pointpt
is inch
's coordinate system. Recurse onprnt
with the pointpt
translated bydelta(prnt)
.
<* LL.sup = ch *> VAR delta: Point.T; BEGIN LOCK prnt DO delta := prnt.delta END; RETURN Trestle.ScreenOf(prnt, Point.Add(pt, delta)); END ScreenOf; PROCEDUREForceBatches (v: VBT.T): T =
Force the paint batches of all ancestors ofv
up to a VBT of typeT
, and return that VBT.
<* LL.sup < v *> BEGIN WHILE NOT ISTYPE(v, T) DO LOCK v DO VBTRep.ForceBatch(v) END; v := VBT.Parent(v) END; <* ASSERT v # NIL *> RETURN v END ForceBatches; PROCEDURECreate/capture the off-screen VBT ---------------------------------------ClearSaved2 (v: T) = <* LL.sup < v *> VAR offScreen, savedBuff: VBT.T; BEGIN (* discard existing buffer (if any) *) LOCK v DO offScreen := v.offScreen; savedBuff := v.savedBuff END; IF savedBuff # NIL THEN Trestle.Delete(savedBuff); VBT.Discard(savedBuff) END; VAR savedDiff: Rect.T; BEGIN IF offScreen # NIL THEN savedDiff := VBT.Domain(offScreen) ELSE savedDiff := Rect.Full END; LOCK v DO v.savedBuff := NIL; v.savedDiff := savedDiff END END END ClearSaved2; PROCEDUREClearSaved (v: VBT.T) = <* LL.sup < v *> BEGIN WHILE NOT ISTYPE(v, T) DO v := VBT.Parent(v) END; <* ASSERT v # NIL *> ClearSaved2(v) END ClearSaved; PROCEDURESave (v: VBT.T) = <* LL.sup < v *> VAR db: T := ForceBatches(v); offscreen, savedBuff: VBT.T; savedDiff: Rect.T; BEGIN (* create a savedBuff if necessary *) LOCK db DO offscreen := db.offScreen; savedBuff := db.savedBuff; savedDiff := db.savedDiff END; IF offscreen = NIL THEN RETURN END; IF savedBuff = NIL THEN savedBuff := InstallOffscreen(db) END; PaintVBTtoVBT(savedBuff, savedDiff, offscreen); LOCK db DO db.savedBuff := savedBuff; db.savedDiff := Rect.Empty END END Save; PROCEDURERestore (v: VBT.T) = <* LL.sup < v *> VAR db: T := ForceBatches(v); offscreen, savedBuff: VBT.T; savedDiff: Rect.T; BEGIN (* create a savedBuff if necessary *) LOCK db DO offscreen := db.offScreen; savedBuff := db.savedBuff; savedDiff := db.savedDiff END; IF offscreen = NIL THEN RETURN END; IF savedBuff = NIL THEN VBT.PaintTint(offscreen, savedDiff, PaintOp.Bg) ELSE PaintVBTtoVBT(offscreen, savedDiff, savedBuff) END; LOCK db DO db.screenDiff := Rect.Join(db.screenDiff, savedDiff); db.savedDiff := Rect.Empty END END Restore;
PROCEDUREInstallOffscreen (v: T): VBT.T =
Install and return a new offscreen VBT whose domain is
congruent to v
's.
VAR offScreen := NEW(VBT.Leaf); dom := VBT.Domain(v); tso := Trestle.ScreenOf(v, Point.Origin); trsl := tso.trsl; stInstall := VBT.ScreenTypeOf(InstalledVBT.Child(v)); st := VBT.ScreenTypeOf(v); <* FATAL TrestleComm.Failure *> BEGIN IF trsl # NIL AND st # NIL THEN (* Install a Filter above "offScreen" so that it can have a ScreenType that Trestle likes in the case where "v" has an "unusual" screen type (i.e. there is a scale filter) *) WITH filter = NEW(Filter.T).init(offScreen) DO Trestle.Attach(filter, trsl); Trestle.InstallOffscreen( filter, dom.east - dom.west, dom.south - dom.north, stInstall); IF filter.st # st THEN (* duke it out with trestle to set the screen type and domain *) VBTClass.Rescreen(offScreen, st); VBTClass.Reshape(offScreen, filter.domain, Rect.Empty); END END END; RETURN offScreen END InstallOffscreen; PROCEDUREReshapeOffScreen (v: T) =
Initializev
's off-screen VBT. The VBT installed offscreen is aFilter.T
containing aVBT.Leaf
. The fieldv.offScreen
is set to the leaf. The offscreen VBT is created with the same width and height asv
. This procedure also has the side-effect of initializingv.screenDiff
andv.savedDiff
to the full domain of the off-screen VBT.
<* LL.sup = VBT.mu.v *> VAR offScreen: VBT.T; BEGIN (* Delete and discard the current off-screen VBT (if any) *) LOCK v DO offScreen := v.offScreen; v.offScreen := NIL END; IF offScreen # NIL THEN Trestle.Delete(offScreen); VBT.Discard(offScreen) END; offScreen := InstallOffscreen(v); LOCK v DO v.offScreen := offScreen; v.screenDiff := VBT.Domain(offScreen); v.savedDiff := v.screenDiff END END ReshapeOffScreen; PROCEDUREReshapeSavedBuff (v: T) = VAR new, old: VBT.T; meet: Rect.T; BEGIN LOCK v DO old := v.savedBuff END; IF old = NIL THEN RETURN END; new := InstallOffscreen(v); (* copy the common areas *) meet := Rect.Meet(VBT.Domain(old), VBT.Domain(new)); PaintVBTtoVBT(new, meet, old); (* fill the remaining area with background *) VAR a: Rect.Partition; BEGIN Rect.Factor(VBT.Domain(new), meet, (*out*) a, 0, 0); a[2] := a[4]; FOR i := 0 TO 3 DO VBT.PaintTint(new, a[i], PaintOp.Bg) END END; (* discard the old buffer *) Trestle.Delete(old); VBT.Discard(old); LOCK v DO v.savedBuff := new END END ReshapeSavedBuff; PROCEDUREPaintVBTtoVBT (to: VBT.T; clip: Rect.T; from: VBT.T; delta := Point.Origin; wait := TRUE) = <* LL.sup < to *> VAR dummy: Region.T; pixmap: ScrnPixmap.T; BEGIN pixmap := VBT.Capture(from, Rect.Sub(clip, delta), (*OUT*) dummy); IF pixmap # NIL THEN IF dummy = Region.Empty THEN VBT.PaintScrnPixmap(to, src := pixmap, delta := delta); VBT.Sync(to, wait) END; <* FATAL TrestleComm.Failure *> BEGIN pixmap.free() END END END PaintVBTtoVBT; PROCEDURELogBadRectArea (<*UNUSED*> area: INTEGER) =
This procedure exists soley to log the area of the rectangle copied from the off-screen VBT to the on-screen VBT at update time.
BEGIN END LogBadRectArea; PROCEDUREUpdate (v: T; wait := TRUE) =
Updatev
fromoffscreen(v)
, and setscreenDiff(v)
toRect.Empty
.
<* LL.sup < v *> VAR screenDiff: Rect.T; offScreen: VBT.T; delta: Point.T; BEGIN LOCK v DO screenDiff := v.screenDiff; offScreen := v.offScreen; delta := v.delta END; IF offScreen # NIL AND screenDiff # Rect.Empty THEN VAR transScreenDiff := Rect.Add(screenDiff, delta); BEGIN PaintVBTtoVBT(v, transScreenDiff, offScreen, delta, wait); IF showSyncRect THEN HighlightVBT.SetRect(v, transScreenDiff); VBT.Sync(v) END END; LogBadRectArea(Rect.HorSize(screenDiff) * Rect.VerSize(screenDiff)); LOCK v DO v.screenDiff := Rect.Empty END END END Update; BEGIN END DblBufferVBT.