[_CDCSL_93-16_]<1>Cedar>release>X11>XTkScrollerImpl.mesa

XTkScrollerImpl.mesa

Created by Christian Jacobi, October 22, 1990 5:38:56 pm PDT

Christian Jacobi, February 21, 1992 5:22 pm PST

DIRECTORY

Real,

Xl,

XlCursor,

XTk,

XTkFriends,

XTkScroller;

XTkScrollerImpl: CEDAR MONITOR

IMPORTS Real, XlCursor, Xl, XTk, XTkFriends

EXPORTS XTkScroller =

BEGIN OPEN XTkScroller;

setStateCalled: PUBLIC ATOM ¬ $ScrollerSetStateCalled;

myPropKey: REF ATOM ~ NEW[ATOM ¬ $scroller];

cdCache: ConnectionData ¬ NEW[ConnectionDataRec[0]]; --must never be NIL

GetConnectionData: PROC [c: Xl.Connection] RETURNS [cd: ConnectionData] = {

cd ¬ cdCache; IF cd.connection = c THEN RETURN;

cdCache ¬ cd ¬ NARROW[Xl.GetConnectionPropAndInit[c, myPropKey, InitConnection]];

};

ConnectionData: TYPE = REF ConnectionDataRec;

ConnectionDataRec: TYPE = RECORD [

connection: Xl.Connection ¬ NIL,

inertCursor: Xl.Cursor ¬ Xl.nullCursor,

exposeTQ: Xl.TQ ¬ NIL, --share tq, limit parallelism

up, down, left, right, leftRight, upDown: Xl.Cursor ¬ Xl.nullCursor,

perDepth: SEQUENCE num: NAT OF PerDepthRec

];

PerDepthRec: TYPE = RECORD [

grey1, grey2, grey3: Xl.Pixmap,

gc1, gc2, gc3: Xl.GContext

];

InitConnection: Xl.InitializeProcType = {

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]];

cd: ConnectionData ¬ NEW[ConnectionDataRec[Xl.ScreenDepthCount[c]]];

cd.exposeTQ ¬ Xl.CreateTQ[];

cd.inertCursor ¬ XlCursor.SharedStandardCursor[c, tcross];

cd.up ¬ XlCursor.SharedStandardCursor[c, sbUpArrow];

cd.down ¬ XlCursor.SharedStandardCursor[c, sbDownArrow];

cd.left ¬ XlCursor.SharedStandardCursor[c, sbLeftArrow];

cd.right ¬ XlCursor.SharedStandardCursor[c, sbRightArrow];

cd.leftRight ¬ XlCursor.SharedStandardCursor[c, sbHDoubleArrow];

cd.upDown ¬ XlCursor.SharedStandardCursor[c, sbVDoubleArrow];

FOR d: NAT IN [0..cd.num) DO

sd: Xl.ScreenDepth ¬ Xl.NthScreenDepth[c, d];

screen: Xl.Screen ¬ sd.screen;

gc1: Xl.GContext ¬ Xl.MakeGContext[c, screen.root.drawable];

gc2: Xl.GContext ¬ Xl.MakeGContext[c, screen.root.drawable];

gc3: Xl.GContext ¬ Xl.MakeGContext[c, screen.root.drawable];

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];

cd.perDepth[d].grey1 ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth];

cd.perDepth[d].grey2 ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth];

cd.perDepth[d].grey3 ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], sd.depth];

TRUSTED {

Xl.PutImage[c: c, drawable: cd.perDepth[d].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: cd.perDepth[d].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: cd.perDepth[d].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: cd.perDepth[d].grey1];

Xl.SetGCTile[gc: gc2, tile: cd.perDepth[d].grey2];

Xl.SetGCTile[gc: gc3, tile: cd.perDepth[d].grey3];

Xl.SetGCFillStyle[gc: gc1, fillStyle: tiled];

Xl.SetGCFillStyle[gc: gc2, fillStyle: tiled];

Xl.SetGCFillStyle[gc: gc3, fillStyle: tiled];

cd.perDepth[d].gc1 ¬ gc1;

cd.perDepth[d].gc2 ¬ gc2;

cd.perDepth[d].gc3 ¬ gc3;

ENDLOOP;

RETURN [cd]

};

------------------------------------------------------

defaultWidth: INT = 12;

eventMask: Xl.SetOfEvent ~ [structureNotify: TRUE, buttonMotion: TRUE, exposure: TRUE, buttonPress: TRUE, buttonRelease: TRUE];

scrollerClass: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[

key: $scroller, classNameHint: $Scrollbar, wDataNum: 1,

configureLR: ScrollerConfigureLR,

initInstPart: ScrollerInitInstPart,

forgetScreenLR: ScrollerForgetScreenLR,

eventMask: eventMask,

backgroundKey: $white

]];

CallRegRec: TYPE = RECORD [

scroller: Scroller,

scrollerProc: ScrollProc,

clientData: REF ¬ NIL,

tq: Xl.TQ ¬ NIL --NIL for rootTQ

];

CallData: TYPE = RECORD [

crrl: LIST OF CallRegRec,

action: XTkScroller.Action,

value: REAL

];

ScrollerData: TYPE = REF ScrollerRec;

ScrollerRec: TYPE = RECORD [

state: State, --monitored

direction: Direction,

iOwnButton: BOOL ¬ FALSE,

initiatedAction: Action ¬ none,

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 [scroller: Scroller] RETURNS [ScrollerData] = INLINE {

RETURN [NARROW[XTkFriends.InstPart[scroller, scrollerClass]]];

};

SetState: PUBLIC PROC [scroller: Scroller, state: State, propagate: BOOL] = {

sd: ScrollerData ~ GetInstData[scroller];

EntrySetState[sd, state];

IF propagate THEN XTkFriends.CallNotifiers[scroller, setStateCalled, sd];

ScrollerRepaint[scroller, sd];

};

GetDirection: PUBLIC PROC [scroller: Scroller] RETURNS [direction: Direction] = {

sd: ScrollerData ~ GetInstData[scroller];

RETURN [sd.direction]

};

GetState: PUBLIC PROC [scroller: Scroller] RETURNS [state: State] = {

sd: ScrollerData ~ GetInstData[scroller];

state ¬ EntryGetState[sd];

};

EntrySetState: ENTRY PROC [sd: ScrollerData, state: State] = {

sd.state ¬ state

};

EntryGetState: ENTRY PROC [sd: ScrollerData] RETURNS [state: State] = {

state ¬ sd.state

};

ScrollerConfigureLR: XTk.ConfigureProc = {

existW: BOOL ¬ widget.actualMapping<unconfigured;

createW: BOOL ¬ mapping<unconfigured AND ~existW;

IF createW THEN {

sd: ScrollerData ~ GetInstData[widget];

cd: ConnectionData = GetConnectionData[widget.connection];

IF sd.gc1=NIL THEN {sd.gc1 ¬ cd.perDepth[widget.screenDepth.screenDepthIndex].gc1};

IF sd.gc2=NIL THEN {sd.gc2 ¬ cd.perDepth[widget.screenDepth.screenDepthIndex].gc2};

IF sd.gc3=NIL THEN {sd.gc3 ¬ cd.perDepth[widget.screenDepth.screenDepthIndex].gc3};

SELECT sd.direction FROM

vertical => {

sd.leftMouseCursor ¬ cd.up;

sd.middleMouseCursor ¬ cd.upDown;

sd.rightMouseCursor ¬ cd.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 ¬ cd.left;

sd.middleMouseCursor ¬ cd.leftRight;

sd.rightMouseCursor ¬ cd.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 ¬ cd.inertCursor

ELSE sd.inertCursor ¬ widget.attributes.cursor;

XTk.AddTemporaryMatch[widget, [proc: ScrollerEventProc, handles: scrollerEventSet, tq: cd.exposeTQ, data: widget], eventMask];

ForwardCallScrollerProcs[sd, configure, sd.reportedLength, NIL]; --because window creation does not make configure events...

};

XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping, reConsiderChildren];

};

CreateScroller: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], direction: Direction, state: State] RETURNS [scroller: Scroller] = {

sd: ScrollerData;

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;

scroller ¬ XTk.CreateWidget[widgetSpec, scrollerClass];

sd ¬ GetInstData[scroller];

sd.direction ¬ direction;

sd.state ¬ state;

};

InteractiveRegistrations: PUBLIC PROC [scroller: Scroller, scrollerProc: ScrollProc, clientData: REF ¬ NIL, tq: Xl.TQ ¬ NIL] = {

Protected: ENTRY PROC [sd: ScrollerData, crr: CallRegRec] = {

sd.crrList ¬ CONS[crr, sd.crrList]

};

sd: ScrollerData ~ GetInstData[scroller];

crr: CallRegRec ~ [scrollerProc: scrollerProc, clientData: clientData, scroller: scroller];

IF sd=NIL OR scrollerProc=NIL THEN ERROR;

Protected[sd, crr];

};

ForwardCallScrollerProcs: PROC [sd: ScrollerData, action: XTkScroller.Action, value: REAL, event: Xl.Event ¬ NIL] = {

--propagate actions onto right threads

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.scroller.rootTQ; IF tq=NIL THEN EXIT};

Xl.Enqueue[tq: tq, proc: SynchCallScrollerProc, data: cd, event: event];

ENDLOOP

};

SynchCallScrollerProc: Xl.EventProcType = {

cd: REF CallData ~ NARROW[clientData];

cd.crrl.first.scrollerProc[scroller: cd.crrl.first.scroller, action: cd.action, value: cd.value, event: event, clientData: cd.crrl.first.clientData];

};

ScrollerInitInstPart: XTk.InitInstancePartProc = {

XTkFriends.AssignInstPart[widget, scrollerClass, NEW[ScrollerRec]];

};

ScrollerForgetScreenLR: XTk.TerminateProc = {

sd: ScrollerData ~ 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;

};

scrollerEventSet: Xl.EventFilter ~ Xl.CreateEventFilter[expose, buttonPress, buttonRelease, configureNotify];

ScrollerEventProc: Xl.EventProcType = {

ENABLE Xl.XError => GOTO oops;

scroller: Scroller ~ NARROW[clientData];

sd: ScrollerData ~ GetInstData[scroller];

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 {

sd.iOwnButton ¬ TRUE;

SELECT bp.button FROM

1 => {sd.initiatedAction ¬ forward; SetCursor[scroller, sd.leftMouseCursor]};

2 => {sd.initiatedAction ¬ thumb; SetCursor[scroller, sd.middleMouseCursor]};

3 => {sd.initiatedAction ¬ backward; SetCursor[scroller, sd.rightMouseCursor]};

ENDCASE => {};

};

Xl.EventCode.buttonRelease => {

IF sd.iOwnButton THEN {

br: Xl.ButtonReleaseEvent ~ NARROW[event];

IF br.sameScreen AND (Inside[scroller, br.pos] OR Extents[scroller, br.pos, sd.direction]) THEN {

leng: REAL ~ sd.reportedLength;

value: REAL ~ ValueFromPos[sd, br.pos];

ForwardCallScrollerProcs[sd, sd.initiatedAction, value/leng, event];

};

SetCursor[scroller, 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];

ForwardCallScrollerProcs[sd, configure, value, event];

}

};

Xl.EventCode.expose => {

expose: Xl.ExposeEvent = NARROW[event];

IF expose.count<=0 THEN ScrollerRepaint[scroller, sd];

};

ENDCASE => {};

EXITS oops => {};

};

ValueFromPos: PROC [sd: ScrollerData, 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];

};

ScrollerRepaint: PROC [scroller: Scroller, sd: ScrollerData] = {

cheat: INT ~ 3;

c: Xl.Connection ~ scroller.connection;

w: Xl.Window ~ scroller.window;

sz: Xl.Size ~ scroller.actual.size;

state: State ¬ sd.state;

IF scroller.fastAccessAllowed#ok OR scroller.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 ~ scroller.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 ~ scroller.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.