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.state<dead THEN { 
IF proc[self, c, data].stop THEN {stop ¬ TRUE; RETURN};
};
};

ConfigureLR: XTk.ConfigureProc = {
SizingLR: PROC [widget: XTk.Widget, reConsiderChildren: BOOL] = {
xsd: XSData ~ GetXScrollerData[widget];
child: XTk.Widget ~ xsd.child;
IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE];
IF child#NIL THEN {
g: Xl.Geometry;
IF child.state#realized AND ~reConsiderChildren THEN RETURN;
IF child.s.mapping=mapped THEN { 
proposed: Xl.Geometry ¬ child.actual;
ms: XTk.GeometryRequest ¬ allbutwh;
IF xsd.bindx THEN {
proposed.size.width ¬ geometry.size.width;
ms[w] ¬ TRUE;
};
IF xsd.bindy THEN {
proposed.size.height ¬ geometry.size.width;
ms[h] ¬ TRUE;
};
g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: proposed, maySkip: ms];
g.pos ¬ EntryGetPos[xsd];
IF g.borderWidth<0 THEN g.borderWidth ¬ 0;
IF xsd.bindx THEN {
g.size.width ¬ widget.actual.size.width;
IF g.size.width>0 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<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF createW THEN {
IF widget.attributes.backgroundPixel=Xl.illegalPixel THEN 
widget.attributes.backgroundPixel ¬ widget.screenDepth.screen.whitePixel
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping];
IF existW OR createW THEN {
doChildren: BOOL ¬ reConsiderChildren OR createW;
SizingLR[widget, doChildren];
};
};

ReplaceChild: PUBLIC PROC [xScroller: XTk.Widget, child: XTk.Widget, delayed: BOOL ¬ FALSE, preventDestructionOfOldChild: BOOL ¬ FALSE] = {
action: PROC [] = {
xsd: XSData ~ GetXScrollerData[xScroller];
oldChild: XTk.Widget ~ xsd.child;
IF oldChild=child THEN RETURN;
IF oldChild#NIL THEN {
IF oldChild.parent#xScroller THEN ERROR;
IF oldChild.state<screened THEN 
XTkFriends.ConfigureLR[oldChild, [], unconfigured, TRUE];
IF preventDestructionOfOldChild 
THEN XTkFriends.ForgetScreenLR[oldChild]
ELSE XTkFriends.OrphanizeLR[oldChild, normal]
};
IF child#NIL THEN {
SELECT child.parent FROM
NIL, xScroller => 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.


    ¾  
XTkXScrollerImpl.mesa
Copyright س 1992 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, June 9, 1992 6:45 pm PDT
Christian Jacobi, June 12, 1992 1:17 pm PDT

 ‌تٍ  –(cedarcode) style•NewlineDelimiter
™ code™Kڑœ
دeœ1™<K™5K™+K™ —ڑدk	œک
KکKکKکKکKک —ڑدnœ‍œ‍œک Kڑ‍œکKڑ‍œک—Kڑ‍œ‍œکKک Kک Kڑœ!‍œ‍œ‍œ‍œ‍œکAKک%Kک ڑœ‍œک/ڑں	œ‍œ‍œ ک:ڑœکKک,KکKک%Kڑœ6ک6KکKک!Kک5Kڑœک—Kڑœک——Kک Kڑœ‍œ‍œکڑœ‍œ‍œکKڑœ‍œکKڑœ‍œ‍œکKکKکKک —ڑ
ںœ‍œ‍œ‍œ‍œکJڑ‍œکJڑ‍œکJڑ‍œ‍œ‍œک(—ڑ‍œکJڑ‍œکJڑ‍œ‍œ‍œک(—Jڑ‍œ‍œ‍œ‍œک!KکKڑ‍œ‍œکKکKک —ڑںœ‍œ‍œ‍œک?Kڑ‍œ
کKکKک —ڑںœ‍œ‍œ7‍œ‍œ‍œکژKک9Kڑ‍œ‍œ‍œ ‍œک7Kک"Kک—Kک ڑ
ںœ‍œ‍œ‍œ‍œک@Kڑ‍œ'ک-Kک—Kک ڑںœ‍œ‍œ‍œکGKڑ‍œ‍œ0ک?Kک—Kک ڑںœک3Kڑœ‍œک"Kک7Kک'Kڑ‍œ!‍œ#کJKکKک —ڑ
ںœ‍œ‍œ‍œ‍œکIKک*Kڑ‍œکKکKک —ڑں	œ‍œ‍œ‍œکGKک*KکKکKک —ڑں	œ‍œ‍œ(ک>Kک*Kڑœ‍œک ڑ‍œ‍œکKکKڑ‍œ‍œ(کHKک—KکKک —ڑں	œ‍œ‍œ&‍œکEKک*Kڑœ‍œ‍œک/ڑ‍œ‍œکKک%KکKڑ‍œ‍œ(کHKک—KکKک —ڑںœک+KکKک$KکKک —ڑںœ'ک@Kک%Kکڑ‍œ‍œ‍œ‍œک!Kڑ‍œ‍œ	‍œ‍œک7Kک—Kک—Kک ڑںœک"ڑںœ‍œ*‍œکAKک'KکKڑ‍œ‍œ7‍œکXڑ‍œ‍œ‍œکKکKڑ‍œ‍œ‍œ‍œک<ڑ‍œ‍œک!Kک%Kک#ڑ‍œ‍œکKک*Kڑœ‍œکKک—ڑ‍œ‍œکKک+Kڑœ‍œکKک—KکOKکKڑ‍œ‍œک*ڑ‍œ‍œکKک(Kڑ‍œ‍œ.کDKک—ڑ‍œ‍œکKک*Kڑ‍œ‍œ0کGKک—Kڑ‍œ‍œک)Kڑ‍œ‍œک+Kک—KڑœFکFJک—Kڑœک—Kڑœ‍œ%ک1Kڑœ	‍œ‍œ	ک1ڑ‍œ	‍œکڑ‍œ3‍œک:KڑœHکH—Kک—Kڑœ@ک@ڑ‍œ‍œ	‍œکKڑœ‍œ‍œ	ک1KکKک—Kڑœک—Kک ڑںœ‍œ‍œ5‍œ‍œ ‍œ‍œک‹ڑœ‍œکKک*Kک!Kڑ‍œ‍œ‍œکڑ‍œ
‍œ‍œکKڑ‍œ‍œ‍œک(ڑ‍œ‍œک Kڑœ3‍œک9—ڑ‍œک Kڑ‍œ$ک(Kڑ‍œ)ک-—Kک—ڑ‍œ‍œ‍œکڑ‍œ‍کKڑ‍œIکLKڑ‍œ‍œک—Kڑ‍œ‍œک9Kک—KکKکڑ‍œ‍œک"Kڑ‍œ
‍œ-ک=Kک—Kک—ڑ‍œ‍œ‍œک5Kڑ‍œ
کKڑ‍œ+ک/—KکKک —ڑںœک*Kک'کKکEKکKک*Kک—ڑ‍œ‍œ‍œکKڑ‍œ‍œ‍œ‍œک?Kڑ‍œ‍œ‍œ‍œک@ڑ‍œ‍œ‍œک$Kک#KکKڑœ‍œکKکJKڑ‍œ‍œک8ڑ‍œ‍œ‍œک,KکC—ڑ‍œ‍œ‍œک-KکE—Kک—Kک—Kک6Kڑ‍œ‍œک:Kڑ‍œ‍œک;Kڑ‍œ‍œک=KکKک —Kڑ‍œکKک Kک — …—    j  $  