<<>> <> <> <> <> <<>> DIRECTORY Xl, XTk, XTkFriends, XTkXScroller; XTkXScrollerImpl: CEDAR MONITOR IMPORTS Xl, XTk, XTkFriends EXPORTS XTkXScroller = BEGIN OPEN XTkXScroller; allbutwh: XTk.GeometryRequest = [TRUE, TRUE, FALSE, FALSE, TRUE]; varyingFlag: XTk.WidgetFlagKey ~ wf6; xScrollerClass: PUBLIC XTk.Class ¬ InitClass[]; InitClass: PROC [] RETURNS [csc: XTk.ImplementorClass] = { csc ¬ XTkFriends.CreateClass[[ key: $xScroller, classNameHint: $XScroller, wDataNum: 1, initInstPart: XScrollerInitInstPart, internalEnumerateChildren: InternalEnumerateChildren, configureLR: ConfigureLR, preferredSizeLR: PreferredSizeLR, pleaseResizeChild: XTkFriends.IgnorePleaseResizeChild ]]; }; XSData: TYPE = REF XSDataRec; XSDataRec: TYPE = RECORD [ child: XTk.Widget ¬ NIL, bindx, bindy: BOOL ¬ FALSE, pos: Xl.Point ¬ [0, 0] ]; EntrySetPos: ENTRY PROC [xsd: XSData, p: Xl.Point] RETURNS [new: BOOL] = { IF xsd.bindx THEN p.x ¬ 0 ELSE p.x ¬ MIN[MAX[p.x, -10000], 10000]; IF xsd.bindy THEN p.y ¬ 0 ELSE p.y ¬ MIN[MAX[p.y, -10000], 10000]; IF xsd.pos=p THEN RETURN [FALSE]; xsd.pos ¬ p; RETURN [TRUE] }; EntryGetPos: ENTRY PROC [xsd: XSData] RETURNS [p: Xl.Point] = { RETURN [xsd.pos] }; CreateXScroller: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], child: XTk.Widget ¬ NIL, bindx, bindy: BOOL] RETURNS [xScroller: XScroller] = { xScroller ¬ XTk.CreateWidget[widgetSpec, xScrollerClass]; IF child#NIL THEN ReplaceChild[xScroller, child, TRUE]; SetBindXY[xScroller, bindx, bindy] }; IsXScroller: PUBLIC PROC [widget: XTk.Widget] RETURNS [BOOL] = { RETURN [XTk.HasClass[widget, xScrollerClass]] }; GetXScrollerData: PROC [widget: XTk.Widget] RETURNS [XSData] = INLINE { RETURN [ NARROW[XTkFriends.InstPart[widget, xScrollerClass]] ]; }; XScrollerInitInstPart: XTk.InitInstancePartProc = { xsd: XSData ~ NEW[XSDataRec ¬ []]; XTkFriends.AssignInstPart[widget, xScrollerClass, xsd]; XTk.SetWidgetFlag[widget, varyingFlag]; IF widget.s.geometry.borderWidth<0 THEN widget.s.geometry.borderWidth ¬ 0; }; Child: PUBLIC PROC [xScroller: XTk.Widget] RETURNS [XTk.Widget ¬ NIL] = { xsd: XSData ~ GetXScrollerData[xScroller]; RETURN [xsd.child]; }; GetOffset: PUBLIC PROC [xScroller: XScroller] RETURNS [p: Xl.Point] = { xsd: XSData ~ GetXScrollerData[xScroller]; p ¬ EntryGetPos[xsd]; }; SetOffset: PUBLIC PROC [xScroller: XScroller, p: Xl.Point] = { xsd: XSData ~ GetXScrollerData[xScroller]; new: BOOL ¬ EntrySetPos[xsd, p]; IF new THEN { XTk.NoteChildChange[xScroller]; IF xScroller.state=realized THEN XTk.StartReconfigureChildren[xScroller] }; }; SetBindXY: PUBLIC PROC [xScroller: XScroller, bindx, bindy: BOOL] = { xsd: XSData ~ GetXScrollerData[xScroller]; new: BOOL ¬ xsd.bindx#bindx OR xsd.bindy#bindy; IF new THEN { xsd.bindx ¬ bindx; xsd.bindy ¬ bindy; XTk.NoteChildChange[xScroller]; IF xScroller.state=realized THEN XTk.StartReconfigureChildren[xScroller] }; }; PleaseResizeChild: XTk.WidgetNChildProc = { XTk.NoteChildChange[widget]; XTk.StartReconfigureChildren[widget] }; InternalEnumerateChildren: XTk.InternalEnumerateChildrenProc = { xsd: XSData ~ GetXScrollerData[self]; c: XTk.Widget ¬ xsd.child; IF c#NIL AND c.state0 THEN g.size.width ¬ g.size.width - 2*g.borderWidth }; IF xsd.bindy THEN { g.size.height ¬ widget.actual.size.height; IF g.size.height>0 THEN g.size.height ¬ g.size.height - 2*g.borderWidth }; IF g.size.width<=0 THEN g.size.width ¬ 1; IF g.size.height<=0 THEN g.size.height ¬ 1; }; XTkFriends.ConfigureLR[child, g, child.s.mapping, reConsiderChildren]; }; }; existW: BOOL ¬ widget.actualMapping XTkFriends.AssignParentAndCheckScreenLR[child, xScroller]; ENDCASE => ERROR; IF child.s.mapping=dontUse THEN child.s.mapping ¬ mapped; }; xsd.child ¬ child; XTk.NoteChildChange[xScroller]; IF xScroller.state=realized THEN { IF ~delayed THEN XTkFriends.ReconfigureChildrenLR[xScroller]; }; }; IF xScroller.rootTQ=NIL OR xScroller.state>=screened THEN action[] ELSE Xl.CallWithLock[xScroller.rootTQ, action]; }; PreferredSizeLR: XTk.PreferredSizeProc = { xsd: XSData ~ GetXScrollerData[widget]; preferred ¬ [ size: [widget.s.geometry.size.width, widget.s.geometry.size.height], pos: widget.s.geometry.pos, borderWidth: widget.s.geometry.borderWidth ]; IF xsd.child#NIL THEN { IF preferred.size.width>0 OR ~xsd.bindx THEN maySkip[w] ¬ TRUE; IF preferred.size.height>0 OR ~xsd.bindy THEN maySkip[h] ¬ TRUE; IF ~maySkip[w] OR ~maySkip[h] THEN { proposed: Xl.Geometry ¬ preferred; proposed.borderWidth ¬ 0; maySkip[x] ¬ maySkip[y] ¬ TRUE; proposed ¬ XTkFriends.PreferredSizeLR[xsd.child, mode, proposed, maySkip]; IF proposed.borderWidth<0 THEN proposed.borderWidth ¬ 0; IF xsd.bindx AND proposed.size.width>0 THEN preferred.size.width ¬ proposed.size.width+ 2*proposed.borderWidth; IF xsd.bindy AND proposed.size.height>0 THEN preferred.size.height ¬ proposed.size.height+ 2*proposed.borderWidth; }; }; preferred.borderWidth ¬ widget.s.geometry.borderWidth; IF preferred.borderWidth<0 THEN preferred.borderWidth ¬ 0; IF preferred.size.width<=0 THEN preferred.size.width ¬ 300; IF preferred.size.height<=0 THEN preferred.size.height ¬ 200; }; END.