MODULE************************* Check Mark ***************************; IMPORT Axis, FeedbackVBT, Filter, HVSplit, MultiClass, Pixmap, PixmapVBT, Point, Rect, Region, Shadow, ShadowPaint, Split, VBT, VBTKitResources; REVEAL T = Public BRANDED OBJECT marginVBT: VBT.T OVERRIDES init := Init END; TYPE MC = MultiClass.T OBJECT OVERRIDES replace := Replace; succ := Succ; pred := Succ; END; PROCEDURE MarginFeedbackVBT Init (v: T; ch, marginVBT: VBT.T): T = VAR hv := HVSplit.New(Axis.T.Hor, FALSE, -1, FALSE); BEGIN EVAL FeedbackVBT.T.init(v, hv); MultiClass.Be(v, NEW(MC)); Split.AddChild(hv, marginVBT); IF ch # NIL THEN Split.AddChild(hv, ch); MultiClass.BeChild(v, ch); END; v.marginVBT := marginVBT; FeedbackVBT.Normal(v); RETURN v END Init; TYPE Flavor = {Check, Box, Bullet}; OnOff = BOOLEAN; NE = {Normal, Excited}; VAR mu := NEW(MUTEX); inited := ARRAY Flavor OF BOOLEAN {FALSE, FALSE, FALSE}; pixmaps : ARRAY Flavor, OnOff, NE OF Pixmap.T; styles : ARRAY Flavor, OnOff, NE OF Shadow.Style; textures : ARRAY Flavor, OnOff, NE OF Pixmap.T; TYPE TWithPixmaps = T OBJECT flavor: Flavor; OVERRIDES normal := Normal; excited := Excited; END; PROCEDURENewWithPixmaps (ch : VBT.T; blotVBT: BlotVBT; flavor : Flavor ): T = BEGIN RETURN NEW(TWithPixmaps, flavor := flavor).init(ch, blotVBT) END NewWithPixmaps; PROCEDUREShow (v: TWithPixmaps; normalExcited: NE) = VAR onOff := FeedbackVBT.GetState(v); BEGIN LOCK mu DO BlotVBTPut( v.marginVBT, pixmaps[v.flavor, onOff, normalExcited], styles[v.flavor, onOff, normalExcited], textures[v.flavor, onOff, normalExcited]) END END Show; PROCEDURENormal (v: T) = BEGIN Show(v, NE.Normal); END Normal; PROCEDUREExcited (v: T) = BEGIN Show(v, NE.Excited); END Excited;
PROCEDURE************************* Box ***************************NewCheck (ch: VBT.T; shadow: Shadow.T := NIL): T = BEGIN GetCheckResources(); RETURN NewWithPixmaps(ch, NewBlotVBT(shadow), Flavor.Check); END NewCheck; PROCEDUREGetCheckResources () = BEGIN LOCK mu DO IF inited [Flavor.Check] THEN RETURN END; pixmaps [Flavor.Check, FALSE, NE.Normal] := VBTKitResources.GetPixmap ("checkMarkOff"); pixmaps [Flavor.Check, TRUE, NE.Normal] := VBTKitResources.GetPixmap ("checkMarkOn"); pixmaps [Flavor.Check, FALSE, NE.Excited] := VBTKitResources.GetPixmap ("checkMarkOffExcited"); pixmaps [Flavor.Check, TRUE, NE.Excited] := VBTKitResources.GetPixmap ("checkMarkOnExcited"); inited [Flavor.Check] := TRUE; END END GetCheckResources;
PROCEDURE************************* Radio ***************************NewBox (ch: VBT.T; shadow: Shadow.T := NIL): T = BEGIN GetBoxResources(); RETURN NewWithPixmaps( ch, NewBlotVBT(shadow, Looks.Square, 0.5), Flavor.Box); END NewBox; PROCEDUREGetBoxResources () = BEGIN LOCK mu DO IF inited[Flavor.Box] THEN RETURN END; pixmaps[Flavor.Box, FALSE, NE.Normal] := VBTKitResources.GetPixmap("checkOff"); styles[Flavor.Box, FALSE, NE.Normal] := Shadow.Style.Raised; textures[Flavor.Box, FALSE, NE.Normal] := Pixmap.Empty; pixmaps[Flavor.Box, TRUE, NE.Normal] := VBTKitResources.GetPixmap("checkOn"); styles[Flavor.Box, TRUE, NE.Normal] := Shadow.Style.Lowered; textures[Flavor.Box, TRUE, NE.Normal] := Pixmap.Solid; pixmaps[Flavor.Box, FALSE, NE.Excited] := VBTKitResources.GetPixmap("checkOffExcited"); styles[Flavor.Box, FALSE, NE.Excited] := Shadow.Style.Raised; textures[Flavor.Box, FALSE, NE.Excited] := Pixmap.Gray; pixmaps[Flavor.Box, TRUE, NE.Excited] := VBTKitResources.GetPixmap("checkOnExcited"); styles[Flavor.Box, TRUE, NE.Excited] := Shadow.Style.Lowered; textures[Flavor.Box, TRUE, NE.Excited] := Pixmap.Gray; inited[Flavor.Box] := TRUE; END END GetBoxResources;
PROCEDURE************************* BlotVBT: ***************************NewBullet (ch: VBT.T; shadow: Shadow.T := NIL): T = BEGIN GetBulletResources (); RETURN NewWithPixmaps ( ch, NewBlotVBT (shadow, Looks.Diamond, 0.25), Flavor.Bullet); END NewBullet; PROCEDUREGetBulletResources () = BEGIN LOCK mu DO IF inited[Flavor.Bullet] THEN RETURN END; pixmaps[Flavor.Bullet, FALSE, NE.Normal] := VBTKitResources.GetPixmap("radioOff"); styles[Flavor.Bullet, FALSE, NE.Normal] := Shadow.Style.Raised; textures[Flavor.Bullet, FALSE, NE.Normal] := Pixmap.Empty; pixmaps[Flavor.Bullet, TRUE, NE.Normal] := VBTKitResources.GetPixmap("radioOn"); styles[Flavor.Bullet, TRUE, NE.Normal] := Shadow.Style.Lowered; textures[Flavor.Bullet, TRUE, NE.Normal] := Pixmap.Solid; pixmaps[Flavor.Bullet, FALSE, NE.Excited] := VBTKitResources.GetPixmap("radioOffExcited"); styles[Flavor.Bullet, FALSE, NE.Excited] := Shadow.Style.Raised; textures[Flavor.Bullet, FALSE, NE.Excited] := Pixmap.Gray; pixmaps[Flavor.Bullet, TRUE, NE.Excited] := VBTKitResources.GetPixmap("radioOnExcited"); styles[Flavor.Bullet, TRUE, NE.Excited] := Shadow.Style.Lowered; textures[Flavor.Bullet, TRUE, NE.Excited] := Pixmap.Gray; inited[Flavor.Bullet] := TRUE; END END GetBulletResources;
When the 2-1/2d look is supported, a BlotVBT displays as a 2-1/2d square or diamond, whose interior color and style (e.g., lowered or raised) can be set dynamically. Otherwise, when the 2-1/2d look is not supported, a pixmap is displayed. The shape of VBT is the shape of the pixmap (even when 2-1/2d is supported), with all stretch removed.
TYPE Looks = {Same, Square, Diamond}; TYPE BlotVBT = PixmapVBT.T BRANDED OBJECT shadow : Shadow.T; looks : Looks; inset : REAL; pm : Pixmap.T; style : Shadow.Style; interior: Pixmap.T OVERRIDES shape := BlotVBTShape; repaint := BlotVBTRepaint; END; PROCEDURE************************* Multi methods: ***************************NewBlotVBT (shadow: Shadow.T := NIL; looks : Looks := Looks.Same; inset : REAL := 0.0 ): BlotVBT = VAR v := NEW(BlotVBT); BEGIN IF shadow = NIL THEN shadow := Shadow.None END; v.shadow := shadow; v.looks := looks; v.inset := inset; v.pm := Pixmap.Empty; v.style := Shadow.Style.Flat; v.interior := Pixmap.Empty; EVAL PixmapVBT.T.init(v, v.pm, op:=v.shadow.bgFg, bg:=v.shadow.bg); RETURN v; END NewBlotVBT; PROCEDUREBlotVBTPut (v : BlotVBT; pm : Pixmap.T; style : Shadow.Style; interior: Pixmap.T ) = BEGIN v.pm := pm; v.style := style; v.interior := interior; PixmapVBT.Put(v, v.pm); VBT.Mark(v); END BlotVBTPut; PROCEDUREBlotVBTShape (v: BlotVBT; ax: Axis.T; n: CARDINAL): VBT.SizeRange = VAR sr := PixmapVBT.T.shape(v, ax, n); BEGIN sr.hi := sr.lo + 1; RETURN sr; END BlotVBTShape; PROCEDUREBlotVBTRepaint (v: BlotVBT; READONLY rgn: Region.T) = BEGIN IF (v.looks = Looks.Same) OR NOT Shadow.Supported(v.shadow, v) THEN PixmapVBT.T.repaint(v, rgn) ELSE BlotVBTRepaint2 (v, rgn) END END BlotVBTRepaint; PROCEDUREBlotVBTRepaint2 (v: BlotVBT; READONLY clip: Region.T) = VAR dom, inner, outer: Rect.T; a: Rect.Partition; BEGIN dom := VBT.Domain(v); WITH dh = ROUND(VBT.MMToPixels(v, v.inset, Axis.T.Hor)), dv = ROUND(VBT.MMToPixels(v, v.inset, Axis.T.Ver)), bounds = Rect.Change(VBT.PixmapDomain(v, v.pm), dh, -dh, dv, -dv), delta = Point.Sub(Rect.Middle(dom), Rect.Middle(bounds)) DO (* Now midpoint(v.pm) + delta = midpoint(dom) *) outer := Rect.Move(bounds, delta) END; Rect.Factor(Rect.Meet(dom, clip.r), outer, a, 0, 0); FOR i := 0 TO 4 DO IF i # 2 THEN VBT.PaintTexture(v, a[i], v.shadow.bg, Pixmap.Solid, Point.Origin); ELSE (* i = 2 *) WITH dh = ROUND(VBT.MMToPixels(v, ABS(v.shadow.size), Axis.T.Hor)), dv = ROUND(VBT.MMToPixels(v, ABS(v.shadow.size), Axis.T.Ver)) DO inner := Rect.Change(outer, dh, -dh, dv, -dv) END; CASE v.looks OF | Looks.Same => <* ASSERT FALSE *> | Looks.Square => ShadowPaint.Border(v, clip, v.shadow, v.style, inner, outer); VBT.PaintTexture(v, Rect.Meet(clip.r, inner), v.shadow.bgFg, v.interior, Point.Origin); | Looks.Diamond => ShadowPaint.Diamond(v, clip, v.shadow, v.style, inner, outer, v.shadow.bgFg, v.interior); END END END END BlotVBTRepaint2;
PROCEDUREReplace (m: MC; ch, new: VBT.T) = <* FATAL Split.NotAChild *> VAR hv := Filter.Child(m.vbt); BEGIN IF ch = NIL THEN Split.AddChild(hv, new) ELSE Split.Replace(hv, ch, new) END END Replace; PROCEDURESucc (m: MC; ch: VBT.T): VBT.T = VAR hv := Filter.Child(m.vbt); BEGIN IF ch = NIL THEN RETURN Split.Nth(hv, 1) ELSE RETURN NIL END END Succ; BEGIN END MarginFeedbackVBT.