XTkBiScrollerFrameImpl.mesa
Copyright Ó 1990, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 22, 1990 5:38:56 pm PDT
Christian Jacobi, February 18, 1993 4:42 pm PST
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: <<ENTRY>> PROC [bsfd: BSFData, id: ScrollProcRegistration] = {
<<bsfd.registeredList ¬ CONS[id, bsfd.registeredList]>>
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.