Copyright (C) 1994, Digital Equipment Corp.
ZShape.m3, coded Fri Oct 31 11:24:53 1986 by cgn
<*PRAGMA LL*>
UNSAFE MODULE ZShape;
Unsafe when it traverses paint batches.
IMPORT VBT, Rect, Split, ProperSplit, Point, PolyRegion, PaintPrivate,
Region, Batch, BatchUtil, BatchRep, Axis, ScrnPixmap, Interval,
VBTTuning, VBTClass, Word, VBTRep;
FROM PaintPrivate IMPORT PaintCommand;
REVEAL
T = ZSplit.T BRANDED OBJECT
(* Protection level VBT.mu *)
OVERRIDES
beChild := BeChild;
repaint := Repaint;
reshape := Reshape;
redisplay := Redisplay;
END;
TYPE
ZChild = ProperSplit.Child OBJECT
(* Protection level VBT.mu *)
shapeChanged, mapped := FALSE;
(* The mapped bit is set if the child is mapped. *)
(* zc.upRef.shapeChanged = TRUE implies that zc's newshape method
has been called and therefore its shape method will be called
in order to possibly change the dimensions of the child. *)
dom: ZDom := NIL;
(* If zc.upRef.dom is non-NIL, then zc.upRef.dom.r is the
rectangle to which zc will be reshaped the next time
zc.parent is redisplayed non-empty and zc is mapped. Also,
zc.upRef.dom.checked is set if the domain has been
clipped into zc's shape range. *)
reshapeControl: ZSplit.ReshapeControl := NIL;
(* Protection level VBT.mu + ch *)
clip: ZClip := NIL;
(* If clip = NIL, this child is unobscured; otherwise
clip.rgn is the child's visible region, and
clip.cache is a subset of clip.rgn. *)
END;
Child = ZSplit.Child OBJECT
reg := Region.Empty;
translation := TRUE;
regionControl: RegionControl := NIL;
(* If zc.upRef.reg is Empty, the child is rectangular. Otherwise,
zc.upRef.reg is the region desired by the child that corresponds
either to its dom or to its domain when dom is NIL. *)
END;
ZClip = REF RECORD cache: Rect.T := Rect.Empty; rgn: Region.T END;
ZDom = REF RECORD r: Rect.T; checked, replacement := FALSE END;
PROCEDURE New(
bg: VBT.T := NIL;
saveBits := FALSE;
parlim: INTEGER := -1): T =
BEGIN
RETURN Be(NEW(T), bg, saveBits, parlim)
END New;
PROCEDURE BeChild(v: T; ch: VBT.T) RAISES {} =
VAR ur: Child;
BEGIN
IF ch.upRef = NIL THEN
ur := NEW(Child);
ch.upRef := ur
ELSE
ur := ch.upRef
END;
ZSplit.T.beChild(v, ch)
END BeChild;
PROCEDURE Repaint(v: T; READONLY rg: Region.T) RAISES {} =
VAR ch := v.succ(NIL); rgn := rg; ur: Child;
BEGIN
WHILE (ch # NIL) AND NOT Region.IsEmpty(rgn) DO
WITH ur = NARROW(ch.upRef, Child) DO
IF Region.OverlapRect(ch.domain, rgn) THEN
ur := ch.upRef;
IF ur.clip = NIL THEN
VBTClass.Repaint(ch, Region.MeetRect(ch.domain, rgn));
rgn := Region.Difference(rgn, Region.FromRect(ch.domain))
ELSIF Region.Overlap(ur.clip.rgn, rgn) THEN
VBTClass.Repaint(ch, Region.Meet(ur.clip.rgn, rgn));
rgn := Region.Difference(rgn, ur.clip.rgn)
END
END
END;
ch := v.succ(ch)
END
END Repaint;
PROCEDURE Reshape(v: T; READONLY cd: VBT.ReshapeRec) RAISES {} =
VAR ch: VBT.T; prev, old: Rect.T;
BEGIN
IF Rect.IsEmpty(cd.new) THEN
v.oldDom := NEW(REF Rect.T);
v.oldDom^ := cd.prev
ELSIF v.oldDom = NIL THEN
old := cd.prev
ELSE
old := v.oldDom^;
v.oldDom := NIL
END;
IF NOT Rect.IsEmpty(cd.new) AND NOT Rect.Equal(cd.new, old) THEN
ch := v.succ(NIL);
WHILE ch # NIL DO
WITH ur = NARROW(ch.upRef, Child) DO
RememberDomain(ch, ur);
prev := ur.dom.r;
ur.dom.r := ur.reshapeControl.apply(ch, old, cd.new, prev);
IF ur.shapeChanged THEN
ur.dom.checked := FALSE;
ur.shapeChanged := FALSE;
VBTClass.ClearNewShape(ch)
ELSIF ur.dom.checked THEN
ur.dom.checked := Congruent(prev, ur.dom.r);
IF ur.dom.checked THEN
IF ur.regionControl # NIL THEN
ur.reg := ur.regionControl.apply(ch, ur.dom.r)
END
END
END
END;
ch := v.succ(ch)
END
END;
IF Congruent(cd.new, cd.prev) THEN
Redisplay2(v, TRUE, TRUE, cd.saved,
Point.Sub(Rect.NorthWest(cd.new), Rect.NorthWest(cd.prev)))
ELSE
Redisplay2(v, TRUE, FALSE, cd.saved, Point.Origin)
END
END Reshape;
PROCEDURE Redisplay(v: T) RAISES {} =
BEGIN Redisplay2(v, FALSE, FALSE, v.domain, Point.Origin) END Redisplay;
TYPE
ChildRec = RECORD ch: VBT.T; ur: Child; clip: Clip; winner: BOOLEAN END;
PROCEDURE Redisplay2(v: T; inReshape, translation: BOOLEAN; READONLY
saved: Rect.T; READONLY delta: Point.T)
RAISES {} =
VAR ch := v.succ(NIL); numch := 0;
a1: ARRAY [0..9] OF ChildRec;
a2: REF ARRAY OF ChildRec;
replacement := FALSE;
BEGIN
VBTClass.LocateChanged(v);
IF Rect.IsEmpty(v.domain) THEN
WHILE ch # NIL DO
WITH ur = NARROW(ch.upRef, Child) DO
RememberDomain(ch, ur);
IF ur.clip # NIL THEN LOCK ch DO ur.clip := NIL END END
END;
IF NOT Rect.IsEmpty(ch.domain) THEN
VBTClass.Reshape(ch, Rect.Empty, Rect.Empty)
END;
ch := v.succ(ch)
END;
v.affected := PolyRegion.Empty;
RETURN
END;
translation := translation AND Rect.IsEmpty(v.affected.r);
(* Check domains, expand affected, and blow away unmapped windows *)
WHILE ch # NIL DO
WITH ur = NARROW(ch.upRef, Child) DO
IF NOT ur.mapped THEN
IF NOT Rect.IsEmpty(ch.domain) THEN
translation := FALSE;
RememberDomain(ch, ur);
VAR oldDom := ch.domain; BEGIN
VBTClass.Reshape(ch, Rect.Empty, Rect.Empty);
IF NOT inReshape THEN
IF ur.clip # NIL THEN
PolyRegion.JoinRgn(v.affected, ur.clip.rgn);
LOCK ch DO ur.clip := NIL END
ELSE
PolyRegion.JoinRect(v.affected, oldDom)
END
END
END
END
ELSE
IF (ur.dom # NIL) OR ur.shapeChanged THEN
Move2(ch, ur, GetDomain(ch));
ur.shapeChanged := FALSE;
END;
IF inReshape THEN
IF translation THEN
IF ur.dom = NIL THEN
translation := Point.Equal(delta, Point.Origin)
AND ur.translation;
ELSE
translation := Rect.Equal(Rect.Add(ch.domain, delta),
ur.dom.r) AND ur.translation;
END
END
ELSIF (ur.dom # NIL) THEN
IF ur.dom.replacement THEN
replacement := TRUE
ELSE
PolyRegion.JoinRgn(v.affected,
Region.SymmetricDifference(
Region.FromRect(ur.dom.r), Region.FromRect(ch.domain)))
END
END;
ur.translation := TRUE;
IF (ur.dom # NIL) AND Rect.IsEmpty(ur.dom.r) THEN
ur.dom := NIL;
VBTClass.Reshape(ch, Rect.Empty, Rect.Empty);
IF ur.clip # NIL THEN LOCK ch DO ur.clip := NIL END END
ELSE
INC(numch)
END
END
END;
ch := v.succ(ch)
END;
IF inReshape OR replacement OR NOT Rect.IsEmpty(v.affected.r) THEN
IF numch <= NUMBER(a1) THEN
Redisplay3(v, a1, inReshape, translation, saved, delta)
ELSE
a2 := NEW(REF ARRAY OF ChildRec, numch);
Redisplay3(v, a2^, inReshape, translation, saved, delta)
END
END
END Redisplay2;
PROCEDURE ComputeClip(
READONLY affected: Region.T;
VAR covered: PolyRegion.T;
READONLY dom, pdom: Rect.T;
inReshape: BOOLEAN;
oclip: Clip): Clip =
VAR cl, oc: Region.T; obs := PolyRegion.OverlapRect(covered, dom);
BEGIN
IF NOT obs AND Rect.Subset(dom, pdom) AND
((oclip = NIL) OR inReshape OR Region.SubsetRect(dom, affected))
THEN
PolyRegion.JoinRect(covered, dom);
RETURN NIL
ELSE
WITH ndom = Rect.Meet(dom, pdom) DO
IF inReshape THEN
cl := PolyRegion.Complement(covered, Region.FromRect(ndom))
ELSE
WITH af = Region.MeetRect(ndom, affected) DO
IF obs THEN
cl := PolyRegion.Complement(covered, af)
ELSE
cl := af
END;
IF NOT RegionEqRect(ndom, af) THEN
IF oclip = NIL THEN
oc := Region.FromRect(ndom)
ELSE
oc := Region.MeetRect(ndom, oclip.rgn)
END;
cl := Region.Join(cl, Region.Difference(oc, af))
END
END
END;
PolyRegion.JoinRect(covered, ndom)
END;
IF RegionEqRect(dom, cl) THEN
RETURN NIL
ELSIF Region.IsEmpty(cl) THEN
RETURN EmptyClip
ELSIF (oclip # NIL) AND Region.Equal(oclip.rgn, cl) THEN
RETURN oclip
ELSE
RETURN NEW(Clip, rgn := cl)
END
END
END ComputeClip;
<*INLINE*> PROCEDURE RegionEqRect(
READONLY rect: Rect.T;
READONLY rgn: Region.T): BOOLEAN =
BEGIN
RETURN (rgn.p = NIL) AND Rect.Equal(rect, rgn.r)
END RegionEqRect;
PROCEDURE ApplyClip(
v: T;
VAR el: ChildRec;
READONLY dom: Rect.T;
inReshape: BOOLEAN;
READONLY saved: Rect.T;
VAR secure:PolyRegion.T) =
VAR nc: Clip;
BEGIN
WITH ur = el.ur DO
IF ur.dom = NIL THEN
(* set ch's clip to be meet of old and new clip, to
prevent it from painting on windows that we are
going to reshape. *)
IF (el.clip = NIL) OR (ur.clip = EmptyClip)
OR (ur.clip = el.clip) THEN
nc := ur.clip
ELSIF (ur.clip = NIL) OR (el.clip = EmptyClip) THEN
nc := el.clip
ELSE
nc := NEW(Clip, rgn := Region.Meet(el.clip.rgn, ur.clip.rgn))
END;
IF inReshape AND (nc = NIL) AND NOT Rect.Subset(dom, saved) THEN
nc := NEW(Clip, rgn := Region.FromRect(Rect.Meet(dom, saved)))
ELSIF inReshape AND (nc # NIL) AND
NOT Rect.Subset(nc.rgn.r, saved) THEN
nc := NEW(Clip, rgn := Region.MeetRect(saved, nc.rgn))
END;
el.winner := FALSE
ELSIF v.saveBits AND (el.clip = NIL) AND (ur.clip = NIL)
AND NOT Rect.IsEmpty(el.ch.domain) AND
NOT PolyRegion.OverlapRect(secure, el.ch.domain) THEN
el.winner := TRUE;
PolyRegion.JoinRect(secure, dom);
nc := NIL
ELSE
el.winner := FALSE;
nc := EmptyClip;
END;
(* ch.clip := nc *)
IF ur.clip # nc THEN
LOCK el.ch DO
ur.clip := nc;
VBTClass.ClearShortCircuit(el.ch)
END
END
END
END ApplyClip;
PROCEDURE Redisplay3(v: T; VAR a: ARRAY OF ChildRec; inReshape, translation:
BOOLEAN; READONLY saved: Rect.T; READONLY delta: Point.T) =
VAR ch := v.succ(NIL);
covered := PolyRegion.Empty;
secure := PolyRegion.Empty;
affected, br: Region.T; nch := 0;
BEGIN
IF NOT inReshape THEN
affected := PolyRegion.ToRegion(v.affected)
END;
v.affected := PolyRegion.Empty;
(* Compute new regions. Find movers that don't get old domain, and
throttle them; also restrict painting on windows that get more
obscured. *)
WHILE ch # NIL DO
WITH ur = NARROW(ch.upRef, Child), nd = Domain(ch, ur) DO
IF ur.mapped AND (inReshape OR (ur.dom # NIL) OR
Region.OverlapRect(nd, affected))
THEN
WITH el = a[nch] DO
IF translation THEN
IF (ur.clip = NIL) OR (ur.clip = EmptyClip) OR
Point.Equal(delta, Point.Origin) THEN
el.clip := ur.clip
ELSE
el.clip := NEW(Clip, rgn := Region.Add(ur.clip.rgn, delta),
cache := Rect.Add(ur.clip.cache, delta))
END
ELSE
el.clip :=
ComputeClip(affected, covered, nd, v.domain, inReshape,
ur.clip)
END;
IF (ur.dom # NIL) OR (el.clip # ur.clip) OR
(inReshape AND NOT Rect.Subset(nd, saved)) THEN
el.ch := ch;
el.ur := ur;
INC(nch);
ApplyClip(v, el, nd, inReshape, saved, secure)
END
END
END
END;
ch := v.succ(ch)
END;
(* Move the ones that get old domain *)
IF v.saveBits THEN
FOR i := 0 TO nch - 1 DO
WITH el = a[i] DO
IF el.winner THEN
VBTClass.Reshape(el.ch, el.ur.dom.r, saved);
el.ur.dom := NIL
END
END
END
END;
(* Deliver badrects and move the rest of the children *)
FOR i := 0 TO nch - 1 DO
WITH el = a[i] DO
IF NOT el.winner THEN
IF (el.ur.dom = NIL) AND (el.ur.clip # el.clip) THEN
IF el.clip = NIL THEN
IF el.ch.regionControl = NIL THEN
br := Region.Difference(
Region.FromRect(el.ch.domain), el.ur.clip.rgn)
ELSE
br := Region.Difference(el.ch.reg, el.ur.clip.rgn)
ELSE
br := Region.Difference(el.clip.rgn, el.ur.clip.rgn)
END;
LOCK el.ch DO
el.ur.clip := el.clip;
VBTClass.ForceRepaint(el.ch, br, FALSE)
END;
VBTClass.Repaint(el.ch, Region.Empty)
ELSIF el.ur.dom # NIL THEN
LOCK el.ch DO el.ur.clip := el.clip END;
VBTClass.Reshape(el.ch, el.ur.dom.r, Rect.Empty);
el.ur.dom := NIL
END
END
END
END
END Redisplay3;
PROCEDURE GetDomain(ch: VBT.T): Region.T =
<*FATAL Split.NotAChild*>
VAR lastChild := Split.Succ(ch.parent,ch) = NIL;
BEGIN
WITH ur = NARROW(ch.upRef, Child), r = Domain(ch, ur) DO
IF ur.shapeChanged OR (ur.dom # NIL) AND NOT ur.dom.checked THEN
WITH
s = VBTClass.GetShapes(ch, ur.shapeChanged),
hor = s[Axis.T.Hor], ver = s[Axis.T.Ver]
DO
IF ur.shapeChanged AND NOT lastChild THEN
IF ur.regionControl = NIL THEN
RETURN Rect.FromCorner(Rect.NorthWest(r.r), hor.pref, ver.pref)
ELSE
RETURN ur.regionControl.apply(ch,
Rect.FromCorner(Rect.NorthWest(r.r), hor.pref, ver.pref))
ELSE
WITH hsize= Rect.HorSize(r.r), vsize = Rect.VerSize(r.r),
width = MIN(hor.hi-1, MAX(hor.lo, hsize)),
height = MIN(ver.hi-1, MAX(ver.lo, vsize))
DO
IF (width = hsize) AND (height = vsize) OR lastChild THEN
IF ur.dom # NIL THEN ur.dom.checked := TRUE END;
RETURN r
END;
IF ur.regionControl = NIL THEN
RETURN Rect.FromCorner(Rect.NorthWest(r.r), hor.pref, ver.pref)
ELSE
RETURN ur.regionControl.apply(ch,
Rect.FromCorner(Rect.NorthWest(r.r), hor.pref, ver.pref))
END
END
END
ELSE
RETURN r
END
END
END GetDomain;
<*INLINE*> PROCEDURE Domain(ch: VBT.T; ur: Child): Region.T =
(* ur = ch.upRef. LL = VBT.mu*)
VAR rg: Region.T; r: Rect.T;
BEGIN
IF ur.dom = NIL THEN r := ch.domain ELSE r := ur.dom.r END;
IF ur.regionControl = NIL THEN RETURN r END;
IF NOT ur.checked THEN
rg := ur.regionControl.apply(ch, r);
ur.translation :=
Region.Equal(rg,
Region.Move(ur.reg,
Point.Sub(Rect.NorthWest(rg.r), Rect.NorthWest(ur.reg.r))));
ur.reg := rg
END;
RETURN ur.reg
END Domain;
<*INLINE*> PROCEDURE Congruent(READONLY r1, r2: Rect.T): BOOLEAN =
BEGIN
RETURN
Rect.HorSize(r1) = Rect.HorSize(r2) AND
Rect.VerSize(r1) = Rect.VerSize(r2)
END Congruent;
PROCEDURE SetReshapeControl(
ch: VBT.T;
rc: ReshapeControl) =
BEGIN
WITH ur = NARROW(ch.upRef, Child) DO
ur.reshapeControl := rc
END
END SetReshapeControl;
BEGIN
END ZShape.