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 = {
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 = {
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.

  ذ  
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

Internally, positions are handled root-relative 
Because telepointer-window relative coordinates are moved asynchronously when the telepointer-window is reconfigured.  
--Use separate queue so it can be slowed down and events can be collapsed
 ‌تا  •NewlineDelimiter
™ ™J™<J™+J™-J™"J™ —codeڑدk	ک	KکKک
KکKکKک	Kک
KکKک—Jک ڑدnœ‌œ‌ک#Kڑ‌œLکS—Kڑ‌œکKک Kڑœ‌œ‌œکڑœ‌œ‌œکKڑœ‌œکKڑœ‌œ‌œکKک*Kک$Kک$Kڑœ‌œ‌œدc5کSKک—Kک Kڑ	œ‌œ‌œ‌œ‌œک6Kڑ	œ‌œ‌œ‌œ‌œک5Kک Kک$Kڑœ‌œکKڑœ‌œ-کBKک ڑ‍œکKڑœ‌œک)ڑ‌œںCکIKڑœU‌œ‌œکwڑ‌œ3‌œ‌کBKڑœ‌œ ک'Kڑ‌œ‌œک—Kڑ‌œک—Kک=KکWKکKک —ڑ‍œ‌œ‌œکCKک3KکKک —ڑ‍œک(Kڑœ‌œک"KکKک(Kکڑœ‌œک%KکKکIKکKک	Kک—کFKک:Kک6Kڑœ‌œ‌œ‌œکIKک9Kک—Kک"Kڑœ<‌œsک³KکKکKک —ڑ‍œک"™0K™w—ڑ‍œ‌œک3Kڑœ$ں$کHJک'Jک4Kک[Kک—Kڑœ‌œک Kکڑ‌œ‌ککKڑœ‌œک)JڑœدbœکKک—کKڑœ‌œک*Jڑœ œکKک—کKڑœ‌œک(Kڑœ‹ œک¥Kک—Kڑ‌œک—KکKک —ڑ‍œک%ڑ‌œ
‌œ‌œکڑ‌œ4‌œ‌کCڑœ‌œک-Kڑ‌œ‌œ‌œ.ک<Kک—Kڑ‌œک—Kک—KکKک —ڑ‍œک,K™IKڑœ‌œک KکKک'Kک=Kڑœ‌œ‌œ'ک4Kڑœ‌œ‌œ(ک5ڑ‌œ‌œکKکKکاKڑœں1کHKک—KکKک —Kک1KڑœC‌œکHKڑ‌œکKک — …—    Œ  #  