XTkXBiScrollerImpl.mesa
Copyright Ó 1992, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 9, 1992 6:45 pm PDT
Christian Jacobi, September 17, 1993 10:32 am PDT
DIRECTORY
Real,
Xl,
XTk,
XTkBiScrollerFrame,
XTkFriends,
XTkXBiScroller,
XTkXScroller;
XTkXBiScrollerImpl:
CEDAR
MONITOR
IMPORTS Real, Xl, XTkXScroller, XTkBiScrollerFrame, XTk, XTkFriends
EXPORTS XTkXBiScroller =
BEGIN OPEN XTkXBiScroller;
stateChanged: PUBLIC ATOM ¬ $XBiScrollerState;
xBiScrollerClass:
PUBLIC XTk.Class ~ CreateXBiScrollerClass[];
CreateXBiScrollerClass:
PROC []
RETURNS [XTk.Class] = {
class: XTk.ImplementorClass ~ XTkFriends.CreateClass[[super: XTkBiScrollerFrame.biScrollerFrameClass, key: $xBiScroller, initInstPart: XBiScrollerInitInstPart, wDataNum: 1]];
RETURN [class];
};
CreateXBiScroller:
PUBLIC
PROC [widgetSpec: XTk.WidgetSpec ¬ [], child: XTk.Widget ¬
NIL, insideSize: Xl.Size ¬ [XTk.dontUse, XTk.dontUse], vsbar, hsbar:
BOOL]
RETURNS [XBiScroller] = {
widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, xBiScrollerClass];
BEGIN
xBiScroller: XTk.Widget ¬ XTkBiScrollerFrame.CreateBiScrollerFrame[widgetSpec, NIL, insideSize, vsbar, hsbar];
xbsd: XBSData ¬ GetXBiScrollerData[xBiScroller];
IF child#NIL THEN ReplaceChild[xBiScroller, child, TRUE];
XTkBiScrollerFrame.SetScrollProc[xBiScroller, Scroll];
XTkXScroller.SetBindXY[xbsd.dummyChild, NOT hsbar, NOT vsbar];
RETURN [xBiScroller];
END;
};
IsXBiScroller:
PUBLIC
PROC [widget: XTk.Widget]
RETURNS [
BOOL] = {
RETURN [XTk.HasClass[widget, xBiScrollerClass]]
};
XBSData: TYPE = REF XBSDataRec;
XBSDataRec:
TYPE =
RECORD [
dummyChild: XTk.Widget ¬ NIL, --direct child of biscroller, parent of real child
pos: Xl.Point ¬ [0, 0],
filterPair: REF FilterPair ¬ NIL
];
GetXBiScrollerData:
PROC [widget: XTk.Widget]
RETURNS [XBSData] =
INLINE {
RETURN [ NARROW[XTkFriends.InstPart[widget, xBiScrollerClass]] ];
};
XBiScrollerInitInstPart: XTk.InitInstancePartProc = {
xbsd: XBSData ~ NEW[XBSDataRec ¬ []];
XTkFriends.AssignInstPart[widget, xBiScrollerClass, xbsd];
xbsd.dummyChild ¬ XTkXScroller.CreateXScroller[];
XTkBiScrollerFrame.ReplaceChild[widget, xbsd.dummyChild];
XTk.RegisterNotifier[xbsd.dummyChild, XTk.postConfigureLRKey, CheckChildState, widget];
XTk.RegisterNotifier[xbsd.dummyChild, XTk.postWindowCreationLRKey, CheckChildState, widget];
};
GetInnerSize:
PROC [w: XTk.Widget]
RETURNS [sz: Xl.Size ¬ [200, 200]] = {
IF w#
NIL
THEN {
sz.width ¬ MIN[MAX[w.actual.size.width, 1], 10000];
sz.height ¬ MIN[MAX[w.actual.size.height, 1], 10000];
};
};
GetOuterSize:
PROC [w: XTk.Widget]
RETURNS [sz: Xl.Size ¬ [200, 200]] = {
IF w#
NIL
THEN {
b: INT ¬ MIN[MAX[w.actual.borderWidth, 0], 500];
sz ¬ GetInnerSize[w];
sz.width ¬ sz.width + 2*b;
sz.height ¬ sz.height + 2*b;
};
};
Scroll: XTkBiScrollerFrame.ScrollProc = {
xBiScroller: XBiScroller ~ biScrollerFrame; <<super>>
doit: BOOL ¬ FALSE;
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
dummyChild: XTk.Widget ¬ xbsd.dummyChild;
realChild: XTk.Widget ¬ XTkXScroller.Child[dummyChild];
docsz: Xl.Size ¬ GetOuterSize[realChild];
winsz: Xl.Size ¬ GetInnerSize[dummyChild];
p: Xl.Point ¬ EntryGetState[xbsd];
SELECT hAction
FROM
thumb => {
p.x ¬ - Real.Round[x*docsz.width];
doit ¬ TRUE;
};
forward => {
p.x ¬ p.x - Real.Round[x*winsz.width];
doit ¬ TRUE;
};
backward => {
p.x ¬ p.x + Real.Round[x*winsz.width];
doit ¬ TRUE;
};
ENDCASE => {};
SELECT vAction
FROM
thumb => {
p.y ¬ - Real.Round[y*docsz.height];
doit ¬ TRUE;
};
forward => {
p.y ¬ p.y - Real.Round[y*winsz.height];
doit ¬ TRUE;
};
backward => {
p.y ¬ p.y + Real.Round[y*winsz.height];
doit ¬ TRUE;
};
ENDCASE => {};
IF doit THEN PublicSetState[xBiScroller, p, event];
};
FilterPair:
TYPE =
RECORD [
filterProc: FilterProc ¬ NIL,
filterData: REF ¬ NIL
SetFilterProc:
PUBLIC
PROC [xBiScroller: XBiScroller, filterProc: FilterProc, filterData:
REF ¬
NIL] = {
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
pair: REF FilterPair ¬ NIL;
IF filterProc#NIL THEN pair ¬ NEW[FilterPair ¬ [filterProc, filterData]];
xbsd.filterPair ¬ pair
};
Child:
PUBLIC
PROC [xBiScroller: XTk.Widget]
RETURNS [XTk.Widget ¬
NIL] = {
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
RETURN [XTkXScroller.Child[xbsd.dummyChild]];
};
ReplaceChild:
PUBLIC
PROC [xBiScroller: XBiScroller, child: XTk.Widget, delayed:
BOOL ¬
FALSE, preventDestructionOfOldChild:
BOOL ¬
FALSE] = {
xbsd: XBSData ¬ GetXBiScrollerData[xBiScroller];
<<down, the picture>>
XTkXScroller.ReplaceChild[xbsd.dummyChild, child, delayed, preventDestructionOfOldChild];
};
SizeSubtract:
PROC [szVal:
INT, sub:
INT]
RETURNS [
INT] = {
IF szVal>0 THEN szVal ¬ MAX[szVal-sub, 1];
RETURN [szVal]
};
PublicSetState:
PUBLIC
PROC [xBiScroller: XBiScroller, p: Xl.Point, event: XTk.Event ¬
NIL] = {
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
pair: REF FilterPair ¬ xbsd.filterPair;
IF pair=
NIL
THEN <<self>>DirectSetState[xBiScroller, p, event]
ELSE pair.filterProc[xBiScroller, p, pair.filterData, event]
};
CheckChildState: XTk.WidgetNotifyProc = {
xBiScroller: XTk.Widget ~ NARROW[registerData];
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
state: XTkBiScrollerFrame.State2;
f: REAL;
docSize: Xl.Size ¬ GetOuterSize[XTkXScroller.Child[xbsd.dummyChild]];
winSize: Xl.Size ¬ GetInnerSize[xbsd.dummyChild];
p: Xl.Point ¬ EntryGetState[xbsd];
state.v.start ¬ (f ¬ MAX[-p.y, 0])/docSize.height;
state.h.start ¬ (f ¬ MAX[-p.x, 0])/docSize.width;
state.v.next ¬ state.v.start + (f ¬ winSize.height)/docSize.height;
state.h.next ¬ state.h.start + (f ¬ winSize.width)/docSize.width;
<<super, the scrollbars>>XTkBiScrollerFrame.ParentalSetState[xBiScroller, state, event];
};
DirectSetState:
PUBLIC
PROC [xBiScroller: XBiScroller, p: Xl.Point, event: XTk.Event ¬
NIL] = {
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
rootTQ: Xl.TQ ¬ xBiScroller.rootTQ;
action:
PROC [] = {
EntrySetState[xbsd, p];
<<down, the picture>>XTkXScroller.SetOffset[xbsd.dummyChild, p];
XTkFriends.CallNotifiers[xBiScroller, stateChanged, xbsd, event];
};
IF rootTQ=
NIL
OR xBiScroller.state>=screened
THEN action[]
ELSE Xl.CallWithLock[rootTQ, action];
};
GetState:
PUBLIC
PROC [xBiScroller: XBiScroller]
RETURNS [p: Xl.Point] = {
xbsd: XBSData ~ GetXBiScrollerData[xBiScroller];
RETURN [EntryGetState[xbsd]];
};
EntrySetState:
ENTRY
PROC [xbsd: XBSData, p: Xl.Point] =
INLINE {
xbsd.pos ¬ p
};
EntryGetState:
ENTRY
PROC [xbsd: XBSData]
RETURNS [p: Xl.Point] =
INLINE {
RETURN [xbsd.pos]
};
END.