XlTestImpl2.mesa
Copyright Ó 1988, 1989, 1991 by Xerox Corporation. All rights reserved.
Christian Jacobi, April 13, 1988 3:02:13 pm PDT
Christian Jacobi, October 8, 1992 10:17 pm PDT
DIRECTORY IO, Rope, X11, X11Conventions, X11WMOps, Process;
XlTestImpl2: CEDAR PROGRAM
IMPORTS IO, X11, X11Conventions, Process
~ BEGIN OPEN X11;
ROPE: TYPE ~ Rope.ROPE;
num: BYTE ¬ 0;
DetachStart: PROC [] = {
TRUSTED{Process.Detach[FORK StartTest[]]}
};
DetachStop: PROC [] = {
TRUSTED{Process.Detach[FORK StopTest[]]}
};
Debug: PROC[] = {
stop ¬ FALSE;
WHILE ~stop DO
Process.PauseMsec[200];
ENDLOOP;
};
AddS: PROC [p: Point, s: Size] RETURNS [Point] = {
RETURN [[x: p.x+s.width, y: p.y+s.height]]
};
EventProc: EventProcType = {
td: TestData ~ NARROW[clientData];
WITH event SELECT FROM
expose: ExposeEvent => {
window: Window ¬ expose.window;
SetGCForeground[td.gc, 1];
DrawLine[event.connection, window.drawable, expose.pos, AddS[expose.pos, expose.size], td.gc];
};
buttonPress: ButtonPressEvent => {
window: Window ¬ buttonPress.eventWindow;
SetGCForeground[td.gc, 1];
SetGCBackground[td.gc, 0];
SetGCFont[td.gc, fontId];
ImageRope[event.connection, window.drawable, buttonPress.pos, td.gc, "abc1234"];
};
motionNotify: MotionNotifyEvent => {
window: Window ¬ motionNotify.eventWindow;
SetGCForeground[td.gc, 1];
FillRectangle[event.connection, window.drawable, td.gc, motionNotify.pos, [10, 10]];
Flush[event.connection];
};
ENDCASE => {};
};
thread: Thread;
TestData: TYPE = REF TestDataRec;
TestDataRec: TYPE = RECORD [
gc: GContext
];
con: Connection;
wId: Window ¬ nullWindow;
out: IO.STREAM ¬ IO.noWhereStream;
fontName: Rope.ROPE ¬ "vrb-25";
fontId: Font;
events: EventFilter ¬ LongCreateEventFilter[activate: ALL[TRUE]];
nastyUnprotectedConnection: Connection ¬ NIL;
stop: BOOL ¬ FALSE;
StopTest: PROC [] = {
stop ¬ TRUE;
};
StartTest: PROC ~ {
connection: Connection;
Init[];
StopTest[];
connection ¬ con ¬ Xl.CreateConnection[];
IF X11.Alive[connection] THEN {
ENABLE ABORTED => {nastyUnprotectedConnection ¬ connection; GOTO close};
status: GrabStatus ¬ frozen;
gc: GContext ~ MakeGContext[connection];
td: TestData ~ NEW[TestDataRec¬[gc: gc]];
window: Window ¬ wId ¬ CreateWindow[c: connection,
matchList: LIST[NEW[MatchRep ¬ [proc: EventProc, handles: events, thread: thread, data: td]]],
geometry: [pos: [20, 400], size: [400, 300]],
attributes: [overrideRedirect: true, eventMask: OREvents[exposureMask, pointerMotionMask, keyPressMask, buttonPressMask], backgroundPixel: FirstScreen[connection].whitePixel]
];
X11Conventions.SetWindowName[connection, window, "Test"];
fontId ¬ OpenFont[connection, fontName];
IO.PutF[out, "created window: %g \n", IO.card[WindowId[window]]];
SetGCForeground[gc, 1];
SetGCFont[gc, fontId];
MapWindow[connection, window];
FillRectangle[connection, window.drawable, gc, [10, 20], [30, 40]];
FillRectangle[connection, window.drawable, gc, [40, 60], [30, 40]];
Flush[connection];
Debug[];
CloseConnection[connection];
};
EXITS close => {
c: Connection ¬ nastyUnprotectedConnection; nastyUnprotectedConnection ¬ NIL;
IF c#NIL THEN CloseConnection[c];
};
};
init: BOOL ¬ FALSE;
Init: PROC [] = {
IF init THEN RETURN;
init ¬ TRUE;
thread ¬ CreateTQ[$X11TestsImpl];
};
END.