XTkGestureInputImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 28, 1992 2:43:24 pm PST
Christian Jacobi, October 28, 1992 2:52 pm PST
DIRECTORY
Convert, Rope, Xl, XlDB, XlPerDepth, XTk, XTkOps, XTkGestureInput;
XTkGestureInputImpl:
CEDAR
MONITOR
IMPORTS Convert, Xl, XlDB, XlPerDepth, XTk, XTkOps
EXPORTS XTkGestureInput ~
BEGIN OPEN XTkGestureInput;
GestureData: TYPE = REF GestureRec;
GestureRec:
TYPE =
RECORD [
--hangs on widget
self: XTk.Widget ¬ NIL,
stroke: LIST OF Xl.Point ¬ NIL,
gc: Xl.GContext ¬ NIL,
delayFlush: BOOL ¬ TRUE,
paint: BOOL ¬ FALSE,
registrations: LIST OF RegistrationRec ¬ NIL
];
ReportData:
TYPE =
RECORD [
--to transmit report data to tq
gd: GestureData,
stroke: LIST OF Xl.Point,
rrl: LIST OF RegistrationRec
];
RegistrationRec:
TYPE =
RECORD [
--list registrations
proc: GestureReportProc, d1, d2: REF ¬ NIL, tq: Xl.TQ ¬ NIL
];
GestureReportProc: PUBLIC TYPE = PROC [w: XTk.Widget, stroke: LIST OF Xl.Point, e: Xl.Event, d1, d2: REF];
filter: Xl.EventFilter ~ Xl.CreateEventFilter[motionNotify, buttonPress, buttonRelease];
Append:
PROC [gd: GestureData, e: Xl.Event, pos: Xl.Point] = {
IF gd.stroke=
NIL
THEN gd.stroke ¬ LIST[pos]
ELSE
IF gd.stroke.first#pos
THEN {
IF gd.gc#
NIL
AND gd.paint
THEN {
Xl.DrawLine[e.connection, gd.self.window, pos, gd.stroke.first, gd.gc];
Xl.Flush[e.connection, gd.delayFlush];
};
gd.stroke ¬ CONS[pos, gd.stroke];
};
};
EventProc: Xl.EventProcType = {
ENABLE {
Xl.XError => GOTO oops;
};
gd: GestureData ~ NARROW[clientData];
SELECT event.type
FROM
Xl.EventCode.motionNotify => {
e: Xl.MotionNotifyEvent ~ NARROW[event];
Append[gd, e, e.pos];
};
Xl.EventCode.buttonPress => {
e: Xl.ButtonPressEvent ~ NARROW[event];
gd.stroke ¬ NIL;
Append[gd, e, e.pos];
};
Xl.EventCode.buttonRelease => {
e: Xl.ButtonReleaseEvent ~ NARROW[event];
stroke: LIST OF Xl.Point;
Append[gd, e, e.pos];
stroke ¬ gd.stroke; gd.stroke ¬ NIL;
Report[gd, stroke, e];
};
ENDCASE => {};
EXITS oops => {};
};
Report:
PROC [gd: GestureData, stroke:
LIST
OF Xl.Point, event: Xl.Event] = {
FOR rrl:
LIST
OF RegistrationRec ¬ gd.registrations, rrl.rest
WHILE rrl#
NIL
DO
rd: REF ReportData ¬ NEW[ReportData ¬ [gd: gd, stroke: stroke, rrl: rrl]];
tq: Xl.TQ ¬ rrl.first.tq;
IF tq=NIL THEN tq ¬ gd.self.rootTQ;
Xl.Enqueue[tq: tq, proc: QueuedReport, data: rd, event: event]
ENDLOOP
};
QueuedReport: Xl.EventProcType = {
rd: REF ReportData ~ NARROW[clientData];
rd.rrl.first.proc[w: rd.gd.self, stroke: rd.stroke, e: event, d1: rd.rrl.first.d1, d2: rd.rrl.first.d2];
};
propertyKey: REF INT ~ NEW[INT];
GetGestureTrait:
ENTRY
PROC [w: XTk.Widget]
RETURNS [GestureData] = {
IF w=NIL THEN RETURN [NIL];
WITH XTk.GetWidgetProp[w, propertyKey]
SELECT
FROM
gd: GestureData => RETURN [gd];
ENDCASE => {
gd: GestureData ¬ NEW[GestureRec ¬ [self: w]];
XTk.PutWidgetProp[w, propertyKey, gd];
XTkOps.CallAndRegisterOnPostRealize[w, PostRealize, gd];
XTk.RegisterNotifier[w, XTk.preStopFastAccessKey, StopAccess, gd];
RETURN [gd];
};
};
StopAccess: XTk.WidgetNotifyProc = {
gd: GestureData ~ NARROW[registerData];
gd.gc ¬ NIL
};
PostRealize: XTk.WidgetNotifyProc = {
gd: GestureData ~ NARROW[registerData];
gestureMatch: Xl.Match ¬
NEW[Xl.MatchRep ¬ [
proc: EventProc, handles: filter, tq: TrustedSharedTQ[widget.screenDepth], data: gd
]];
IF gd.gc=NIL THEN gd.gc ¬ TrustedSharedGC[widget.screenDepth];
Xl.AddDispatch[widget.connection, widget.window, gestureMatch, [buttonMotion: TRUE, buttonRelease: TRUE, buttonPress: TRUE]];
};
SetReport:
PUBLIC PROC [w: XTk.Widget, report: GestureReportProc, d1, d2:
REF ¬
NIL, tq: Xl.
TQ ¬
NIL] = {
gd: GestureData ¬ GetGestureTrait[w];
EntryAddReport:
ENTRY
PROC [gd: GestureData, rr: RegistrationRec] = {
gd.registrations ¬ CONS[rr, gd.registrations];
};
EntryAddReport[gd, [report, d1, d2, tq]];
};
SetPainting:
PUBLIC
PROC [w: XTk.Widget, addFlush:
BOOL, gc: Xl.GContext ¬
NIL] = {
gd: GestureData ¬ GetGestureTrait[w];
gd.paint ¬ TRUE;
IF addFlush THEN gd.delayFlush ¬ FALSE;
IF gc#NIL THEN gd.gc ¬ gc;
TrustedSharedTQ:
PROC [screenDepth: Xl.ScreenDepth]
RETURNS [Xl.
TQ] = {
pdd: REF PerDepthRec ~ GetDepthData[screenDepth];
RETURN [pdd.sharedTQ]
};
TrustedSharedGC:
PUBLIC
PROC [screenDepth: Xl.ScreenDepth]
RETURNS [Xl.GContext] = {
pdd: REF PerDepthRec ~ GetDepthData[screenDepth];
RETURN [pdd.gc]
};
GetDepthData:
PROC [screenDepth: Xl.ScreenDepth]
RETURNS [
REF PerDepthRec] =
INLINE {
RETURN [NARROW[XlPerDepth.InlineGetData[perDKey, screenDepth]]]
};
PerDepthRec:
TYPE =
RECORD [
sharedTQ: Xl.TQ ¬ NIL,
gc: Xl.GContext
];
perDKey: XlPerDepth.Handle ¬ XlPerDepth.InstallHandle[InstallDepth];
InstallDepth: XlPerDepth.InitProc = {
dd: REF PerDepthRec ¬ NEW[PerDepthRec];
IF sd#
NIL
AND Xl.Alive[sd.screen.connection]
THEN {
width: INT ¬ 0;
screen: Xl.Screen ¬ sd.screen;
c: Xl.Connection ¬ screen.connection;
gc: Xl.GContext ¬ dd.gc ¬ Xl.MakeGContext[c, screen.root.drawable];
Xl.SetGCFunction[gc: gc, function: copy];
Xl.SetGCForeground[gc: gc, foreground: screen.blackPixel];
Xl.SetGCBackground[gc: gc, background: screen.whitePixel];
BEGIN
widthRope: Rope.ROPE; w: INT;
widthRope ¬ XlDB.QueryStandardDB[c, "(XTkGestureInput)(StrokeWidth)"];
w ¬ Convert.IntFromRope[widthRope ! Convert.Error => {w ¬ 0; CONTINUE}];
IF w>0 AND w<20 THEN width ¬ w;
END;
Xl.SetGCLineWidth[gc: gc, width: width];
};
dd.sharedTQ ¬ Xl.CreateTQ[$XTkGesturesImpl];
RETURN [dd]
};
END.