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
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.