TIPTools.Mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Last tweaked by Mike Spreitzer on March 25, 1992 7:11 am PST
Kenneth A. Pier, August 10, 1990 10:29 am PDT
Bier, September 27, 1993 5:10 pm PDT
DIRECTORY
BasicTime, Commander, CommanderOps, GPM, InputFocus, IO, KeyMapping, KeyNames, KeyTypes, Menus, PFS, Process, RelativeTimes, Rope, TIPIdentity, TIPLinking, TIPToolsOps, TIPUser, UserInput, UserInputGetActions, UserInputLookahead, UserInputOps, UserInputPrivate, ViewerClasses, ViewerIO, ViewerOps, ViewersWorld, ViewersWorldInstance;
TIPTools:
CEDAR
PROGRAM
IMPORTS BasicTime, Commander, CommanderOps, GPM, InputFocus, IO, KeyMapping, KeyNames, Menus, PFS, Process, RelativeTimes, Rope, TIPIdentity, TIPLinking, TIPUser, UserInputGetActions, UserInputLookahead, UserInputOps, ViewerIO, ViewerOps, ViewersWorld, ViewersWorldInstance
EXPORTS TIPToolsOps
= BEGIN
Handle: TYPE ~ UserInput.Handle;
ROPE: TYPE ~ Rope.ROPE;
TimeStamp:
TYPE ~ RelativeTimes.TimeStamp;
in milliseconds, relative to an arbitrary per-handle starting point.
Viewer: TYPE ~ ViewerClasses.Viewer;
ViewerClass: TYPE ~ ViewerClasses.ViewerClass;
MouseButton: TYPE ~ ViewerClasses.MouseButton;
Data: TYPE ~ REF DataObj;
DataObj:
TYPE ~
RECORD [
name: ROPE,
v: Viewer ¬ NIL,
in, out: IO.STREAM ¬ NIL,
lastEventTime: TimeStamp
];
menu: Menus.Menu ~ Menus.CreateMenu[];
testClass: ViewerClass ~
NEW [ViewerClasses.ViewerClassRec ¬ [
flavor: $TIPTester,
menu: menu,
notify: Notify]];
GrabInputFocus:
PROC [parent: Viewer, clientData:
REF
ANY ¬
NIL, mouseButton: MouseButton ¬ red, shift, control:
BOOL ¬
FALSE]
--ViewerClasses.ClickProc-- ~ {
InputFocus.SetInputFocus[parent];
RETURN};
CaptureButtons:
PROC [parent: Viewer, clientData:
REF
ANY ¬
NIL, mouseButton: MouseButton ¬ red, shift, control:
BOOL ¬
FALSE]
--ViewerClasses.ClickProc-- ~ {
InputFocus.CaptureButtons[Notify, parent.tipTable, parent];
RETURN};
ReleaseButtons:
PROC [parent: Viewer, clientData:
REF
ANY ¬
NIL, mouseButton: MouseButton ¬ red, shift, control:
BOOL ¬
FALSE]
--ViewerClasses.ClickProc-- ~ {
InputFocus.ReleaseButtons[];
RETURN};
Notify:
PROC [self: Viewer, input:
LIST
OF
REF
ANY, device, user, display:
REF
ANY] ~ {
d: Data ~ NARROW[self.data];
IF d.v=
NIL
OR d.v.destroyed
THEN {
[d.in, d.out] ¬ ViewerIO.CreateViewerStreams[d.name.Concat[" script"]];
d.v ¬ ViewerIO.GetViewerFromStream[d.out];
d.out.PutF1["%g\n", [time[BasicTime.Now[]]]];
};
IF device#
NIL
OR user#
NIL
OR display#
NIL
THEN {
d.out.PutChar['(];
IF device#
NIL
THEN d.out.PutF1["%g,", [refAny[device]] ]
ELSE d.out.PutRope["?,"];
IF user #
NIL
THEN d.out.PutF1["%g,", [refAny[user]] ]
ELSE d.out.PutRope["?,"];
IF display #
NIL
THEN d.out.PutF1["%g)", [refAny[display]] ]
ELSE d.out.PutRope["?)"];
};
d.out.PutChar[':];
FOR input ¬ input, input.rest
WHILE input#
NIL
DO
d.out.PutChar[' ];
PutRefAnyInternal[d.out, input.first, d];
ENDLOOP;
d.out.PutRope["\n\n"];
RETURN};
FmtRefAny:
PUBLIC
PROC [ra:
REF
ANY]
RETURNS [
ROPE] ~ {
to: IO.STREAM ~ IO.ROS[];
PutRefAny[to, ra];
RETURN to.RopeFromROS[]};
PutRefAny:
PUBLIC
PROC [to:
IO.
STREAM, ra:
REF] ~ {
PutRefAnyInternal[to, ra, NIL];
};
PutRefAnyInternal:
PROC [to:
IO.
STREAM, ra:
REF, data: Data] ~ {
WITH ra
SELECT
FROM
x: REF UserInputPrivate.Rep => to.PutRope["Handle"];
x: ROPE => to.PutF1["\"%g\" (ROPE)", [rope[x]] ];
x: ATOM => to.PutF1["$%g", [atom[x]] ];
x: REF CHAR => to.PutF1["'%c", [character[x]] ];
x: REF TEXT => to.PutF1["\"%g\" (REF TEXT)", [text[x]] ];
x: REF READONLY TEXT => to.PutF1["\"%q\"", [text[x]] ];
x: REF INT => to.PutF1["%g", [integer[x]] ];
x: TIPUser.TIPScreenCoords => to.PutF["<%g, %g, %g>", [integer[x.mouseX]], [integer[x.mouseY]], [boolean[x.color]] ];
x: UserInputGetActions.InputAction => PutIA[to, x, data];
x:
LIST
OF
REF
ANY => {
to.PutRope["LIST["];
FOR lra:
LIST
OF
REF
ANY ¬ x, lra.rest
WHILE lra#
NIL
DO
PutRefAnyInternal[to, lra.first, data];
IF lra.rest#NIL THEN to.PutRope[", "];
ENDLOOP;
to.PutRope["]"]};
ENDCASE => to.PutF1["%g", [refAny[ra]] ]};
nilRope: ROPE = "NIL";
PutIA:
PROC [to:
IO.
STREAM, ria: UserInputGetActions.InputAction, data: Data ¬
NIL] ~ {
to.PutF1["<kind: %g, ", [atom[ria.kind]] ];
to.PutF1["eventTime: %g, ", [cardinal[ria.eventTime]] ];
to.PutF1["deltaTime: %g, ", [integer[ria.deltaTime]] ];
to.PutF1["device: %g, ", IF ria.device#NIL THEN [atom[NARROW[ria.device]]] ELSE [rope[nilRope]] ];
IF ria.user#NIL THEN to.PutF1["user: %g, ", IF ria.user#NIL THEN [atom[NARROW[ria.user]]] ELSE [rope[nilRope]] ];
IF ria.data#NIL THEN to.PutF1["data: %g, ", IF ria.data#NIL THEN [refAny[ria.data]] ELSE [rope[nilRope]] ];
to.PutF1["down: %g, ", [boolean[ria.down]] ];
to.PutF["keyCode: %g (%b), ", [cardinal[ria.keyCode.ORD]], [cardinal[ria.keyCode.ORD]] ];
to.PutF1["preferredSym: %g, ", [cardinal[ria.preferredSym]] ];
to.PutF1["x: %g, ", [integer[ria.x]] ];
to.PutF1["y: %g, ", [integer[ria.y]] ];
to.PutF1["rx: %g, ", [real[ria.rx]] ];
to.PutF1["ry: %g", [real[ria.ry]] ];
IF ria.display#NIL THEN to.PutF1[", display: %g", IF ria.display#NIL THEN [atom[NARROW[ria.display]]] ELSE [rope[nilRope]] ];
IF ria.ref#NIL THEN to.PutF1[", ref: %g", IF ria.ref#NIL THEN [refAny[ria.ref]] ELSE [rope[nilRope]] ];
to.PutChar['>];
IF data#
NIL
THEN {
IF RelativeTimes.InlineIsLaterTime[ria.eventTime, data.lastEventTime] THEN to.PutRope["\nTHE CLOCK IS RUNNING BACKWARDS!\n"];
data.lastEventTime ¬ ria.eventTime;
};
};
<<
PutAB:
PROC [to:
IO.
STREAM, rab:
REF UserInput.ActionBody] ~ {
to.PutF["[deltaTime: %g, ", [integer[rab.deltaTime]] ];
WITH rab
SELECT
FROM
x: REF deltaEventTime UserInput.ActionBody => to.PutRope["deltaEventTime[]]"];
x: REF keyDown UserInput.ActionBody => to.PutF["keyDown[%g, %g]]", [cardinal[x.keyCode]], [cardinal[x.preferredSym]] ];
x: REF keyStillDown UserInput.ActionBody => to.PutF["keyStillDown[%g, %g]]", [cardinal[x.keyCode]], [cardinal[x.preferredSym]] ];
x: REF keyUp UserInput.ActionBody => to.PutF["keyUp[%g, %g]]", [cardinal[x.keyCode]], [cardinal[x.preferredSym]] ];
x: REF allUp UserInput.ActionBody => to.PutRope["allUp[]]"];
x: REF eventTime UserInput.ActionBody => to.PutF["eventTime[%g]]", [cardinal[x.eventTime]] ];
x: REF mousePosition UserInput.ActionBody => to.PutF["mousePosition[%g, %g, %g]]", [integer[x.mousePosition.mouseX]], [integer[x.mousePosition.mouseY]], [boolean[x.mousePosition.color]] ];
x: REF fakeMouseMotion UserInput.ActionBody => to.PutRope["fakeMouseMotion[]]"];
x: REF penPosition UserInput.ActionBody => to.PutF["penPosition[%g, %g, %g]]", [integer[x.penPosition.mouseX]], [integer[x.penPosition.mouseY]], [boolean[x.penPosition.color]] ];
x: REF end UserInput.ActionBody => to.PutRope["end[]]"];
x: REF timedOut UserInput.ActionBody => to.PutRope["timedOut[]]"];
ENDCASE => to.PutRope["??]"];
RETURN};
>>
CreateTest:
PROC [tipFileName:
ROPE, tipTable: TIPUser.TIPTable] ~ {
d: Data ¬ NEW [DataObj ¬ [name: tipFileName, lastEventTime: [0]]];
v: Viewer ¬ ViewerOps.CreateViewer[testClass.flavor, [class: testClass, name: tipFileName.Concat[" tester"], tipTable: tipTable, data: d]];
};
ListMapping:
PROC [out:
IO.
STREAM] ~ {
vw: ViewersWorld.Ref ~ ViewersWorldInstance.GetWorld[];
uih: UserInput.Handle ~ ViewersWorld.GetInputHandle[vw];
km: KeyMapping.Mapping ~ UserInputOps.GetMapping[uih];
skipped: NAT ¬ 0;
FOR kc: KeyTypes.KeyCode
IN KeyTypes.KeyCode
DO
n: NAT ~ KeyMapping.CountKeySyms[km, kc];
IF n=0 THEN skipped ¬ skipped.SUCC
ELSE {
out.PutF1["%g:", [cardinal[kc.ORD]]];
FOR i:
NAT
IN [0 .. n)
DO
ks: KeyTypes.KeySym ~ KeyMapping.GetKeySym[km, kc, i];
name: ROPE ~ KeyNames.NameFromKeySym[ks];
IF NOT name.IsEmpty[] THEN out.PutF[" %g:%g", [rope[name]], [cardinal[ks]]] ELSE out.PutF1[" %g", [cardinal[ks]]];
ENDLOOP;
out.PutRope["\n"];
};
ENDLOOP;
out.PutF1["%g KeyCode(s) skipped due to empty mapping.\n", [integer[skipped]] ];
RETURN};
UserInputSpy:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
vw: ViewersWorld.Ref ~ ViewersWorldInstance.GetWorld[];
uih: UserInput.Handle ~ ViewersWorld.GetInputHandle[vw];
ch: UserInput.Handle;
plusTime: BOOL ¬ FALSE;
needTime: BOOL ¬ TRUE;
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
tH: BasicTime.GMT;
msH: INT;
IF argv.argc<1 OR argv.argc>2 THEN RETURN [$Failure, "Usage: UserInputSpy [+time|-time]"];
IF argv.argc=2
THEN
SELECT
TRUE
FROM
argv[1].Equal["+time", FALSE] => plusTime ¬ TRUE;
argv[1].Equal["-time", FALSE] => plusTime ¬ FALSE;
ENDCASE => RETURN [$Failure, "Usage: UserInputSpy [+time|-time]"];
ch ¬ UserInputOps.Create[];
{ENABLE UNWIND => UserInputOps.Close[ch];
UserInputLookahead.SaveState[ch, uih];
DO
ia: UserInputGetActions.InputAction ~ UserInputGetActions.GetInputAction[ch];
IF needTime
THEN {
[tH, msH] ¬ UserInputOps.GetAbsoluteTime[uih, ia.eventTime];
cmd.out.PutF["TimeStamp %g corresponds to %g ms past %g.\n", [cardinal[ia.eventTime]], [integer[msH]], [time[tH]] ];
needTime ¬ FALSE};
Process.CheckForAbort[];
IF
NOT plusTime
THEN
SELECT ia.kind
FROM
$EventTime, $TimeIsPassing => LOOP;
ENDCASE => NULL;
PutRefAny[cmd.out, ia];
cmd.out.PutRope["\n"];
IF ia.kind = $End THEN EXIT;
ENDLOOP;
};
UserInputOps.Close[ch];
RETURN};
Expand:
PROC [in, out:
IO.
STREAM] ~ {
fh: GPM.Handle ~ GPM.Open[in];
fh.startCall ¬ '[;
fh.endCall ¬ '];
fh.singleQuote ¬ 004C;
fh.startQuote ¬ '(;
fh.endQuote ¬ ');
fh.sepArg ¬ ',;
fh.numArg ¬ '~;
GPM.DumpToStream[out, fh];
RETURN};
ListMappingCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
ListMapping[cmd.out];
RETURN};
TPPCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
Expand[cmd.in, cmd.out !GPM.Error => {result ¬ $Failure; msg ¬ IO.PutFR["GPM.Error[%g, %g]", [rope[SELECT ec FROM MacroError => "MacroError", EndOfStream => "EndOfStream", ENDCASE => ERROR]], [rope[errorMsg]]]; CONTINUE}];
RETURN};
TIPReadCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
IF argv.argc<1 THEN RETURN [NIL, "Usage: TIPRead tipFileName ..."];
FOR i:
NAT
IN [1 .. argv.argc)
DO
[] ¬ TIPUser.InstantiateNewTIPTable[argv[i] !
TIPUser.InvalidTable => {result ¬ $Failure; msg ¬ errorMsg; CONTINUE};
PFS.Error => {result ¬ $Failure; msg ¬ error.explanation; CONTINUE}
];
ENDLOOP;
RETURN};
TIPTestCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
name: ROPE ¬ NIL;
tip: TIPUser.TIPTable ¬ NIL;
IF argv.argc<1 THEN RETURN [NIL, "Usage: TIPTest tipFileName ..."];
FOR i:
NAT
DECREASING
IN [1 .. argv.argc)
DO
this: TIPUser.TIPTable ~ TIPUser.InstantiateNewTIPTable[argv[i] !
TIPUser.InvalidTable => {msg ¬ errorMsg; GOTO Dun};
PFS.Error => {msg ¬ error.explanation; GOTO Dun}];
IF tip#
NIL
THEN {
[] ¬ TIPLinking.Append[this, tip];
name ¬ argv[i].Cat["; ", name]}
ELSE name ¬ argv[i];
tip ¬ this;
ENDLOOP;
CreateTest[name, tip];
RETURN;
EXITS Dun => result ¬ $Failure};
TransparentTIPTestCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
CreateTest["transparent TIP table", TIPUser.TransparentTIPTable[]];
RETURN};
IdentityTIPTestCmd:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ¬
NIL, msg:
ROPE ¬
NIL]
--Commander.CommandProc-- ~ {
plusTime: BOOL ¬ cmd.procData.clientData = $PlusTime;
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
IF argv.argc<1 OR argv.argc>2 THEN RETURN [$Failure, "Usage: IdentityTIPTest [+time|-time]"];
IF argv.argc=2
THEN
SELECT
TRUE
FROM
argv[1].Equal["+time", FALSE] => plusTime ¬ TRUE;
argv[1].Equal["-time", FALSE] => plusTime ¬ FALSE;
ENDCASE => RETURN [$Failure, "Usage: IdentityTIPTest [+time|-time]"];
CreateTest[IO.PutFR1["identity (plusTime=%g) TIP table", [boolean[plusTime]] ], TIPIdentity.IdentityTIPTable[plusTime]];
};
PrintDown: Commander.CommandProc = {
uih: Handle ¬ ViewersWorld.GetInputHandle[ViewersWorldInstance.GetWorld[]];
km: KeyMapping.Mapping ¬ UserInputOps.GetMapping[uih];
PrintIfDown:
PROC [keySym: KeyTypes.KeySym]
RETURNS [done:
BOOL ←
FALSE]
--KeyMapping.WalkKeySymsProc-- = {
success: BOOL ¬ FALSE;
IF UserInputOps.GetLatestKeySymState[uih, keySym] = down
THEN {
kcs: KeyMapping.KeyCodes ← KeyMapping.KeyCodesFromKeySym[km, keySym];
cmd.out.PutF["Down: %g [%g] because down:", [rope[KeyNames.NameFromKeySym[keySym]]], [integer[keySym]] ];
FOR i:
NAT
IN [0 .. kcs.n)
DO
cmd.out.PutF[" %g(%g)", [cardinal[kcs[i].keyCode.ORD]], [integer[kcs[i].glyphIndex]] ];
ENDLOOP;
cmd.out.PutRope["\n"];
};
RETURN};
[] ¬ KeyMapping.WalkKeySyms[km, PrintIfDown];
};
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Grab Input Focus", GrabInputFocus]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["CaptureButtons", CaptureButtons]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["ReleaseButtons", ReleaseButtons]];
ViewerOps.RegisterViewerClass[testClass.flavor, testClass];
Commander.Register["TPP", TPPCmd, "Tip PreProcessor (reads stdin, writes stdout)"];
Commander.Register["TIPRead", TIPReadCmd, "TIPRead tipFileName ... tries to read TIP tables, hopefully catching and printing errors in a useful way"];
Commander.Register["TIPTest", TIPTestCmd, "TIPTest tipFileName - creates a testing viewer for the given TIP table"];
Commander.Register["TransparentTIPTest", TransparentTIPTestCmd, "creates a testing viewer for a transparent TIP table"];
Commander.Register["IdentityTIPTest", IdentityTIPTestCmd, "[+time|-time] --- creates a testing viewer for an Identity TIP table"];
Commander.Register["IdentityPlusTimeTIPTest", IdentityTIPTestCmd, "creates a testing viewer for an Identity TIP table", $PlusTime];
Commander.Register["ListMapping", ListMappingCmd, "list mapping from KeyCodes to KeySyms"];
Commander.Register["UserInputSpy", UserInputSpy, "[+time|-time] --- write all future input on stdout"];
Commander.Register["TIPPrintDown", PrintDown, "Prints the names of keys that are currently down and all of the KeyCodes(with glyphIndex) that are responsible"];
END.