MODULE; ViewportVBT
Viewports have gotten kind of hairy, so I'll document them.
A Viewport is a cross of an HVSplit and JoinedVBT with scroll bars and Multis thrown in.
The structure is as follows:
There is a single child provided by the client. It is the Multi child of the Viewport filter.
The child is wrapped in a JoinedVBT so that it can support multiple views (handled by the join's parents).
The viewport consists of multiple views. Each view consists of a single join parent glued together with scroll bars. Logically, each view is a filter for the join parent.
A view's structure is as follows (depending on the scroll bars):
horizontal and vertical scroll bars: (ViewRoot (HVSplitReshape (HSplit VScroller Bar) JoinParent) Bar (MyHSplit Reset Bar HScroller))
horizontal scroll bars (ViewRoot JoinParent Bar (HSplit Reset Bar HScroller))
vertical scroll bars: (ViewRoot (HVSplitReshape (HSplit VScroller Bar) JoinParent))
no scroll bars: (ViewRoot JoinParent)
IMPORT Axis, Filter, FilterClass, FlexVBT, HVBar, HVSplit, JoinedVBT, JoinParent, MultiClass, OffsetVBT, PaintOp, Pixmap, Point, Rect, Region, ScrollerVBT, ScrollerVBTClass, Shadow, ShadowedFeedbackVBT, Split, SwitchVBT, TextVBT, TextureVBT, Thread, VBT, VBTClass, VBTRep, VBTKitEnv; TYPE Views = REF ARRAY OF RECORD offset := Point.Origin; viewRoot : ViewRoot; hscroller : Scroller; vscroller : Scroller; joinParent: VBT.T; offsetVBT : OffsetVBT.TPublic; END;
viewRoot = NIL => unoccupied/removed view
REVEAL T = Public BRANDED "ViewportVBT.T" OBJECT multiChild : VBT.T; views : Views; join : VBT.T; shadow : Shadow.T; step : CARDINAL; adjustableViews: BOOLEAN; (* TRUE => there is an HVBar between views for adjusting their height *) scrollStyle: ScrollStyle; shapeStyle : ShapeStyle; multiView: BOOLEAN; OVERRIDES reshape := ReshapeT; init := Init; END; TYPE MC = MultiClass.Filter BRANDED "ViewportVBT.MC" OBJECT OVERRIDES pred := Succ; succ := Succ; replace := Replace; END; PROCEDUREReturn the size of a scroller and a bar (if any)Init (v : T; ch : VBT.T; axis := Axis.T.Ver; shadow : Shadow.T := NIL; step : CARDINAL := 10; scrollStyle := ScrollStyle.AlaViewport; shapeStyle := ShapeStyle.Related; multiView : BOOLEAN := TRUE ): T = BEGIN IF shadow = NIL THEN shadow := Shadow.None END; MultiClass.Be(v, NEW(MC)); MultiClass.BeChild(v, ch); EVAL HVSplit.T.init(v, axis); IF multiView THEN v.join := JoinedVBT.New(NEW(JoinChild).init(v, ch)); ELSE v.join := NEW(JoinChild).init(v, ch); END; v.views := NEW(Views, 0); v.shadow := shadow; v.step := step; v.multiChild := ch; IF scrollStyle = ScrollStyle.AlaViewport THEN IF axis = Axis.T.Hor THEN scrollStyle := ScrollStyle.HorOnly; ELSE scrollStyle := ScrollStyle.VerOnly; END; END; v.scrollStyle := scrollStyle; v.shapeStyle := shapeStyle; v.adjustableViews := multiView; v.multiView := multiView; (* TRUE; Does not work yet :-( *) EVAL AddView(v, -1); RETURN v END Init; PROCEDUREReshapeT (v: T; READONLY cd: VBT.ReshapeRec) = VAR sr: VBT.SizeRange; scrollerSize := ScrollerSize(v, Axis.Other[HVSplit.AxisOf(v)]); BEGIN IF v.shapeStyle = ShapeStyle.Related AND v.multiView THEN IF HVSplit.AxisOf(v) = Axis.T.Ver THEN WITH n = MAX(0, Rect.HorSize(cd.new) - scrollerSize) DO sr := v.multiChild.shape(Axis.T.Ver, n); VBTClass.Reshape(v.join, Rect.FromSize(n, sr.pref), Rect.Empty); END; ELSE WITH n = MAX(0, Rect.HorSize(cd.new) - scrollerSize) DO sr := v.multiChild.shape(Axis.T.Hor, n); VBTClass.Reshape(v.join, Rect.FromSize(sr.pref, n), Rect.Empty); END; END; END; HVSplit.T.reshape(v, cd); END ReshapeT;
PROCEDURE--------------------- JoinChild ------------------ScrollerSize (v: T; ax: Axis.T; bothAxes := FALSE): INTEGER = VAR sr : VBT.SizeRange; barSize := BarSize(v, ax); BEGIN IF (bothAxes OR (HVSplit.AxisOf(v) # ax)) AND NUMBER(v.views^) > 0 THEN WITH vv = v.views[0] DO (* return the size of the scroller (if any) and bar *) IF ax = Axis.T.Hor AND vv.vscroller # NIL THEN sr := VBTClass.GetShape(vv.vscroller.parent, ax, 0) ELSIF ax = Axis.T.Ver AND vv.hscroller # NIL THEN sr := VBTClass.GetShape(vv.hscroller.parent, ax, 0) ELSE barSize := 0; END; RETURN sr.pref + barSize; END; END; RETURN 0; END ScrollerSize;
TYPE JoinChild = Filter.T OBJECT vp: T; METHODS init (vp: T; ch: VBT.T): JoinChild := InitJoinChild; OVERRIDES shape := ShapeJoinChild; END; PROCEDURE----------------- Scrollers -------------------------InitJoinChild (v: JoinChild; vp: T; ch: VBT.T): JoinChild = BEGIN v.vp := vp; RETURN Filter.T.init(v, ch); END InitJoinChild; PROCEDUREShapeJoinChild (v: JoinChild; ax: Axis.T; n: CARDINAL): VBT.SizeRange = BEGIN IF v.vp # NIL AND v.vp.shapeStyle = ShapeStyle.Related AND ax # HVSplit.AxisOf(v.vp) THEN WITH pref = MAX( 0, Rect.Size(ax, v.vp.domain) - ScrollerSize(v.vp, ax)) DO RETURN VBT.SizeRange{lo := pref, pref := pref, hi := pref + 1} END; ELSE VAR sz: VBT.SizeRange := Filter.T.shape(v, ax, n); BEGIN RETURN sz END; END; END ShapeJoinChild;
PROCEDURE********* Views **********ScrollerGet (v: ScrollerVBT.T): INTEGER = BEGIN IF v # NIL THEN RETURN ScrollerVBT.Get(v) ELSE RETURN 0 END; END ScrollerGet; PROCEDUREScrollerPut (v: ScrollerVBT.T; i: INTEGER) = BEGIN IF v # NIL THEN ScrollerVBT.Put(v, i) END; END ScrollerPut; PROCEDUREScrollerPutBounds (v : ScrollerVBT.T; min, max: INTEGER; thumb : CARDINAL ) = BEGIN IF v # NIL THEN ScrollerVBT.PutBounds(v, min, max, thumb) END; END ScrollerPutBounds; PROCEDUREScrollTo ( v : T; READONLY r : Rect.T; i : INTEGER := 0; <* UNUSED *> force: BOOLEAN := TRUE) = PROCEDURE NewOffset (sb: ScrollerVBT.T; lo, hi: INTEGER): INTEGER = VAR val, min, max, thumb: INTEGER; BEGIN IF sb = NIL THEN RETURN 0 END; min := ScrollerVBT.GetMin(sb); max := ScrollerVBT.GetMax(sb); thumb := ScrollerVBT.GetThumb(sb); (* bias range to lo portion that fits *) lo := MAX(lo, min); hi := MIN(MIN(hi, max - 1), lo + thumb - 1); (* put center of range at center of view *) val := (lo + hi) DIV 2 - thumb DIV 2; val := MIN(MAX(val, min), max - thumb); ScrollerVBT.Put(sb, val); RETURN val; END NewOffset; VAR dom : Rect.T; offset: Point.T; vv := v.views[i]; BEGIN (* IF NOT force THEN FOR j := 0 TO LAST(v.views^) DO WITH vvv = v.views[j] DO IF vvv.viewRoot # NIL THEN WITH vDom = VBT.Domain(vvv.offsetVBT) DO IF Rect.Subset(vvv.joinParent.translate(r), vDom) THEN RETURN END END END; END; END; END; *) dom := VBT.Domain(v.join); offset.h := NewOffset(vv.hscroller, r.west - dom.west, r.east - dom.west); offset.v := NewOffset(vv.vscroller, r.north - dom.north, r.south - dom.north); Move(v, i, offset); END ScrollTo; PROCEDURENormalize (v: T; w: VBT.T; i: INTEGER := 0) = BEGIN IF Rect.IsEmpty(VBT.Domain(w)) THEN EVAL Thread.Fork(NEW(NormalizeCl, v := v, w := w, i := i)) ELSE DoNormalize(v, w, i) END END Normalize; TYPE NormalizeCl = Thread.Closure OBJECT v: T; w: VBT.T; i: INTEGER; OVERRIDES apply := NormalizeBg END; PROCEDURENormalizeBg (arg: NormalizeCl): REFANY RAISES {} = BEGIN LOCK VBT.mu DO VBTRep.Redisplay(); IF NOT Rect.IsEmpty(VBT.Domain(arg.w)) THEN DoNormalize(arg.v, arg.w, arg.i); VBTRep.Redisplay(); END END; RETURN NIL; END NormalizeBg; PROCEDUREDoNormalize (v: T; w: VBT.T; i: INTEGER) = BEGIN ScrollTo(v, VBT.Domain(w), i, FALSE) END DoNormalize;
VAR stretchyChild := NEW(VBT.Leaf);
To make HVSplit.Adjust work, need a child with 0 pref and stretchy
CONST HasHScroller = SET OF ScrollStyle{ScrollStyle.HorAndVer, ScrollStyle.HorOnly, ScrollStyle.Auto}; HasVScroller = SET OF ScrollStyle{ScrollStyle.HorAndVer, ScrollStyle.VerOnly, ScrollStyle.Auto}; PROCEDURE---------------- View HVSplit ----------------AddView (v: T; after: INTEGER := -1; split := TRUE): INTEGER = VAR cntViews := NUMBER(v.views^); reset, flexReset: VBT.T; h1 : HVSplitReshape; h2 : HVSplit.T; v1, v2 : VBT.T; iNew : INTEGER; vscroll := v.scrollStyle IN HasVScroller; hscroll := v.scrollStyle IN HasHScroller; BEGIN <* ASSERT(after >= -1 AND after < cntViews) *> iNew := 0; WHILE iNew < cntViews AND v.views[iNew].viewRoot # NIL DO INC(iNew); END; IF NOT v.multiView AND iNew >= 1 THEN RETURN -1 END; IF iNew = cntViews THEN VAR old := v.views; BEGIN v.views := NEW(Views, cntViews + 1); SUBARRAY(v.views^, 0, cntViews) := SUBARRAY(old^, 0, cntViews); END; END; WITH vv = v.views[iNew] DO IF v.multiView THEN vv.joinParent := NEW(MyJoinParent, vp := v, view := iNew).init(v.join); vv.offsetVBT := NEW(MyOffset).init(vv.joinParent, bg:=v.shadow.bg); ELSE vv.offsetVBT := NEW(MySimpleOffset, vp := v, view := iNew).init(v.join, bg:=v.shadow.bg); END; IF vscroll THEN vv.vscroller := NEW(Scroller, vp := v, view := iNew).init( Axis.T.Ver, 0, 0, v.shadow, v.step); (* !!! Jan. 1992 compiler bug: proc call in NEW *) VAR newshapeChild: HSplit; BEGIN IF VBTKitEnv.ScrollbarWest THEN newshapeChild := NewHSplit(vv.vscroller, Axis.T.Ver, vv.vscroller, NewBar(v.shadow)); ELSE newshapeChild := NewHSplit(vv.vscroller, Axis.T.Ver, NewBar(v.shadow),vv.vscroller); END; h1 := NEW(HVSplitReshape, newshapeChild := newshapeChild).init( Axis.T.Hor); END; (* !!! compiler bug *) IF VBTKitEnv.ScrollbarWest THEN Split.AddChild(h1, h1.newshapeChild, vv.offsetVBT); ELSE Split.AddChild(h1, vv.offsetVBT, h1.newshapeChild); END; v1 := h1; ELSE v1 := vv.offsetVBT; END; IF hscroll THEN vv.hscroller := NEW(Scroller, vp := v, view := iNew).init( Axis.T.Hor, 0, 0, v.shadow, v.step); END; IF hscroll AND vscroll THEN reset := NEW(ResetSwitch, vp := v, view := iNew).init( NEW(ShadowedFeedbackVBT.T).init( TextVBT.New("R"), Shadow.None)); WITH a = ScrollerVBTClass.GetAttributes(vv.vscroller) DO flexReset := FlexVBT.FromAxis( reset, Axis.T.Hor, FlexVBT.RigidRange(a.stripeWidth + 2.0 * a.margin)); END; IF VBTKitEnv.ScrollbarWest THEN h2 := NewHSplit(vv.hscroller, Axis.T.Hor, flexReset, NewBar(v.shadow), vv.hscroller); ELSE h2 := NewHSplit(vv.hscroller, Axis.T.Hor, vv.hscroller, NewBar(v.shadow), flexReset); END; v2 := h2; ELSIF hscroll THEN v2 := vv.hscroller; END; vv.viewRoot := NEW(ViewRoot, newshapeChild := v2, vp := v).init(Axis.T.Ver); IF v2 = NIL THEN Split.AddChild(vv.viewRoot, v1) ELSE IF VBTKitEnv.ScrollbarSouth THEN Split.AddChild(vv.viewRoot, v1, NewBar(v.shadow), v2); ELSE Split.AddChild(vv.viewRoot, v2, NewBar(v.shadow), v1); END; END; InsertView(v, vv.viewRoot, after, split); END; RETURN iNew; END AddView; PROCEDUREInsertView (v: T; view: VBT.T; after: INTEGER; split: BOOLEAN) = VAR bar : VBT.T; afterRoot: HVSplit.T; <* FATAL Split.NotAChild *> BEGIN IF after = -1 THEN Split.Insert(v, NIL, stretchyChild); IF v.adjustableViews AND Split.NumChildren(v) > 1 THEN Split.Insert(v, stretchyChild, NEW(BorderedHVBar).init()); END; ELSE afterRoot := v.views[after].viewRoot; IF v.adjustableViews THEN bar := NEW(BorderedHVBar).init(); Split.Insert(v, afterRoot, bar); Split.Insert(v, bar, stretchyChild); ELSE Split.Insert(v, afterRoot, stretchyChild); END; IF split THEN VAR min, max, adj0, adj1, adj2: INTEGER; pred := Split.Pred(v, afterRoot); splitDom := afterRoot.domain; BEGIN IF HVSplit.AxisOf(v) = Axis.T.Ver THEN min := v.domain.north; max := v.domain.south; adj0 := splitDom.north - min; adj1 := ((splitDom.south + splitDom.north) DIV 2) - min; adj2 := splitDom.south - min; ELSE min := v.domain.west; max := v.domain.east; adj0 := splitDom.west - min; adj1 := ((splitDom.east + splitDom.west) DIV 2) - min; adj2 := splitDom.east - min; END; IF pred # NIL THEN HVSplit.Adjust(v, pred, adj0) END; IF v.adjustableViews THEN HVSplit.Adjust(v, bar, adj1); END; HVSplit.Adjust(v, stretchyChild, adj2); END; END; END; Split.Replace(v, stretchyChild, view); END InsertView; PROCEDURERemoveView (v: T; view: INTEGER) = VAR cntViews := NUMBER(v.views^); bar : VBT.T; <* FATAL Split.NotAChild *> BEGIN WITH vv = v.views[view] DO <* ASSERT(view >= 0 AND view < cntViews) *> IF v.adjustableViews THEN bar := Split.Succ(v, vv.viewRoot); IF bar = NIL THEN bar := Split.Pred(v, vv.viewRoot); END; IF bar # NIL THEN Split.Delete(v, bar); VBT.Discard(bar); END; END; Split.Delete(v, vv.viewRoot); JoinParent.Rem(vv.joinParent); VBT.Discard(vv.viewRoot); vv.viewRoot := NIL; vv.hscroller := NIL; vv.vscroller := NIL; vv.joinParent := NIL; vv.offsetVBT := NIL; END; END RemoveView;
TYPE HSplit = HVSplit.T OBJECT scroller: Scroller; axis : Axis.T; OVERRIDES shape := HSplitShape; redisplay := HSplitRedisplay; END; PROCEDURE--------------------------- HVSplit Reshape -------------NewHSplit (scroller : Scroller; axis : Axis.T; ch0, ch1, ch2: VBT.T := NIL): HSplit = VAR hs := NEW(HSplit, scroller := scroller, axis := axis).init(Axis.T.Hor); BEGIN Split.AddChild(hs, ch0, ch1, ch2); RETURN hs; END NewHSplit; PROCEDUREHSplitShape (v: HSplit; axis: Axis.T; n: CARDINAL): VBT.SizeRange = VAR vs := v.scroller; vp := vs.vp; vv := vp.views[vs.view]; BEGIN IF vp.scrollStyle # ScrollStyle.Auto OR axis = v.axis THEN RETURN HVSplit.T.shape(v, axis, n); ELSE IF vv.offsetVBT # NIL AND Rect.Size(v.axis, vp.join.domain) <= Rect.Size(v.axis, vv.offsetVBT.domain) THEN VBT.Mark(v); RETURN VBT.SizeRange{lo := 0, pref := 0, hi := 1}; ELSE RETURN HVSplit.T.shape(v, axis, n); END; END; END HSplitShape; PROCEDUREHSplitRedisplay (v: HSplit) = VAR vs := v.scroller; vp := vs.vp; vv := vp.views[vs.view]; BEGIN IF vp.scrollStyle = ScrollStyle.Auto AND vv.offsetVBT # NIL AND Rect.Size(v.axis, vp.join.domain) <= Rect.Size(v.axis, vv.offsetVBT.domain) THEN ScrollTo(vp, vp.join.domain, vs.view); END; HVSplit.T.redisplay(v); END HSplitRedisplay;
TYPE HVSplitReshape = HVSplit.T OBJECT newshapeChild: VBT.T; OVERRIDES reshape := HVSplitReshapeMethod; newShape := HVSplitNewshapeMethod; END; PROCEDURE------------------- ViewRoot -------------------HVSplitReshapeMethod ( v : HVSplitReshape; READONLY cd: VBT.ReshapeRec ) = BEGIN IF v.newshapeChild # NIL THEN VBT.NewShape(v.newshapeChild); END; HVSplit.T.reshape(v, cd); END HVSplitReshapeMethod; TYPE NewshapeClosure = Thread.Closure OBJECT v: VBT.T; OVERRIDES apply := ForkedNewshapeChild; END; PROCEDUREHVSplitNewshapeMethod (v: HVSplitReshape; ch: VBT.T) = BEGIN IF ch # v.newshapeChild AND v.newshapeChild # NIL THEN EVAL Thread.Fork(NEW(NewshapeClosure, v := v.newshapeChild)); END; HVSplit.T.newShape(v, ch); END HVSplitNewshapeMethod; PROCEDUREForkedNewshapeChild (cl: NewshapeClosure): REFANY = BEGIN LOCK VBT.mu DO VBT.NewShape(cl.v) END; RETURN NIL; END ForkedNewshapeChild;
TYPE ViewRoot = HVSplitReshape OBJECT vp: T; OVERRIDES axisOrder := AxisOrderView; shape := ShapeView; END; PROCEDUREUse the multiChild's shape in the non-axis directionAxisOrderView (v: ViewRoot): Axis.T = BEGIN RETURN v.vp.multiChild.axisOrder() END AxisOrderView;
PROCEDURE-------------------- BorderedHVBar ---------------------ShapeView (v: ViewRoot; ax: Axis.T; n: CARDINAL): VBT.SizeRange = VAR sr : VBT.SizeRange; scrollerSize: CARDINAL; BEGIN IF ax = HVSplit.AxisOf(v) THEN RETURN VBT.DefaultShape; ELSE scrollerSize := ScrollerSize(v.vp, ax); sr := v.vp.multiChild.shape( ax, MAX(0, n - ScrollerSize(v.vp, Axis.Other[ax], TRUE))); IF v.vp.shapeStyle = ShapeStyle.Related THEN RETURN VBT.SizeRange{sr.lo + scrollerSize, sr.pref + scrollerSize, sr.hi + scrollerSize}; ELSE RETURN VBT.SizeRange{0, sr.pref + scrollerSize, MAX(sr.hi + scrollerSize, VBT.DefaultShape.hi)} END; END; END ShapeView;
TYPE BorderedHVBar = HVBar.T OBJECT METHODS init (): BorderedHVBar := BorderedHVBarInit; OVERRIDES repaint := BorderedHVBarRepaint; reshape := BorderedHVBarReshape; END; PROCEDURE********* Bar **********BorderedHVBarInit (v: BorderedHVBar): BorderedHVBar = BEGIN RETURN HVBar.T.init(v) END BorderedHVBarInit; PROCEDUREBorderedHVBarReshape ( v : BorderedHVBar; <*UNUSED*> READONLY cd: VBT.ReshapeRec ) = BEGIN BorderedHVBarRepaint(v, Region.Full); END BorderedHVBarReshape; PROCEDUREBorderedHVBarRepaint ( v: BorderedHVBar; READONLY r: Region.T ) = VAR dh := ROUND(VBT.MMToPixels(v, 0.5, Axis.T.Hor)); dv := ROUND(VBT.MMToPixels(v, 0.5, Axis.T.Ver)); chDom := Rect.Change(v.domain, dh, -dh, dv, -dv); a: Rect.Partition; BEGIN Rect.Factor(Rect.Meet(v.domain, r.r), chDom, a, 0, 0); a[2] := a[4]; VBT.PolyTexture( v, SUBARRAY(a, 0, 4), PaintOp.Fg, Pixmap.Solid); VBT.PaintTexture(v, chDom, PaintOp.BgFg, Pixmap.Gray); END BorderedHVBarRepaint;
TYPE Bar = TextureVBT.T OBJECT OVERRIDES shape := BarShape; END; PROCEDURE********* Callback for scrolllbars, reset button: **********NewBar (shadow: Shadow.T): Bar = BEGIN WITH v = NEW(Bar) DO EVAL TextureVBT.T.init(v, shadow.fg, Pixmap.Solid); RETURN v END END NewBar; PROCEDUREBarSize (v: VBT.T; ax: Axis.T): INTEGER = BEGIN RETURN ROUND(VBT.MMToPixels(v, 0.5, ax)) END BarSize; PROCEDUREBarShape (v: Bar; ax: Axis.T; <* UNUSED *>n: CARDINAL): VBT.SizeRange = BEGIN IF ax = HVSplit.AxisOf(VBT.Parent(v)) THEN WITH lo = BarSize(v, ax) DO RETURN VBT.SizeRange{lo := lo, pref := lo, hi := lo + 1} END ELSE RETURN VBT.DefaultShape END END BarShape;
TYPE ResetSwitch = SwitchVBT.T OBJECT vp : T; view: INTEGER OVERRIDES callback := ResetAction END; PROCEDURE********** OffsetVBT methods **************ResetAction (self: ResetSwitch; <* UNUSED *> READONLY cd: VBT.MouseRec) = BEGIN Move(self.vp, self.view, Point.Origin) END ResetAction; TYPE Scroller = ScrollerVBT.T OBJECT vp : T; view: INTEGER; OVERRIDES mouse := ScrollerMouse; callback := ScrollerAction END; PROCEDURECountViews (v: T): INTEGER = VAR cnt := 0; BEGIN FOR i := 0 TO LAST(v.views^) DO IF v.views[i].viewRoot # NIL THEN INC(cnt) END; END; RETURN cnt; END CountViews; PROCEDUREScrollerMouse (v: Scroller; READONLY cd: VBT.MouseRec) = BEGIN IF VBT.Modifier.Option IN cd.modifiers THEN IF cd.clickType = VBT.ClickType.FirstDown THEN CASE cd.whatChanged OF | VBT.Modifier.MouseL => EVAL AddView(v.vp, v.view); | VBT.Modifier.MouseR => IF CountViews(v.vp) > 1 THEN RemoveView(v.vp, v.view) END; ELSE END; END; ELSE ScrollerVBT.T.mouse(v, cd); END; END ScrollerMouse; PROCEDUREPixelsToMM (v: VBT.T; ax: Axis.T; pix: INTEGER): REAL = BEGIN RETURN FLOAT(pix) / VBT.MMToPixels(v, 1.0, ax) END PixelsToMM; PROCEDUREScrollerAction (self: Scroller; <* UNUSED *> READONLY cd: VBT.MouseRec) = VAR vv := self.vp.views[self.view]; BEGIN Move(self.vp, self.view, Point.T{ScrollerGet(vv.hscroller), ScrollerGet(vv.vscroller)}); END ScrollerAction; PROCEDUREMove (v: T; i: INTEGER; READONLY offset: Point.T) = BEGIN WITH vv = v.views[i] DO vv.offsetVBT.move(PixelsToMM(v, Axis.T.Ver, offset.v), PixelsToMM(v, Axis.T.Hor, offset.h)); vv.offset := offset; ScrollerPut(vv.hscroller, offset.h); ScrollerPut(vv.vscroller, offset.v); END; END Move;
TYPE (* child must be MyJoinParent *) MyOffset = OffsetVBT.T OBJECT OVERRIDES reshape := OffsetReshape; END; MySimpleOffset = OffsetVBT.Simple OBJECT vp: T; view: View; OVERRIDES reshape := SimpleOffsetReshape; END; PROCEDURE********* JoinVBTParent methods: **********OffsetReshape (off: MyOffset; READONLY cd: VBT.ReshapeRec) = BEGIN OffsetVBT.T.reshape(off, cd); EVAL AdjustShape(off.ch); END OffsetReshape; PROCEDURESimpleOffsetReshape (off: MySimpleOffset; READONLY cd: VBT.ReshapeRec) = BEGIN OffsetVBT.Simple.reshape(off, cd); EVAL SimpleAdjustShape(off); END SimpleOffsetReshape;
TYPE MyJoinParent = JoinParent.T OBJECT vp : T; view: INTEGER; OVERRIDES shape := JoinParentShape; reshape := JoinParentReshape; END; PROCEDURE********* Multi methods: **********AdjustDelta (pLo, pHi, cLo, cHi, oldDelta: INTEGER): INTEGER = BEGIN IF pHi - pLo > cHi - cLo THEN RETURN cLo - pLo ELSIF cHi >= pHi + oldDelta THEN RETURN oldDelta ELSE RETURN cHi - pHi END; END AdjustDelta; PROCEDUREAdjustShape (prntP: MyJoinParent): ARRAY Axis.T OF VBT.SizeRange = VAR shapes: ARRAY Axis.T OF VBT.SizeRange; offset: Point.T; pDom : Rect.T; BEGIN IF prntP.parent = NIL THEN RETURN ARRAY Axis.T OF VBT.SizeRange{VBT.DefaultShape, VBT.DefaultShape}; ELSE (* msm 7/26/95: shapes := VBTClass.GetShapes(JoinParent.Child(prntP)); *) shapes := VBTClass.GetShapes(Filter.Child(prntP)); pDom := VBT.Domain(prntP.parent); WITH v = prntP.vp, vv = v.views[prntP.view] DO ScrollerPutBounds( vv.hscroller, 0, shapes[Axis.T.Hor].pref, Rect.HorSize(pDom)); ScrollerPut(vv.hscroller, vv.offset.h); ScrollerPutBounds( vv.vscroller, 0, shapes[Axis.T.Ver].pref, Rect.VerSize(pDom)); ScrollerPut(vv.vscroller, vv.offset.v); offset.h := AdjustDelta(0, pDom.east - pDom.west, 0, shapes[Axis.T.Hor].pref, vv.offset.h); offset.v := AdjustDelta(0, pDom.south - pDom.north, 0, shapes[Axis.T.Ver].pref, vv.offset.v); Move(v, prntP.view, offset); END; RETURN shapes END; END AdjustShape; PROCEDURESimpleAdjustShape (prntP: MySimpleOffset): ARRAY Axis.T OF VBT.SizeRange = VAR shapes: ARRAY Axis.T OF VBT.SizeRange; offset: Point.T; pDom : Rect.T; BEGIN IF prntP.parent = NIL THEN RETURN ARRAY Axis.T OF VBT.SizeRange{VBT.DefaultShape, VBT.DefaultShape}; ELSE shapes := VBTClass.GetShapes(Filter.Child(prntP)); pDom := VBT.Domain(prntP.parent); WITH v = prntP.vp, vv = v.views[prntP.view] DO ScrollerPutBounds( vv.hscroller, 0, shapes[Axis.T.Hor].pref, Rect.HorSize(pDom)); ScrollerPut(vv.hscroller, vv.offset.h); ScrollerPutBounds( vv.vscroller, 0, shapes[Axis.T.Ver].pref, Rect.VerSize(pDom)); ScrollerPut(vv.vscroller, vv.offset.v); offset.h := AdjustDelta(0, pDom.east - pDom.west, 0, shapes[Axis.T.Hor].pref, vv.offset.h); offset.v := AdjustDelta(0, pDom.south - pDom.north, 0, shapes[Axis.T.Ver].pref, vv.offset.v); Move(v, prntP.view, offset); END; RETURN shapes END; END SimpleAdjustShape; PROCEDUREJoinParentShape (prntP: MyJoinParent; axis : Axis.T; <* UNUSED *> n : CARDINAL ): VBT.SizeRange = VAR sr := AdjustShape(prntP)[axis]; BEGIN sr.lo := 0; sr.hi := MAX(sr.pref + 1, VBT.DefaultShape.hi); RETURN sr; END JoinParentShape; PROCEDUREJoinParentReshape (prntP: MyJoinParent; READONLY cd: VBT.ReshapeRec) = BEGIN JoinParent.T.reshape(prntP, cd); EVAL AdjustShape(prntP); END JoinParentReshape;
PROCEDURE********* Global initialization: **********Replace (m: MC; ch: VBT.T; new: VBT.T) = BEGIN WITH v = NARROW(m.vbt, T) DO <*ASSERT(ch = v.multiChild) *> EVAL Filter.Replace(v.multiChild.parent, new); END END Replace; PROCEDURESucc (m: MC; ch: VBT.T): VBT.T = BEGIN WITH v = NARROW(m.vbt, T) DO IF ch = NIL THEN RETURN v.multiChild ELSE RETURN NIL END END END Succ;
BEGIN END ViewportVBT.