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;
PROCEDURE Repaint (prnt: T; READONLY rgn: Region.T) RAISES {} =
MergergnwithbadRect(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;
PROCEDURE Rescreen (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;
PROCEDURE Mouse (prnt: T; READONLY cd: VBT.MouseRec) RAISES {} =
IfNOT cd.cp.gone, invoke the parent type'smousemethod 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;
PROCEDURE Position (prnt: T; READONLY cd: VBT.PositionRec) RAISES {} =
IfNOT cd.cp.offScreen, invoke the parent type'spositionmethod 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;
PROCEDURE SetCursor (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;
PROCEDURE PaintBatch (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;
PROCEDURE Sync (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;
PROCEDURE Capture (
prnt: T;
<*UNUSED*> ch: VBT.T;
READONLY rect: Rect.T;
VAR (*OUT*) br: Region.T)
: ScrnPixmap.T RAISES {} =
The rectanglerectis inch's coordinate system. Capture the rectanglerectfrom 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;
PROCEDURE ScreenOf (
prnt: T;
<*UNUSED*> ch: VBT.T;
READONLY pt: Point.T)
: Trestle.ScreenOfRec RAISES {} =
The pointptis inch's coordinate system. Recurse onprntwith the pointpttranslated 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;
PROCEDURE ForceBatches (v: VBT.Leaf): T =
Force the paint batches of all ancestors ofvup 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;
PROCEDURE GetDamaged (v: VBT.Leaf): Rect.T =
<* LL.sup < v *>
VAR db: T := ForceBatches(v); BEGIN
LOCK db DO RETURN db.damaged END
END GetDamaged;
PROCEDURE SetDamaged (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;
Create/capture the off-screen VBT ---------------------------------------
PROCEDURESetupOffScreen (v: T) =
Initializev's off-screen VBT. The VBT installed offscreen is aFilter.Tcontaining aVBT.Leaf. The fieldv.offScreenis 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.badRecttoRect.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;
PROCEDURE Update (v: T; wait := TRUE) =
Updatevfromoffscreen(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.