SlateTelepointerImpl.mesa
Copyright Ó 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 6, 1993 4:55 pm PST
Christian Jacobi, March 10, 1993 10:29 am PST
Theimer, April 8, 1993 1:45 pm PDT
DIRECTORY
Process,
PropList,
Slate,
Xl,
XlCursor,
XlDetails,
XTk,
XTkBitmapScroller;
SlateTelepointerImpl:
CEDAR
MONITOR
IMPORTS Process, PropList, Slate, Xl, XlCursor, XlDetails, XTk, XTkBitmapScroller ~
BEGIN
TPRef: TYPE = REF TPData;
TPData:
TYPE =
RECORD [
i: Slate.Instance ¬ NIL,
telepointerTQ: Xl.TQ ¬ NIL,
telepointerWin: Xl.Window ¬ Xl.nullWindow,
telepointerPos: Xl.Point ¬ [-1, -1],
telepointerAbs: Xl.Point ¬ [-1, -1],
sessionPT: REF Xl.Point ¬ NIL --page relative coordinates, independent of scrolling
];
keyForPoint: REF ATOM ~ NEW[ATOM ¬ $TelepointerPoint];
keyForTPRef: REF ATOM ~ NEW[ATOM ¬ $TelepointerData];
telepointerSize: Xl.Size ~ [10, 10];
telepointerBorder: INT ~ 2;
telepointerDelta: INT ~ telepointerSize.width/2+telepointerBorder;
Setup: Slate.EventProc = {
tpr: TPRef ~ NEW[TPData ¬ [i: instance]];
BEGIN
-- guaranteed set up of per session data (sessionPT: REF Xl.Point)
[] ¬ PropList.ConditionalPutProp[list: session.properties, key: keyForPoint, expect: NIL, new: NEW[Xl.Point ¬ [0, 0]]];
WITH PropList.GetProp[session.properties, keyForPoint]
SELECT
FROM
rp: REF Xl.Point => tpr.sessionPT ¬ rp;
ENDCASE => ERROR;
END;
[] ¬ PropList.PutProp[instance.properties, keyForTPRef, tpr];
XTk.RegisterNotifier[instance.surface, XTk.postWindowCreationKey, SurfaceCreated, tpr];
};
GetScrollPos:
PROC [surface: XTk.Widget]
RETURNS [sp: Xl.Point] = {
sp ¬ XTkBitmapScroller.GetScrollPos[surface.parent]
};
SurfaceCreated: XTk.WidgetNotifyProc = {
tpr: TPRef ~ NARROW[registerData];
i: Slate.Instance ~ tpr.i;
c: Xl.Connection ~ i.surface.connection;
win: Xl.Window;
match: Xl.Match ~
NEW[Xl.MatchRep ¬ [
proc: DirectXEvent,
handles: Xl.CreateEventFilter[buttonPress, buttonRelease, motionNotify],
tq: i.surface.rootTQ,
data: tpr
]];
attributes: Xl.Attributes ~ [saveUnder: true, overrideRedirect: true,
backgroundPixel: i.surface.screenDepth.screen.whitePixel,
borderPixel: i.surface.screenDepth.screen.blackPixel,
eventMask: [buttonRelease: TRUE, buttonPress: TRUE, button1Motion: TRUE],
cursor: XlCursor.SharedStandardCursor[c: c, source: trek]
];
tpr.telepointerTQ ¬ Xl.CreateTQ[];
win ¬ tpr.telepointerWin ¬ Xl.CreateWindow[c: c, matchList: LIST[match], parent: i.surface.window, geometry: [[1, 1], telepointerSize, telepointerBorder], attributes: attributes];
Xl.MapWindow[c, win];
};
DirectXEvent: Xl.EventProcType = {
Internally, positions are handled root-relative
Because telepointer-window relative coordinates are moved asynchronously when the telepointer-window is reconfigured.
SetTelepointer:
PROC [tpr: TPRef, rp: Xl.Point] = {
abs: Xl.Point ~ tpr.telepointerAbs; --root position of real BitmapWidget
sp: Xl.Point ~ GetScrollPos[i.surface];
tpr.sessionPT ¬ [rp.x-abs.x-sp.x, rp.y-abs.y-sp.y];
Slate.CallGlobalForAllInstancesOfSession[session: tpr.i.session, event: $TelepointerTrack];
};
tpr: TPRef ~ NARROW[clientData];
i: Slate.Instance ~ tpr.i;
SELECT event.type
FROM
motionNotify => {
ev: Xl.MotionNotifyEvent ~ NARROW[event];
SetTelepointer[tpr, ev.rootP];
};
buttonRelease => {
ev: Xl.ButtonReleaseEvent ~ NARROW[event];
SetTelepointer[tpr, ev.rootP];
};
buttonPress => {
ev: Xl.ButtonPressEvent ~ NARROW[event];
tpr.telepointerAbs ¬ Xl.TranslateCoordinates[c: i.surface.connection, srcWindow: i.surface.window, dstWindow: i.surface.screenDepth.screen.root, srcPos: [0, 0]].pos;
};
ENDCASE => {};
};
TrackTelepointer: Slate.EventProc = {
IF instance#
NIL
THEN {
WITH PropList.GetProp[instance.properties, keyForTPRef]
SELECT
FROM
tpr: TPRef => {tq: Xl.
TQ ~ tpr.telepointerTQ;
IF tq#NIL THEN Xl.Enqueue[tq, QueuedTrackTelepointer, tpr];
};
ENDCASE => {};
};
};
QueuedTrackTelepointer: Xl.EventProcType = {
--Use separate queue so it can be slowed down and events can be collapsed
tpr: TPRef ~ NARROW[clientData];
i: Slate.Instance ~ tpr.i;
sp: Xl.Point ~ GetScrollPos[i.surface];
p: Xl.Point ¬ [tpr.sessionPT.x+sp.x, tpr.sessionPT.y+sp.y];
p.x ¬ MAX[MIN[i.surface.actual.size.width, p.x], 0];
p.y ¬ MAX[MIN[i.surface.actual.size.height, p.y], 0];
IF p#tpr.telepointerPos
THEN {
tpr.telepointerPos ¬ p;
Xl.ConfigureWindow[c: i.surface.connection, window: tpr.telepointerWin, geometry: [[p.x-telepointerDelta, p.y-telepointerDelta], telepointerSize, telepointerBorder], details: XlDetails.ignoreErrors];
Process.PauseMsec[50]; --limits traffic, good for low bandwidth X server
};
};
Slate.RegisterGlobalEventProc[$UICreated, Setup];
Slate.RegisterGlobalEventProc[$TelepointerTrack, TrackTelepointer, NIL];
END.