<<>> <> <> <> <> <<>> DIRECTORY Xl, XTk, XTkBiScrollerFrame, XTkButtons, XTkCollections, XTkFriends, XTkScrollbar; XTkBiScrollerFrameImpl: CEDAR MONITOR IMPORTS Xl, XTkCollections, XTkScrollbar, XTk, XTkButtons, XTkFriends EXPORTS XTkBiScrollerFrame = BEGIN OPEN XTkBiScrollerFrame; BiScrollerFrame: TYPE = XTkBiScrollerFrame.BiScrollerFrame; Action: TYPE = XTkBiScrollerFrame.Action; State2: TYPE = XTkBiScrollerFrame.State2; stateChanged: PUBLIC ATOM ¬ $BiScrollerFrameState; biScrollerFrameClass: PUBLIC XTk.Class ~ CreateClass[]; CreateClass: PROC [] RETURNS [XTk.Class] = { class: XTk.ImplementorClass ~ XTkFriends.CreateClass[[ super: XTkCollections.collectionClass, key: $biScrollerFrame, initInstPart: BiScrollerInitInstPart, preferredSizeLR: BiScrollerPreferredSizeLR, removeChildLR: BiScrollerRemoveChildLR, configureLR: BiScrollerConfigureLR, internalEnumerateChildren: BiScrollerInternalEnumerateChildren, wDataNum: 1 ]]; ccPart: XTkCollections.CollectionClassPart ~ XTkCollections.NewCollectionClassPart[class]; ccPart.addChildLR ¬ BiScrollerAddChildLR; RETURN [class]; }; varyingFlag: XTk.WidgetFlagKey ~ wf6; CreateBiScrollerFrame: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], child: XTk.Widget ¬ NIL, insideSize: Xl.Size ¬ [XTk.dontUse, XTk.dontUse], vsbar, hsbar: BOOL ¬ TRUE] RETURNS [BiScrollerFrame] = { IF insideSize.width>0 THEN { widgetSpec.geometry.size.width ¬ insideSize.width; IF vsbar THEN widgetSpec.geometry.size.width ¬ widgetSpec.geometry.size.width + sbtW; }; IF insideSize.height>0 THEN { widgetSpec.geometry.size.height ¬ insideSize.height; IF hsbar THEN widgetSpec.geometry.size.height ¬ widgetSpec.geometry.size.height + sbtW; }; BEGIN biScrollerFrame: XTk.Widget ¬ XTk.CreateWidget[widgetSpec, biScrollerFrameClass]; bsfd: BSFData ¬ GetBiScrollerData[biScrollerFrame]; AssertScrollBars[biScrollerFrame, bsfd, vsbar, hsbar]; IF child#NIL THEN ReplaceChild[biScrollerFrame, child, TRUE]; XTk.SetWidgetFlag[biScrollerFrame, varyingFlag]; RETURN [biScrollerFrame]; END; }; IsBiScrollerFrame: PUBLIC PROC [widget: XTk.Widget] RETURNS [BOOL] = { RETURN [XTk.HasClass[widget, biScrollerFrameClass]] }; ScrollProcRegistration: TYPE = REF InterActiveRec; InterActiveRec: TYPE = RECORD [ biScrollerFrame: BiScrollerFrame, scrollProc: XTkBiScrollerFrame.ScrollProc, clientData: REF ¬ NIL, tq: Xl.TQ ¬ NIL --NIL for rootTQ ]; VSProc: XTkScrollbar.ScrollProc = { id: ScrollProcRegistration ~ NARROW[clientData]; id.scrollProc[biScrollerFrame: id.biScrollerFrame, vAction: LOOPHOLE[action], hAction: none, y: value, x: -1, event: event, clientData: id.clientData] }; HSProc: XTkScrollbar.ScrollProc = { id: ScrollProcRegistration ~ NARROW[clientData]; id.scrollProc[biScrollerFrame: id.biScrollerFrame, hAction: LOOPHOLE[action], vAction: none, x: value, y: -1, event: event, clientData: id.clientData] }; RegisterInterActiveData: <> PROC [bsfd: BSFData, id: ScrollProcRegistration] = { <<<>>> bsfd.registeredList ¬ LIST[id] }; SetScrollProc: PUBLIC PROC [biScrollerFrame: BiScrollerFrame, scrollProc: XTkBiScrollerFrame.ScrollProc, clientData: REF ¬ NIL, tq: Xl.TQ ¬ NIL] = { bsfd: BSFData ~ GetBiScrollerData[biScrollerFrame]; id: ScrollProcRegistration ~ NEW[InterActiveRec ¬ [scrollProc: scrollProc, clientData: clientData, biScrollerFrame: biScrollerFrame]]; IF bsfd=NIL OR scrollProc=NIL THEN ERROR; id.tq ¬ tq; IF bsfd.sbv#NIL THEN XTkScrollbar.SetScrollProc[bsfd.sbv, VSProc, id, tq]; IF bsfd.sbh#NIL THEN XTkScrollbar.SetScrollProc[bsfd.sbh, HSProc, id, tq]; RegisterInterActiveData[bsfd, id]; }; BSFData: TYPE = REF BSFRec; BSFRec: TYPE = RECORD [ child: XTk.Widget ¬ NIL, --managed by subclassing XTkCollections state: State2 ¬ [[0, 0], [0, 0]], sbv, sbh, reset: XTk.Widget ¬ NIL, --managed internally needSbv, needSbh: BOOL ¬ FALSE, registeredList: LIST OF ScrollProcRegistration ¬ NIL ]; sbW: INT ¬ 10; --width of scroll bar sbbW: INT ¬ 0; --border width of scroll bar sbtW: INT ¬ sbW+2*sbbW; --total width of scroll bar GetBiScrollerData: PROC [widget: XTk.Widget] RETURNS [BSFData] = INLINE { RETURN [ NARROW[XTkFriends.InstPart[widget, biScrollerFrameClass]] ]; }; BiScrollerInternalEnumerateChildren: XTk.InternalEnumerateChildrenProc = { bsfd: BSFData ~ GetBiScrollerData[self]; IF bsfd.sbv#NIL THEN { stop ¬ proc[self, bsfd.sbv, data].stop; IF stop THEN RETURN; }; IF bsfd.sbh#NIL THEN { stop ¬ proc[self, bsfd.sbh, data].stop; IF stop THEN RETURN; }; IF bsfd.reset#NIL THEN { stop ¬ proc[self, bsfd.reset, data].stop; }; }; AssertScrollBars: PROC [widget: XTk.Widget, bsfd: BSFData, vsbar, hsbar: BOOL] = { IF vsbar THEN bsfd.needSbv ¬ TRUE; IF hsbar THEN bsfd.needSbh ¬ TRUE; IF bsfd.needSbh AND bsfd.sbh=NIL THEN { bsfd.sbh ¬ XTkScrollbar.CreateScrollbar[widgetSpec: [], direction: horizontal, state: [0, 0]]; bsfd.sbh.parent ¬ widget; }; IF bsfd.needSbv AND bsfd.sbv=NIL THEN { bsfd.sbv ¬ XTkScrollbar.CreateScrollbar[widgetSpec: [], direction: vertical, state: [0, 0]]; bsfd.sbv.parent ¬ widget; }; IF bsfd.needSbv AND bsfd.needSbh AND bsfd.reset=NIL THEN { bsfd.reset ¬ XTkButtons.CreateButton[widgetSpec: [], hitProc: ResetButtonHit, registerData: bsfd]; bsfd.reset.parent ¬ widget; }; }; BiScrollerInitInstPart: XTk.InitInstancePartProc = { bsfd: BSFData ~ NEW[BSFRec ¬ []]; XTkFriends.AssignInstPart[widget, biScrollerFrameClass, bsfd]; }; ResetButtonHit: XTk.WidgetNotifyProc = { ForwardCallScrollProc[bsfd: NARROW[registerData], hAction: thumb, vAction: thumb, y: 0, x: 0, event: event]; }; Child: PUBLIC PROC [biScrollerFrame: XTk.Widget] RETURNS [XTk.Widget ¬ NIL] = { bsfd: BSFData ~ GetBiScrollerData[biScrollerFrame]; RETURN [bsfd.child]; }; BiScrollerAddChildLR: XTkCollections.AddChildProc = { bsfd: BSFData ~ GetBiScrollerData[collection]; IF bsfd.child#NIL THEN { [] ¬ XTkCollections.RemoveChildInPlaceLR[widget: collection, child: bsfd.child]; XTkFriends.OrphanizeLR[bsfd.child, IF collection.fastAccessAllowed=ok THEN normal ELSE errorConnection]; }; bsfd.child ¬ newChild; IF newChild#NIL THEN { [] ¬ XTkCollections.AddChildInFirstPlaceLR[collection: collection, newChild: newChild, position: NIL]; }; IF reConsiderNow THEN XTkFriends.ReconfigureChildrenLR[collection]; }; BiScrollerRemoveChildLR: XTk.RemoveChildProc = { bsfd: BSFData ~ GetBiScrollerData[widget]; IF child=bsfd.child THEN { bsfd.child ¬ NIL; [] ¬ XTkCollections.RemoveChildInPlaceLR[widget: widget, child: child]; done ¬ TRUE; }; }; ReplaceChild: PUBLIC PROC [biScrollerFrame: XTk.Widget, child: XTk.Widget, delayed: BOOL ¬ FALSE, preventDestructionOfOldChild: BOOL ¬ FALSE] = { action: PROC [] = { bs: XTk.Widget ¬ biScrollerFrame; bsfd: BSFData ¬ GetBiScrollerData[bs]; oldChild: XTk.Widget ¬ bsfd.child; IF oldChild#NIL THEN XTkCollections.RemoveChildLR[collection: bs, child: oldChild, reConsiderNow: FALSE, preventDestruction: preventDestructionOfOldChild]; IF child#NIL THEN XTkCollections.AddChildLR[collection: bs, newChild: child, reConsiderNow: FALSE]; IF biScrollerFrame.state=realized THEN { IF ~delayed THEN XTkFriends.ReconfigureChildrenLR[bs]; }; }; IF biScrollerFrame.rootTQ=NIL THEN action[] ELSE Xl.CallWithLock[biScrollerFrame.rootTQ, action]; }; BiScrollerPreferredSizeLR: XTk.PreferredSizeProc = { preferred ¬ [ size: [widget.s.geometry.size.width, widget.s.geometry.size.height], pos: widget.s.geometry.pos, borderWidth: widget.s.geometry.borderWidth ]; IF preferred.borderWidth<0 THEN preferred.borderWidth ¬ 0; IF preferred.size.width<=0 THEN preferred.size.width ¬ 200; IF preferred.size.height<=0 THEN preferred.size.height ¬ 200; }; SizeSubtract: PROC [szVal: INT, sub: INT] RETURNS [INT] = { IF szVal>0 THEN szVal ¬ MAX[szVal-sub, 1]; RETURN [szVal] }; BiScrollerConfigureLR: XTk.ConfigureProc = { bsfd: BSFData ~ GetBiScrollerData[widget]; child: XTk.Widget ~ bsfd.child; userPos: Xl.Point ¬ [0, 0]; IF widget.actual.borderWidth<0 THEN widget.actual.borderWidth ¬ 0; IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE]; XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping]; IF bsfd.needSbv AND bsfd.sbv#NIL THEN userPos.x ¬ sbtW; IF bsfd.needSbh AND bsfd.sbh#NIL THEN userPos.y ¬ sbtW; IF bsfd.sbv#NIL THEN { mapping: XTk.Mapping ¬ IF bsfd.needSbv THEN mapped ELSE unconfigured; XTkFriends.ConfigureLR[bsfd.sbv, [ pos: [0, userPos.y], size: [sbW, SizeSubtract[geometry.size.height, userPos.y]], borderWidth: sbbW ], mapping]; }; IF bsfd.sbh#NIL THEN { mapping: XTk.Mapping ¬ IF bsfd.needSbh THEN mapped ELSE unconfigured; XTkFriends.ConfigureLR[bsfd.sbh, [ pos: [userPos.x, 0], size: [SizeSubtract[geometry.size.width, userPos.x], sbW], borderWidth: sbbW ], mapping]; }; IF bsfd.reset#NIL THEN { mapping: XTk.Mapping ¬ IF bsfd.needSbh AND bsfd.needSbv THEN mapped ELSE unconfigured; XTkFriends.ConfigureLR[bsfd.reset, [ pos: [0, 0], size: [userPos.x, userPos.y], borderWidth: 0 ], mapping]; }; IF child#NIL THEN { g: Xl.Geometry ¬ [[0, 0], [0, 0], 0]; g.pos ¬ userPos; g.borderWidth ¬ child.s.geometry.borderWidth; IF g.borderWidth<0 THEN g.borderWidth ¬ 0; g.size.width ¬ SizeSubtract[geometry.size.width, userPos.x]; g.size.height ¬ SizeSubtract[geometry.size.height, userPos.y]; IF g.borderWidth>0 THEN { g.size.width ¬ SizeSubtract[g.size.width, 2*g.borderWidth]; g.size.height ¬ SizeSubtract[g.size.height, 2*g.borderWidth]; }; XTkFriends.ConfigureLR[child, g, child.s.mapping, reConsiderChildren]; }; }; PublicSetState: PUBLIC PROC [biScrollerFrame: BiScrollerFrame, hAction, vAction: Action, x, y: REAL, event: XTk.Event ¬ NIL] = { bsfd: BSFData ~ GetBiScrollerData[biScrollerFrame]; ForwardCallScrollProc[bsfd: bsfd, hAction: hAction, vAction: vAction, x: x, y: y, event: event]; }; ForwardData: TYPE = RECORD [ spl: LIST OF ScrollProcRegistration, hAction, vAction: Action, x, y: REAL ]; ForwardCallScrollProc: PROC [bsfd: BSFData, hAction, vAction: Action, x, y: REAL, event: XTk.Event ¬ NIL] = { <<--dispatch actions onto right tq>> FOR spl: LIST OF ScrollProcRegistration ¬ bsfd.registeredList, spl.rest WHILE spl#NIL DO fd: REF ForwardData ~ NEW[ForwardData ¬ [spl: spl, hAction: hAction, vAction: vAction, x: x, y: y]]; tq: Xl.TQ ¬ spl.first.tq; IF tq=NIL THEN {tq ¬ spl.first.biScrollerFrame.rootTQ; IF tq=NIL THEN EXIT}; Xl.Enqueue[tq: tq, proc: ForwardedCallScrollProc, data: fd, event: event]; ENDLOOP }; ForwardedCallScrollProc: Xl.EventProcType = { fd: REF ForwardData ~ NARROW[clientData]; fd.spl.first.scrollProc[biScrollerFrame: fd.spl.first.biScrollerFrame, hAction: fd.hAction, vAction: fd.vAction, x: fd.x, y: fd.y, event: event, clientData: fd.spl.first.clientData]; }; ParentalSetState: PUBLIC PROC [biScrollerFrame: BiScrollerFrame, state: State2, event: XTk.Event ¬ NIL] = { bsfd: BSFData ~ GetBiScrollerData[biScrollerFrame]; EntrySetState[bsfd, state]; IF bsfd.sbh#NIL THEN XTkScrollbar.ParentalSetState[bsfd.sbh, LOOPHOLE[state.h], event]; IF bsfd.sbv#NIL THEN XTkScrollbar.ParentalSetState[bsfd.sbv, LOOPHOLE[state.v], event]; XTkFriends.CallNotifiers[biScrollerFrame, stateChanged, bsfd, event]; }; GetState: PUBLIC PROC [biScrollerFrame: BiScrollerFrame] RETURNS [state: State2] = { bsfd: BSFData ~ GetBiScrollerData[biScrollerFrame]; RETURN [EntryGetState[bsfd]]; }; EntrySetState: ENTRY PROC [bsfd: BSFData, state: State2] = { bsfd.state ¬ state }; EntryGetState: ENTRY PROC [bsfd: BSFData] RETURNS [State2] = { RETURN [bsfd.state] }; END.