Copyright (C) 1994, Digital Equipment Corp.
<* PRAGMA LL *> MODULEA; IMPORT Filter, FilterClass, VBTClass, VBT, VBTRep, Point, Rect, Region, Trestle, TrestleComm, InstalledVBT, Batch, BatchUtil, ScrnPixmap, MouseSplit, DblBufferUtil; 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 also maintains a rectangle badRect(v)
in the child's
coordinate system. The rectangle badRect(v)
is a (not necessarily
tightest) bounding box on the portion of offscreen(v)
that has changed
since the last update.
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: VBT.T := NIL; badRect, damaged: Rect.T; (* 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;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 SetupOffScreen(prnt); IF child # NIL THEN LOCK prnt DO prnt.delta := delta END; VBTClass.Reshape(child, Rect.Sub(cd.new, delta), Rect.Empty) END END Reshape; PROCEDURERepaint (prnt: T; READONLY rgn: Region.T) RAISES {} =
Mergergn
withbadRect(prnt)
, and then update the on-screen VBT.
<* LL.sup = VBT.mu.prnt *> BEGIN LOCK prnt DO prnt.badRect := Rect.Join(prnt.badRect, 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 {} =
MergebadRect(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.badRect := Rect.Join(prnt.badRect, clip); prnt.damaged := Rect.Join(prnt.damaged, 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); LOCK prnt DO prnt.damaged := Rect.Empty END 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.Leaf): 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 ---------------------------------------GetDamaged (v: VBT.Leaf): Rect.T = <* LL.sup < v *> VAR db: T := ForceBatches(v); BEGIN LOCK db DO RETURN db.damaged END END GetDamaged; PROCEDURESetDamaged (v: VBT.Leaf; READONLY r: Rect.T) = <* LL.sup < v *> VAR db: T := ForceBatches(v); BEGIN LOCK db DO db.damaged := r END END SetDamaged;
PROCEDURESetupOffScreen (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.badRect
toRect.Full
.
<* 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 := NEW(VBT.Leaf); VAR 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 END; LOCK v DO v.offScreen := offScreen; v.badRect := Rect.Empty; v.damaged := Rect.Empty END END SetupOffScreen; PROCEDUREUpdate (v: T; wait := TRUE) =
Updatev
fromoffscreen(v)
, and setbadRect(v)
to the empty rectangle.
<* LL.sup < v *> VAR badRect: Rect.T; offScreen: VBT.T; delta: Point.T; BEGIN LOCK v DO badRect := v.badRect; offScreen := v.offScreen; delta := v.delta END; IF offScreen # NIL AND badRect # Rect.Empty THEN VAR dummy: Region.T; pixmap := VBT.Capture(offScreen, badRect, dummy); BEGIN IF pixmap # NIL THEN VBT.PaintScrnPixmap(v, src := pixmap, delta := delta); VBT.Sync(v, wait); <* FATAL TrestleComm.Failure *> BEGIN pixmap.free() END; LOCK v DO v.badRect := Rect.Empty END END END END END Update; BEGIN END DblBufferVBT.