XTkScrollbarImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 22, 1990 5:38:56 pm PDT
Christian Jacobi, October 8, 1992 10:04 am PDT
DIRECTORY
Real,
Xl,
XlCursor,
XlPerDepth,
XTk,
XTkFriends,
XTkScrollbar;
XTkScrollbarImpl:
CEDAR
MONITOR
IMPORTS Real, Xl, XlCursor, XlPerDepth, XTk, XTkFriends
EXPORTS XTkScrollbar =
BEGIN OPEN XTkScrollbar;
stateChanged: PUBLIC ATOM ¬ $ScrollbarState;
PerDepthRec:
TYPE =
RECORD [
inertCursor: Xl.Cursor ¬ Xl.nullCursor,
exposeTQ: Xl.TQ ¬ NIL, --share tq, limit parallelism
up, down, left, right, leftRight, upDown: Xl.Cursor ¬ Xl.nullCursor,
grey1, grey2, grey3: Xl.Pixmap,
gc1, gc2, gc3: Xl.GContext
];
perDHandle: XlPerDepth.Handle ¬ XlPerDepth.InstallHandle[InitDepthData];
GetDepthData:
PROC [sd: Xl.ScreenDepth]
RETURNS [dd:
REF PerDepthRec] = {
dd ¬ NARROW[XlPerDepth.GetData[perDHandle, sd]];
};
InitDepthData: XlPerDepth.InitProc = {
dd: REF PerDepthRec ¬ NEW[PerDepthRec];
IF sd#
NIL
AND Xl.Alive[sd.screen.connection]
THEN {
screen: Xl.Screen ¬ sd.screen;
c: Xl.Connection ¬ screen.connection;
rd: Xl.Drawable ~ screen.root.drawable;
stippleSpace1:
REF
ARRAY [0..3]
OF
CARD32 =
NEW[ARRAY [0..3] OF CARD32 ¬ [088888888H, 044444444H, 022222222H, 0]];
stippleSpace2:
REF
ARRAY [0..3]
OF
CARD32 =
NEW[ARRAY [0..3] OF CARD32 ¬ [0AAAAAAAAH, 055555555H, 0AAAAAAAAH, 055555555H]];
stippleSpace3:
REF
ARRAY [0..3]
OF
CARD32 =
NEW[ARRAY [0..3] OF CARD32 ¬ [022222222H, 044444444H, 088888888H, 0]];
gc1: Xl.GContext ¬ dd.gc1 ¬ Xl.MakeGContext[c, rd];
gc2: Xl.GContext ¬ dd.gc2 ¬ Xl.MakeGContext[c, rd];
gc3: Xl.GContext ¬ dd.gc3 ¬ Xl.MakeGContext[c, rd];
dd.exposeTQ ¬ Xl.CreateTQ[];
dd.inertCursor ¬ XlCursor.SharedStandardCursor[c, tcross];
dd.up ¬ XlCursor.SharedStandardCursor[c, sbUpArrow];
dd.down ¬ XlCursor.SharedStandardCursor[c, sbDownArrow];
dd.left ¬ XlCursor.SharedStandardCursor[c, sbLeftArrow];
dd.right ¬ XlCursor.SharedStandardCursor[c, sbRightArrow];
dd.leftRight ¬ XlCursor.SharedStandardCursor[c, sbHDoubleArrow];
dd.upDown ¬ XlCursor.SharedStandardCursor[c, sbVDoubleArrow];
Xl.SetGCGrounds[gc: gc1, foreground: screen.blackPixel, background: screen.whitePixel];
Xl.SetGCGrounds[gc: gc2, foreground: screen.blackPixel, background: screen.whitePixel];
Xl.SetGCGrounds[gc: gc3, foreground: screen.blackPixel, background: screen.whitePixel];
dd.grey1 ¬ Xl.CreatePixmap[c, rd, [4, 4], sd.depth];
dd.grey2 ¬ Xl.CreatePixmap[c, rd, [4, 4], sd.depth];
dd.grey3 ¬ Xl.CreatePixmap[c, rd, [4, 4], sd.depth];
TRUSTED {
Xl.PutImage[c: c, drawable: dd.grey1.drawable, gc: gc1, size: [4, 4], dest: [0, 0], base: LOOPHOLE[stippleSpace1], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1];
Xl.PutImage[c: c, drawable: dd.grey2.drawable, gc: gc2, size: [4, 4], dest: [0, 0], base: LOOPHOLE[stippleSpace2], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1];
Xl.PutImage[c: c, drawable: dd.grey3.drawable, gc: gc3, size: [4, 4], dest: [0, 0], base: LOOPHOLE[stippleSpace3], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1];
};
Xl.SetGCTile[gc: gc1, tile: dd.grey1];
Xl.SetGCTile[gc: gc2, tile: dd.grey2];
Xl.SetGCTile[gc: gc3, tile: dd.grey3];
Xl.SetGCFillStyle[gc: gc1, fillStyle: tiled];
Xl.SetGCFillStyle[gc: gc2, fillStyle: tiled];
Xl.SetGCFillStyle[gc: gc3, fillStyle: tiled];
};
RETURN [dd]
};
------------------------------------------------------
defaultWidth: INT = 12;
eventMask: Xl.SetOfEvent ~ [structureNotify: TRUE, buttonMotion: TRUE, exposure: TRUE, buttonPress: TRUE, buttonRelease: TRUE];
scrollbarClass:
PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[
key: $scrollbar, classNameHint: $Scrollbar, wDataNum: 1,
configureLR: ScrollbarConfigureLR,
initInstPart: ScrollbarInitInstPart,
forgetScreenLR: ScrollbarForgetScreenLR,
eventMask: eventMask,
backgroundKey: $white
]];
CallRegRec:
TYPE =
RECORD [
scrollbar: Scrollbar,
scrollProc: ScrollProc,
clientData: REF ¬ NIL,
tq: Xl.TQ ¬ NIL --NIL for rootTQ
];
CallData:
TYPE =
RECORD [
crrl: LIST OF CallRegRec,
action: XTkScrollbar.Action,
value: REAL
];
ScrollbarData: TYPE = REF ScrollbarRec;
ScrollbarRec:
TYPE =
RECORD [
state: State ¬ [0, 0], --monitored
direction: Direction ¬ vertical,
iOwnButton: BOOL ¬ FALSE,
initiatedAction: Action ¬ none,
initiatedPos: Xl.Point ¬ [0, 0],
leftMouseCursor: Xl.Cursor ¬ Xl.illegalCursor,
middleMouseCursor: Xl.Cursor ¬ Xl.illegalCursor,
rightMouseCursor: Xl.Cursor ¬ Xl.illegalCursor,
inertCursor: Xl.Cursor ¬ Xl.illegalCursor,
gc1: Xl.GContext ¬ NIL,
gc2: Xl.GContext ¬ NIL,
gc3: Xl.GContext ¬ NIL,
reportedLength: INT ¬ 99999, --never zero; initiated with an impossible value.
crrList: LIST OF CallRegRec ¬ NIL
];
GetInstData:
PROC [scrollbar: Scrollbar]
RETURNS [ScrollbarData] =
INLINE {
RETURN [NARROW[XTkFriends.InstPart[scrollbar, scrollbarClass]]];
};
fakeExpose: REF Xl.EventRep.local ~ NEW[Xl.EventRep.local];
ParentalSetState:
PUBLIC
PROC [scrollbar: Scrollbar, state: State, event: XTk.Event ¬
NIL] = {
c: Xl.Connection ~ scrollbar.connection;
sd: ScrollbarData ~ GetInstData[scrollbar];
EntrySetState[sd, state];
XTkFriends.CallNotifiers[scrollbar, stateChanged, sd, event];
IF Xl.Alive[c]
THEN {
dd: REF PerDepthRec ¬ GetDepthData[scrollbar.screenDepth];
tq: Xl.TQ ~ dd.exposeTQ;
IF tq#NIL THEN Xl.Enqueue[tq: tq, proc: EventProc, data: scrollbar, event: fakeExpose];
};
};
PublicSetState:
PUBLIC
PROC [scrollbar: Scrollbar, action: Action, value:
REAL, event: XTk.Event ¬
NIL] = {
sd: ScrollbarData ~ GetInstData[scrollbar];
ForwardCallScrollProcs[sd, action, value, event];
};
GetDirection:
PUBLIC
PROC [scrollbar: Scrollbar]
RETURNS [direction: Direction] = {
sd: ScrollbarData ~ GetInstData[scrollbar];
RETURN [sd.direction]
};
GetState:
PUBLIC
PROC [scrollbar: Scrollbar]
RETURNS [state: State] = {
sd: ScrollbarData ~ GetInstData[scrollbar];
state ¬ EntryGetState[sd];
};
EntrySetState:
ENTRY
PROC [sd: ScrollbarData, state: State] = {
sd.state ¬ state
};
EntryGetState:
ENTRY
PROC [sd: ScrollbarData]
RETURNS [state: State] = {
state ¬ sd.state
};
ScrollbarConfigureLR: XTk.ConfigureProc = {
existW: BOOL ¬ widget.actualMapping<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF createW
THEN {
sd: ScrollbarData ~ GetInstData[widget];
dd: REF PerDepthRec = GetDepthData[widget.screenDepth];
IF sd.gc1=NIL THEN {sd.gc1 ¬ dd.gc1};
IF sd.gc2=NIL THEN {sd.gc2 ¬ dd.gc2};
IF sd.gc3=NIL THEN {sd.gc3 ¬ dd.gc3};
SELECT sd.direction
FROM
vertical => {
sd.leftMouseCursor ¬ dd.up;
sd.middleMouseCursor ¬ dd.upDown;
sd.rightMouseCursor ¬ dd.down;
SELECT
TRUE
FROM
geometry.size.height>0 => sd.reportedLength ¬ geometry.size.height;
widget.actual.size.height>0 => sd.reportedLength ¬ widget.actual.size.height;
ENDCASE => sd.reportedLength ¬ 1;
};
horizontal => {
sd.leftMouseCursor ¬ dd.left;
sd.middleMouseCursor ¬ dd.leftRight;
sd.rightMouseCursor ¬ dd.right;
SELECT
TRUE
FROM
geometry.size.width>0 => sd.reportedLength ¬ geometry.size.width;
widget.actual.size.width>0 => sd.reportedLength ¬ widget.actual.size.width;
ENDCASE => sd.reportedLength ¬ 1;
};
ENDCASE;
IF Xl.IllegalCursor[widget.attributes.cursor]
THEN widget.attributes.cursor ¬ sd.inertCursor ¬ dd.inertCursor
ELSE sd.inertCursor ¬ widget.attributes.cursor;
XTk.AddTemporaryMatch[widget, [proc: EventProc, handles: eventFilter, tq: dd.exposeTQ, data: widget], eventMask];
ForwardCallScrollProcs[sd, configure, sd.reportedLength, NIL]; --because window creation does not make configure events...
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping, reConsiderChildren];
};
CreateScrollbar:
PUBLIC
PROC [widgetSpec: XTk.WidgetSpec ¬ [], direction: Direction, state: State]
RETURNS [scrollbar: Scrollbar] = {
sd: ScrollbarData;
SELECT direction
FROM
vertical => IF widgetSpec.geometry.size.width<=0 THEN widgetSpec.geometry.size.width ¬ defaultWidth;
horizontal => IF widgetSpec.geometry.size.height<=0 THEN widgetSpec.geometry.size.height ¬ defaultWidth;
ENDCASE;
scrollbar ¬ XTk.CreateWidget[widgetSpec, scrollbarClass];
sd ¬ GetInstData[scrollbar];
sd.direction ¬ direction;
sd.state ¬ state;
};
IsScrollbar:
PUBLIC
PROC [widget: XTk.Widget]
RETURNS [
BOOL] = {
RETURN [XTk.HasClass[widget, scrollbarClass]]
};
SetScrollProc:
PUBLIC
PROC [scrollbar: Scrollbar, scrollProc: ScrollProc, clientData:
REF ¬
NIL, tq: Xl.
TQ ¬
NIL] = {
Protected: ENTRY PROC [sd: ScrollbarData, crr: CallRegRec] = {
sd.crrList ¬ CONS[crr, sd.crrList] --multiple registration ?
};
sd: ScrollbarData ~ GetInstData[scrollbar];
crr: CallRegRec ~ [scrollProc: scrollProc, clientData: clientData, scrollbar: scrollbar];
IF sd=NIL OR scrollProc=NIL THEN ERROR;
sd.crrList ¬ LIST[crr]; --only one registration ?
};
ForwardCallScrollProcs:
PROC [sd: ScrollbarData, action: XTkScrollbar.Action, value:
REAL, event: Xl.Event ¬
NIL] = {
--dispatch actions onto right tq
FOR rl:
LIST
OF CallRegRec ¬ sd.crrList, rl.rest
WHILE rl#
NIL
DO
cd: REF CallData ~ NEW[CallData ¬ [crrl: rl, action: action, value: value]];
tq: Xl.TQ ¬ rl.first.tq;
IF tq=NIL THEN {tq ¬ rl.first.scrollbar.rootTQ; IF tq=NIL THEN EXIT};
Xl.Enqueue[tq: tq, proc: ForwardedCallScrollProc, data: cd, event: event];
ENDLOOP
};
ForwardedCallScrollProc: Xl.EventProcType = {
cd: REF CallData ~ NARROW[clientData];
cd.crrl.first.scrollProc[scrollbar: cd.crrl.first.scrollbar, action: cd.action, value: cd.value, event: event, clientData: cd.crrl.first.clientData];
};
ScrollbarInitInstPart: XTk.InitInstancePartProc = {
XTkFriends.AssignInstPart[widget, scrollbarClass, NEW[ScrollbarRec]];
};
ScrollbarForgetScreenLR: XTk.TerminateProc = {
sd: ScrollbarData ~ GetInstData[widget];
sd.gc1 ¬ sd.gc2 ¬ sd.gc3 ¬ NIL;
sd.leftMouseCursor ¬ sd.middleMouseCursor ¬ sd.rightMouseCursor ¬ sd.inertCursor ¬ Xl.illegalCursor;
sd.iOwnButton ¬ FALSE;
sd.initiatedAction ¬ none;
};
eventFilter: Xl.EventFilter ~ Xl.CreateEventFilter[expose, buttonPress, buttonRelease, configureNotify];
EventProc: Xl.EventProcType = {
ENABLE Xl.XError => GOTO oops;
scrollbar: Scrollbar ~ NARROW[clientData];
sd: ScrollbarData ~ GetInstData[scrollbar];
SELECT event.type
FROM
Xl.EventCode.buttonPress => {
bp: Xl.ButtonPressEvent ~ NARROW[event];
IF ~sd.iOwnButton
AND Xl.SetButtonGrabOwner[bp.connection, bp.timeStamp, sd]=succeeded
THEN {
pm: Xl.PointerMapping ~ Xl.GetPointerMapping[bp.connection];
button: INT ~ (IF pm#NIL AND pm.leng>bp.button THEN pm[bp.button] ELSE bp.button);
Forward:
PROC [] =
INLINE {
sd.initiatedAction ¬ forward; SetCursor[scrollbar, sd.leftMouseCursor]
};
Thumb:
PROC [] =
INLINE {
sd.initiatedAction ¬ thumb; SetCursor[scrollbar, sd.middleMouseCursor]
};
Backward:
PROC [] =
INLINE {
sd.initiatedAction ¬ backward; SetCursor[scrollbar, sd.rightMouseCursor]
};
sd.iOwnButton ¬ TRUE;
sd.initiatedPos ¬ bp.pos;
SELECT button
FROM
1 => {
SELECT
TRUE
FROM
bp.state.control => Thumb[];
bp.state.shift => Backward[];
ENDCASE => Forward[];
};
2 => Thumb[];
3 => Backward[];
ENDCASE => {};
};
};
Xl.EventCode.buttonRelease => {
IF sd.iOwnButton
THEN {
br: Xl.ButtonReleaseEvent ~ NARROW[event];
IF br.sameScreen
AND (Inside[scrollbar, br.pos]
OR Extents[scrollbar, br.pos, sd.direction])
THEN {
action: XTkScrollbar.Action ¬ sd.initiatedAction;
leng: REAL ~ MAX[sd.reportedLength, 1];
value: REAL;
IF action=forward
AND (
ABS[sd.initiatedPos.x-br.pos.x]+
ABS[sd.initiatedPos.y-br.pos.y])>15
THEN {
--Large movement with left mouse down: assume pen instead of mouse
--Invert user interface for pen
distance: Xl.Point ¬ [br.pos.x-sd.initiatedPos.x, br.pos.y-sd.initiatedPos.y];
value ¬ ValueFromPos[sd, distance];
IF value>0
THEN {action ¬ backward}
ELSE {value ¬ -value; action ¬ forward}
}
ELSE {
--Assume regular mouse
value ¬ ValueFromPos[sd, br.pos];
};
ForwardCallScrollProcs[sd, action, value/leng, event];
};
SetCursor[scrollbar, sd.inertCursor];
sd.iOwnButton ¬ FALSE;
};
};
Xl.EventCode.configureNotify => {
cne: Xl.ConfigureNotifyEvent ~ NARROW[event];
value:
INT ~
SELECT sd.direction
FROM
horizontal => cne.geometry.size.width,
vertical => cne.geometry.size.height,
ENDCASE => ERROR;
IF value#sd.reportedLength
THEN {
sd.reportedLength ¬ MAX[value, 1];
ForwardCallScrollProcs[sd, configure, value, event];
}
};
Xl.EventCode.expose => {
expose: Xl.ExposeEvent = NARROW[event];
IF expose.count<=0 THEN ScrollbarRepaint[scrollbar, sd];
};
Xl.EventCode.local => {
IF event=fakeExpose THEN ScrollbarRepaint[scrollbar, sd];
};
ENDCASE => {};
EXITS oops => {};
};
ValueFromPos:
PROC [sd: ScrollbarData, pos: Xl.Point]
RETURNS [p:
INT] =
INLINE {
SELECT sd.direction
FROM
horizontal => {p ¬ pos.x};
vertical => {p ¬ pos.y};
ENDCASE;
};
Inside:
PROC [w: XTk.Widget, p: Xl.Point]
RETURNS [
BOOL] = {
RETURN [p.x>=0 AND p.x<=w.actual.size.width AND p.y>=0 AND p.y<=w.actual.size.height]
};
Extents:
PROC [w: XTk.Widget, p: Xl.Point, direction: Direction]
RETURNS [
BOOL] = {
SELECT direction
FROM
horizontal => RETURN[p.x<=0 OR p.x>=w.actual.size.width];
vertical => RETURN[p.y<=0 OR p.y>=w.actual.size.height];
ENDCASE => ERROR;
};
SetCursor:
PROC [widget: XTk.Widget, cursor: Xl.Cursor] = {
attributes: Xl.Attributes;
attributes.cursor ¬ cursor;
Xl.ChangeWindowAttributes[widget.connection, widget.window, attributes];
Xl.Flush[widget.connection];
};
ScrollbarRepaint:
PROC [scrollbar: Scrollbar, sd: ScrollbarData] = {
cheat: INT ~ 3;
c: Xl.Connection ~ scrollbar.connection;
w: Xl.Window ~ scrollbar.window;
sz: Xl.Size ~ scrollbar.actual.size;
state: State ¬ sd.state;
IF scrollbar.fastAccessAllowed#ok OR scrollbar.state#realized THEN RETURN;
IF sz.height<=0 OR sz.width<=0 THEN RETURN;
state.start ¬ MIN[MAX[state.start, 0.0], 1.0];
state.next ¬ MIN[MAX[state.start, state.next], 1.0];
SELECT sd.direction
FROM
horizontal => {
iLength: INT ~ scrollbar.actual.size.width;
iStart: INT ¬ Real.Round[iLength*state.start];
iNext: INT ¬ Real.Round[iLength*state.next];
--cheat to keep middle range visible...
iStart ¬ MAX[MIN[iStart, iLength-cheat], 0];
iNext ¬ MIN[iLength, MAX[iStart+cheat, iNext]];
IF iStart>0
THEN
Xl.FillRectangle[c, w, sd.gc1, [0, 0], [iStart, sz.height]];
IF iNext>iStart
THEN
Xl.FillRectangle[c, w, sd.gc2, [iStart, 0], [iNext-iStart, sz.height]];
IF iLength>iNext
THEN
Xl.FillRectangle[c, w, sd.gc3, [iNext, 0], [iLength-iNext, sz.height]];
};
vertical => {
iLength: INT ~ scrollbar.actual.size.height;
iStart: INT ¬ Real.Round[iLength*state.start];
iNext: INT ¬ Real.Round[iLength*state.next];
--cheat to keep middle range visible...
iStart ¬ MAX[MIN[iStart, iLength-cheat], 0];
iNext ¬ MIN[iLength, MAX[iStart+cheat, iNext]];
IF iStart>0
THEN
Xl.FillRectangle[c, w, sd.gc1, [0, 0], [sz.width, iStart]];
IF iNext>iStart
THEN
Xl.FillRectangle[c, w, sd.gc2, [0, iStart], [sz.width, iNext-iStart]];
IF iLength>iNext
THEN
Xl.FillRectangle[c, w, sd.gc3, [0, iNext], [sz.width, iLength-iNext]];
};
ENDCASE;
Xl.Flush[c, TRUE];
};
END.