DIRECTORY
Xl,
XTk,
XTkContainers USING [ContainerWidget, CreateContainer, SetVaryingSize],
XTkScroller USING [CreateScroller, GetState, InteractiveRegistrations, Scroller, ScrollProc, SetState, State],
XTkScrollableContainers USING [RedrawProc, ScrollableContainerWidget],
XTkWidgets USING [AppendChild, AppendChildren, RemoveChild];

XTkScrollableContainersImpl: CEDAR MONITOR 
IMPORTS Xl, XTk, XTkContainers, XTkScroller, XTkWidgets 
EXPORTS XTkScrollableContainers ~ {

Widget: TYPE = XTk.Widget;
WidgetSpec: TYPE = XTk.WidgetSpec;
ContainerWidget: TYPE = XTkContainers.ContainerWidget;
ScrollableContainerWidget: TYPE = XTkScrollableContainers.ScrollableContainerWidget;

ScrollableContainerData: TYPE ~ REF ScrollableContainerDataRec;
ScrollableContainerDataRec: TYPE ~ RECORD [
main: XTkContainers.ContainerWidget ¬ NIL,
container: XTkContainers.ContainerWidget ¬ NIL,
containerContainer: XTkContainers.ContainerWidget ¬ NIL,
scrollBar: XTkScroller.Scroller ¬ NIL,
height: INT ¬ Xl.dontUse,
currentTop: INT ¬ 0,
granularity: INT ¬ 1,
redrawData: REF,
redrawProc: XTkScrollableContainers.RedrawProc,
hiddenBar: BOOL ¬ FALSE
];
sampleScrollableContainerData: ScrollableContainerData ¬ NEW[ScrollableContainerDataRec];

ScrollableContainer : TYPE = Widget;

Create: PUBLIC PROC [widgetSpec: WidgetSpec ¬ [], height: INT ¬ Xl.dontUse, granularity: INT ¬ Xl.dontUse, redrawProc: XTkScrollableContainers.RedrawProc ¬ NIL, redrawData: REF ¬ NIL] RETURNS [scrollable: ScrollableContainerWidget] ~ {
addScroller: BOOL ¬ TRUE;
data: ScrollableContainerData ¬ NEW[ScrollableContainerDataRec];
data.redrawProc ¬ redrawProc;
data.redrawData ¬ redrawData;
data.granularity ¬ SELECT TRUE FROM
granularity = 0	=> 1,
granularity = Xl.dontUse	=> 1,
granularity < 0	=> ABS[granularity],
ENDCASE => granularity;
data.height ¬ SELECT TRUE FROM
height < widgetSpec.geometry.size.height => widgetSpec.geometry.size.height,
height = Xl.dontUse => widgetSpec.geometry.size.height,
ENDCASE => height;
IF data.height <= widgetSpec.geometry.size.height THEN
addScroller  ¬ FALSE; 
data.container ¬ XTkContainers.CreateContainer[
widgetSpec: [
geometry: [
pos: [0, 0],
size: [widgetSpec.geometry.size.width - 12, data.height]
]
]
];
IF ~addScroller THEN data.hiddenBar ¬ TRUE;
data.containerContainer ¬ XTkContainers.CreateContainer[
widgetSpec: [
geometry: [
pos: [IF addScroller THEN 12 ELSE 0, 0],
size: [widgetSpec.geometry.size.width - 12, widgetSpec.geometry.size.height]
]
]
];
XTkWidgets.AppendChild[data.containerContainer, data.container];
data.container.attributes.bitGravity ¬ northWest;
data.container.attributes.winGravity ¬ northWest;
data.container.attributes.backingStore ¬ always;
data.container.attributes.saveUnder ¬ true;
IF addScroller 
THEN  {
data.scrollBar ¬ XTkScroller.CreateScroller[
widgetSpec: [
geometry: [
pos: [0, 0],
size: [12, widgetSpec.geometry.size.height]]
]];
XTkScroller.InteractiveRegistrations[data.scrollBar, ScrollProc, data];
XTk.PutWidgetProp[data.scrollBar, sampleScrollableContainerData, data];
};
data.main ¬ XTkContainers.CreateContainer[widgetSpec: widgetSpec];
IF addScroller 
THEN 
XTkWidgets.AppendChildren[data.main,LIST[data.scrollBar, data.containerContainer]]
ELSE 
XTkWidgets.AppendChildren[data.main,LIST[data.containerContainer]];
IF addScroller 
THEN
XTkScroller.SetState[data.scrollBar, [0.0, REAL[widgetSpec.geometry.size.height] / data.height]];
scrollable ¬ data.main;
XTkContainers.SetVaryingSize[scrollable];
XTk.PutWidgetProp[data.container, sampleScrollableContainerData, data];
XTk.PutWidgetProp[data.containerContainer, sampleScrollableContainerData, data];
XTk.PutWidgetProp[data.main, sampleScrollableContainerData, data];
XTk.RegisterNotifier[data.container, XTk.postConfigureKey, ReconfigureProc, data];
};

RegisterRedrawProc: PUBLIC PROC [widget: ContainerWidget, redrawProc: XTkScrollableContainers.RedrawProc, redrawData: REF] ~ {
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[widget, sampleScrollableContainerData];
IF d = NIL THEN RETURN;
data ¬ NARROW[d];
data.redrawProc ¬ redrawProc;
data.redrawData ¬ redrawData;
};

ReconfigureProc: XTk.WidgetNotifyProc ~ {
data: ScrollableContainerData ¬ NARROW[registerData];
IF data.redrawProc # NIL THEN
data.redrawProc[data.redrawData];
};

ContainerFromScrollable: PUBLIC PROCEDURE [scrollable: ScrollableContainerWidget] RETURNS [container: ContainerWidget] ~ {
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[scrollable, sampleScrollableContainerData];
IF d = NIL THEN RETURN;
data ¬ NARROW[d];
RETURN[data.container];
};

SetGranularity: PUBLIC PROCEDURE [widget: ContainerWidget, granularity: INT] ~ {
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[widget, sampleScrollableContainerData];
offBy: INT;
IF d = NIL THEN RETURN;
data ¬ NARROW[d];
data.granularity ¬ SELECT TRUE FROM
granularity = 0	=> 1,
granularity = Xl.dontUse	=> 1,
granularity < 0	=> ABS[granularity],
ENDCASE => granularity;
offBy ¬ data.currentTop MOD granularity;
IF data.currentTop - offBy >= 0 THEN
Scroll[widget, -offBy];
};

FixState: PROCEDURE [data: ScrollableContainerData] ~ {
newState: XTkScroller.State;
newState.start ¬ REAL[data.currentTop] / REAL[data.height];
newState.next ¬ newState.start + REAL[data.containerContainer.actual.size.height] / REAL[data.height];
IF newState = [0, 1] AND ~data.hiddenBar THEN {
gContainer: Xl.Geometry ¬ data.container.s.geometry;
gContainer.pos.x ¬ gContainer.pos.x - 15;
data.container.s.geometry ¬ gContainer;
data.hiddenBar ¬ TRUE;
XTkWidgets.RemoveChild[data.main, data.scrollBar];
XTk.NoteAndStartReconfigure[data.container];
XTk.ShallowInternalEnumerateChildren[data.container, ExposeSend];
data.scrollBar ¬ NIL;
IF data.redrawProc # NIL THEN
data.redrawProc[data.redrawData];
}
ELSE IF newState # [0, 1] AND data.hiddenBar THEN {
gContainer: Xl.Geometry ¬ data.container.s.geometry;
gContainer.pos.x ¬ gContainer.pos.x + 15;
data.container.s.geometry ¬ gContainer;
data.hiddenBar ¬ FALSE;
data.scrollBar ¬ XTkScroller.CreateScroller[
widgetSpec: [
geometry: [
pos: [0, 0],
size: [12, data.main.actual.size.height]]
]];
XTkScroller.InteractiveRegistrations[data.scrollBar, ScrollProc, data];
XTk.PutWidgetProp[data.scrollBar, sampleScrollableContainerData, data];
XTkWidgets.AppendChild[data.main, data.scrollBar];
XTk.NoteAndStartReconfigure[data.container];
XTk.ShallowInternalEnumerateChildren[data.container, ExposeSend];
IF data.redrawProc # NIL THEN
data.redrawProc[data.redrawData];
};
IF data.scrollBar # NIL THEN
XTkScroller.SetState[data.scrollBar, newState];
};

ExposeSend: XTk.EachChild ~ {
event: REF Xl.EventRep.expose ¬ NEW[Xl.EventRep.expose];
event.originalCodeByte ¬ ORD[Xl.EventCode[expose]];
event.dispatchDrawable ¬ parent.window.drawable;
event.connection ¬ parent.connection;
event.seq ¬ 0;
event.window ¬ parent.window;
event.pos ¬ [0, 0];
event.size ¬ parent.actual.size;
event.count ¬ 1;
Xl.SendEvent[parent.connection, parent.window, TRUE, [exposure: TRUE], event­];
};

SetHeight: PUBLIC PROCEDURE [widget: ContainerWidget, height: INT] ~ {
g: Xl.Geometry;
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[widget, sampleScrollableContainerData];
IF d = NIL THEN RETURN;
data ¬ NARROW[d];
g ¬ data.container.actual;
height ¬ IF height < data.containerContainer.actual.size.height 
THEN data.containerContainer.actual.size.height 
ELSE height;
g.size.height ¬ height;
data.container.s.geometry.size.height ¬ height;
data.height ¬ height;
FixState[data];
XTk.NoteAndStartReconfigure[data.container];
XTk.StartReconfigureChildren[data.container];
};

ScrollPosition: PUBLIC PROCEDURE [widget: ContainerWidget] RETURNS [position: INT ¬ -1] ~ {
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[widget, sampleScrollableContainerData];
IF d = NIL THEN RETURN;
data ¬ NARROW[d];
position ¬ data.currentTop;
};

ScrollTo: PUBLIC PROCEDURE [widget: ContainerWidget, position: INT ¬ 0] ~ {
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[widget, sampleScrollableContainerData];
IF d = NIL THEN RETURN;
IF position < 0 THEN position ¬ 0;
data ¬ NARROW[d];
DoScrollTo[data, position];
};

DoScrollTo: PROCEDURE [data: ScrollableContainerData, to: INT] ~ {
diff: INT ¬ to - data.currentTop;
mod: INT ¬ diff MOD data.granularity;
diff ¬ diff - (diff MOD data.granularity);
IF ABS[mod] > (data.granularity / 2) 
THEN
diff ¬ diff + (data.granularity * (ABS[mod] / mod));
DoScroll[data, diff];
};

Scroll: PUBLIC PROCEDURE [widget: ContainerWidget, offset: INT ¬ 0] ~ {
data: ScrollableContainerData;
d: REF ANY ¬ XTk.GetWidgetProp[widget, sampleScrollableContainerData];
IF d = NIL THEN RETURN;
data ¬ NARROW[d];
DoScrollTo[data, data.currentTop + offset];
};

DoScroll: PROCEDURE [data: ScrollableContainerData, deltaY: INT] ~ {
g: Xl.Geometry ¬ data.container.actual;
state: XTkScroller.State;
newTop: INT;
IF data.scrollBar = NIL THEN RETURN;
state ¬ XTkScroller.GetState[data.scrollBar];
IF data.currentTop + deltaY < 0 THEN
deltaY ¬ -data.currentTop;
IF data.currentTop + data.containerContainer.actual.size.height + deltaY > data.height THEN
deltaY ¬ (data.height - data.containerContainer.actual.size.height) - data.currentTop;
newTop ¬ data.currentTop + deltaY;
IF newTop = data.currentTop THEN RETURN;
g.pos.y ¬ g.pos.y - deltaY;
data.currentTop ¬ newTop;
XTk.NoteAndStartReconfigure[data.container, g];
FixState[data];
};

ScrollProc: XTkScroller.ScrollProc ~ {
data: ScrollableContainerData ¬ NARROW[clientData];
SELECT action FROM
configure =>  {
FixState[data];
RETURN;
};
none => {RETURN};
backward, forward, thumb => 
WITH event SELECT FROM
br: Xl.ButtonReleaseEvent =>  {
p: Xl.Point;
p ¬ br.pos;
IF (p.y < 0 OR p.y > data.scrollBar.actual.size.height) 
THEN RETURN;
SELECT action FROM
backward => DoScroll[data,  -data.granularity * CARD[p.y / data.granularity]];
forward => DoScroll[data, data.granularity * CARD[p.y / data.granularity]];
thumb => ScrollTo[data.container, CARD[(data.container.actual.size.height * p.y) / data.scrollBar.actual.size.height]];
ENDCASE => ERROR;
};
ENDCASE => {};
ENDCASE => RETURN;
};
}.

XTkScrollableContainersImpl.mesa
Copyright Σ 1992 by Xerox Corporation.  All rights reserved.
Philip James, March 20, 1992 2:51 pm PST
Christian Jacobi, April 1, 1992 4:19 pm PST
  this doesn't work...it moves data.container left, but the scroller won't move.
  this is here to hide the scrollbar, when there is no scrolling to do.
gScroller: Xl.Geometry _ data.scrollBar.actual;
gScroller.pos.x _ gScroller.pos.x - 15;
data.scrollBar.s.geometry _ gScroller;
gScroller: Xl.Geometry _ data.scrollBar.actual;
gScroller.pos.x _ gScroller.pos.x + 15;
data.scrollBar.s.geometry _ gScroller;
PROC [parent: Widget, child: Widget, data: REF] RETURNS [stop: BOOL _ FALSE]
ScrollProc: TYPE = PROC [scroller: Scroller, action: Action, value: REAL, event: XTk.Event, clientData: REF];
Κ
•–
(cedarcode) style•NewlineDelimiter

™š
œ ™ Jšœ
Οe
œ1™<Jš
œ(™(J™+—Icode˜š
Οk	˜	Kš
œ˜Kš
œ˜Kšœžœ4˜GKšœžœ]˜nKšœžœ)˜FKšœžœ,˜<K˜—šΠlnœžœ
žœ
˜+Kšžœ1˜8Kšžœ˜#K˜Kšœžœ˜Kšœžœ˜"Kšœžœ!˜6Kšœžœ5˜TK˜Kšœžœžœ˜?šœžœžœ˜+Kšœ&žœ
˜*Kšœ+žœ
˜/Kšœ4žœ
˜8Kšœ"ž˜&Kšœžœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ
˜Kš
œ/˜/Kšœžœž˜Kš
œ˜—Kšœ9žœ˜YK˜Kšœžœ
˜$K˜šΟnœžœ
žœ'žœžœ@žœžœžœžœ,˜λ
Kšœ
žœžœ
˜Kšœ žœ˜@K˜K˜šœžœ
žœ
ž˜#Kš
œ˜Kš
œ˜Kšœžœ˜$Kšžœ˜—šœžœ
žœ
ž˜Kš
œL˜LKš
œ7˜7Kšžœ˜—šžœ0ž˜6Kšœžœ˜—˜/š
œ
˜
š
œ˜K˜Kš
œ8˜8Kš
œ
˜
—Kš
œ
˜
—Kš
œ˜—Kšžœžœžœ
˜+˜8š
œ
˜
š
œ˜Kšœžœ
žœžœ˜(Kš
œL˜LKš
œ
˜
—Kš
œ
˜
—Kš
œ˜—Kš
œ@˜@K˜1K˜1K˜0K˜+šžœ
˜šžœ˜˜,š
œ
˜
š
œ˜K˜Kš
œ,˜,—Kš
œ˜——Kš
œG˜GKš
œG˜GK˜——K˜Bšžœ
˜šžœ
˜Kšœ$žœ*˜R—šžœ
˜Kšœ$žœ˜C——šžœ
˜š
ž˜Kšœ+žœ2˜a——K˜K˜)K˜GKš
œP˜PKš
œB˜BKš
œR˜RK˜—K˜š œžœ
žœWžœ˜~Kš
œ˜Kšœžœ
žœ<˜FKšžœžœ
žœ
žœ
˜Kšœžœ˜K˜K˜K˜K˜—š œ˜)Kšœ žœ˜5šžœžœ
ž˜K˜!—K˜K˜—š œžœ
ž	œ)žœ!˜zKš
œ˜Kšœžœ
žœ@˜JKšžœžœ
žœ
žœ
˜Kšœžœ˜Kšžœ˜K˜K˜—š œžœ
ž	œ(žœ˜PKš
œ˜Kšœžœ
žœ<˜FKšœžœ
˜Kšžœžœ
žœ
žœ
˜Kšœžœ˜šœžœ
žœ
ž˜#Kš
œ˜Kš
œ˜Kšœžœ˜$Kšžœ˜—Kšœžœ
˜(šžœž˜$K˜—K˜K˜—š œž	œ$˜7K˜Kšœžœžœ˜;Kšœ!žœ/žœ˜fK™PK™Gšžœžœžœ˜/K™/K˜4Kš
œ'™'K˜)K™&K˜'Kšœžœ
˜Kš
œ2˜2Kš
œ,˜,Kš
œA˜AKšœžœ
˜šžœžœ
ž˜K˜!—K˜
—šžœ
žœžœžœ˜3K™/K˜4K™'K˜)K™&K˜'Kšœžœ
˜˜,š
œ
˜
š
œ˜K˜Kš
œ)˜)—Kš
œ˜——Kš
œG˜GKš
œG˜GKš
œ2˜2Kš
œ,˜,Kš
œA˜Ašžœžœ
ž˜K˜!—K˜—šžœžœ
ž˜Kš
œ/˜/—K˜K˜—š 
œ˜Kš
žœ'žœžœžœžœ
™Lšœžœžœ˜8Kšœžœ˜3K˜0K˜%K˜K˜K˜K˜ K˜—Kšœ/žœ
žœ˜OK˜K˜—š 	œžœ
ž	œ#žœ˜FKš
œ˜Kš
œ˜Kšœžœ
žœ<˜FKšžœžœ
žœ
žœ
˜Kšœžœ˜K˜šœ	žœ5˜@Kšžœ,˜0Kšžœ˜—K˜K˜/K˜K˜Kš
œ,˜,Kš
œ-˜-K˜K˜—š
 œžœ
ž	œžœžœ
˜[Kš
œ˜Kšœžœ
žœ<˜FKšžœžœ
žœ
žœ
˜Kšœžœ˜K˜K˜K˜—š œžœ
ž	œ%žœ	˜KKš
œ˜Kšœžœ
žœ<˜FKšžœžœ
žœ
žœ
˜Kšžœžœ˜"Kšœžœ˜Kš
œ˜K˜K˜—š 
œž	œ%žœ˜BKšœžœ˜!Kšœžœžœ˜%Kšœžœ˜*šžœ
žœ˜%š
ž˜Kšœ#žœ˜4——K˜K˜K˜—š œžœ
ž	œ#žœ	˜GKš
œ˜Kšœžœ
žœ<˜FKšžœžœ
žœ
žœ
˜Kšœžœ˜K˜+K˜K˜—š œž	œ)žœ˜DK˜'Kš
œ˜Kšœžœ
˜Kšžœžœ
žœ
žœ
˜$K˜-šžœž˜$K˜—šžœUž˜[K˜V—K˜"Kšžœžœ
žœ
˜(K˜K˜Kš
œ/˜/K˜K˜K˜—š 
œ˜&Kš	œžœžœ-žœ žœ™mKšœ žœ
˜3šžœž˜š
œ˜K˜Kšžœ
˜K˜—Kšœ	žœ˜š
œ˜šžœžœ
ž˜˜Kš
œ˜K˜šžœ
žœ*˜8Kšžœ
žœ
˜—šžœž˜Kšœ0žœ˜NKšœ-žœ˜KKšœ"žœQ˜wKšžœžœ
˜—K˜—Kšžœ˜——Kšžœžœ
˜—K˜—Kš
œ˜——…—'T4υ