TIPMatcherImpl.mesa
Copyright Ó 1985, 1986, 1991, 1992 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) October 21, 1985 10:09:08 pm PDT
Bier, September 30, 1993 11:52 am PDT
Michael Plass, May 25, 1989 4:35:44 pm PDT
Christian Jacobi, August 25, 1992 2:19 pm PDT
Kenneth A. Pier, August 24, 1992 12:30 pm PDT
Willie-s, December 18, 1991 12:18 pm PST
Doug Wyatt, August 19, 1992 2:54 pm PDT
DIRECTORY
Atom, Devices, DeviceTypes, FastTRAPDevice, IO, KeyChars, KeyMapping, KeyStateTypes, KeySyms1, KeySymsKB, KeySymsTrackball, KeyTypes, Process, Real, RefTab, Rope, RuntimeError, ScreenCoordsTypes, TIPFastTables, TIPIdentity, TIPPredicate, TIPPrivate, TIPPrivateTypes, TIPResults, TIPTables, TIPTypes, TIPUser, UserInput, UserInputGetActions, UserInputLookahead, UserInputOps, UserInputPrivate, UserInputTypes, Vector2;
TIPMatcherImpl: CEDAR PROGRAM
IMPORTS Atom, Devices, FastTRAPDevice, IO, KeyChars, KeyMapping, Process, RefTab, RuntimeError, TIPFastTables, TIPPrivate, UserInputGetActions, UserInputLookahead, UserInputOps
EXPORTS TIPIdentity, TIPPredicate, TIPTypes, TIPPrivate, TIPPrivateTypes, TIPResults, TIPUser, UserInput = BEGIN
HandleRep: PUBLIC TYPE = UserInputPrivate.Rep; -- UserInput.HandleRep
Handle: TYPE = REF HandleRep;
DeviceState: TYPE = DeviceTypes.DeviceState;
InputActionBody: TYPE = UserInputGetActions.InputActionBody;
KeyCode: TYPE = KeyTypes.KeyCode;
KeySym: TYPE = KeyTypes.KeySym;
KeySyms: TYPE = KeyMapping.KeySyms;
KeyboardState: TYPE = KeyStateTypes.KeyboardState;
MouseEvent: TYPE = TIPPrivate.MouseEvent;
MousePosition: TYPE = ScreenCoordsTypes.TIPScreenCoordsRec;
TIPButtonProc: TYPE = TIPPrivate.TIPButtonProc;
TIPChoice: TYPE = TIPTables.TIPChoice;
TIPChoiceSeries: TYPE = TIPTables.TIPChoiceSeries;
TIPClient: TYPE = TIPPrivate.TIPClient;
TIPClientRec: TYPE = TIPPrivate.TIPClientRec;
TIPFastTable: TYPE = TIPTables.TIPFastTable;
TIPKeyState: TYPE = TIPTables.TIPKeyState;
TIPNotifyProc: TYPE = TIPPrivate.TIPNotifyProc;
TIPParseInfo: TYPE = TIPPrivate.TIPParseInfo;
TIPParseInfoRec: TYPE = TIPPrivate.TIPParseInfoRec;
TIPScreenCoords: TYPE = TIPUser.TIPScreenCoords;
TIPScreenCoordsRec: TYPE = TIPUser.TIPScreenCoordsRec;
TIPTable: TYPE = TIPTypes.TIPTable;
TIPTableRep: PUBLIC <<TIPTypes>> TYPE = TIPPrivateTypes.TIPTableRep;
TIPTableImpl: TYPE = REF TIPTables.TIPTableImplRep;
TIPTableImplRep: PUBLIC <<TIPPrivateTypes>> TYPE = TIPTables.TIPTableImplRep;
TIPTerm: TYPE = TIPTables.TIPTerm;
TIPTime: TYPE = TIPUser.TIPTime;
UpDown: TYPE = KeyStateTypes.UpDown;
CONTROL: KeyTypes.KeySym = KeySymsKB.LeftControl;
LeftShift: KeyTypes.KeySym = KeySymsKB.LeftShift;
RightShift: KeyTypes.KeySym = KeySymsKB.RightShift;
ShiftLock: KeyTypes.KeySym = KeySymsKB.ShiftLock;
CapsLock: KeyTypes.KeySym = KeySymsKB.CapsLock;
transparentTIPTable: TIPTable ~ MakeTransparentTIPTable[];
identityTIPTable: TIPTable ~ MakeIdentityTIPTable[plusTime: FALSE];
identityPlusTimeTIPTable: TIPTable ~ MakeIdentityTIPTable[plusTime: TRUE];
mouseGrainCreek: Handle ¬ UserInputOps.Create[]; -- only for setting recording grain
MakeTransparentTIPTable: PROC [] RETURNS [TIPTable] = {
impl: TIPTables.TIPTableImpl ~ NEW[TIPTables.TIPTableImplRep ¬ [variants: transparent[]]];
RETURN [NEW[TIPPrivateTypes.TIPTableRep ¬ [impl: impl]]];
};
MakeIdentityTIPTable: PROC [plusTime: BOOL] RETURNS [TIPTable] = {
impl: TIPTableImpl ¬ NEW[TIPTableImplRep ¬ [variants: identity[plusTime: plusTime]]];
RETURN[NEW[TIPTableRep ¬ [impl: impl]]];
};
TransparentTIPTable: PUBLIC PROC RETURNS [table: TIPTable] = {
RETURN[transparentTIPTable];
};
IdentityTIPTable: PUBLIC PROC [plusTime: BOOL ¬ FALSE] RETURNS [identity: TIPTable] = {
RETURN[IF plusTime THEN identityPlusTimeTIPTable ELSE identityTIPTable];
};
DiscardTypeAhead: PUBLIC PROC [user: TIPClient] = {
discard any mouse/keyboard events not yet processed
UserInputOps.SetAtLatest[user.parseInfo.inCreek];
};
ResetTIPContext: PUBLIC PROC [user: TIPClient, table: TIPTable, notify: TIPNotifyProc, interrupt: BOOL ¬ FALSE] = TRUSTED {
user.parseInfo.tableHead ¬ table;
user.notifyProc ¬ notify;
IF interrupt THEN Interrupt[user, FALSE];
};
InterruptTIP: PUBLIC PROC [self: TIPClient] = {
Forces TIP interpreter to top level state.
Wizards only, please.
ERROR; --unimplemented because no external clients were found; ChJ, August 25, 1992
Interrupt[self, FALSE]
};
Interrupt: PROC [self: TIPClient, destroy: BOOL ¬ FALSE] = {
matcher: PROCESS ~ self.matcher;
IF matcher#NIL THEN {
IF destroy THEN self.matcher ¬ NIL;
Process.Abort[matcher ! Process.InvalidProcess => CONTINUE];
};
};
MatchProcess: PROC [user: TIPClient, doneFlag: REF BOOL] = {
A TIPClient includes the parsed form of a tip table, a notify proc to call, and a stream, user.parseInfo.inCreek, at which we receive actions.
ENABLE RuntimeError.Uncaught => StartTIPClient[user]; -- the old matcher is dead
self: PROCESS ~ Process.GetCurrent[];
Keep two copies of screen coords so that client can overwrite passed copy
privateTSC: TIPScreenCoords ~ NEW[TIPScreenCoordsRec ¬ [0, 0, FALSE]];
userTSC: TIPScreenCoords ~ NEW[TIPScreenCoordsRec];
user.matcher ¬ self;
doneFlag­ ¬ TRUE;
TRUSTED {Process.SetPriority[Process.priorityForeground]}; -- dequeing is important
WHILE user.matcher=self DO
ENABLE ABORTED => LOOP;
Aborted is expected to be caught in these two situations:
1) when DestroyClient is called to flush the tip process (inCreek=NIL)
2) InterruptTIP is called to change the table and flush pending state
WHILE user.matcher=self DO -- until Interrupt is called
MatchLoop[user, privateTSC, userTSC];
ENDLOOP;
ENDLOOP;
};
MatchLoop: PROC [user: TIPClient, privateTSC: TIPScreenCoords, userTSC: TIPScreenCoords] = {
a: InputActionBody;
results: LIST OF REF;
UserInputLookahead.SaveState[saved: user.parseInfo.localCreek, handle: user.parseInfo.inCreek];
a ¬ UserInputGetActions.GetInputActionBody[handle: user.parseInfo.inCreek,
waitMode: forever, acceptance: all];
SELECT a.kind FROM
$KeyStillDown, $AllUp, $Enter, $Exit, $TimeOut, $End, $TimeIsPassing, $EventTime => RETURN;
ENDCASE;
CodeTimer.StartInt[$MatchLoop, $TIP];
BEGIN
IF user.buttonProc#NIL THEN { -- give the buttonProc a chance to parse the event
mouseEvent: MouseEvent ¬ buttonUp;
SELECT a.kind FROM
$IntegerPosition, $FakePosition, $Position => {
inCreek: Handle ~ user.parseInfo.inCreek;
p: MousePosition ~ inCreek.mousePosition;
userTSC­ ¬ privateTSC­ ¬ [mouseX: p.mouseX, mouseY: p.mouseY, color: p.color];
mouseEvent ¬ motion;
};
$Key =>
IF UserInputOps.IsMouseButton[user.parseInfo.inCreek, a.keyCode]
THEN {
userTSC­ ¬ privateTSC­;
mouseEvent ¬ IF a.down THEN buttonDown ELSE buttonUp;
}
ELSE GOTO ParseNormally;
ENDCASE => GOTO ParseNormally;
IF user.buttonProc[userTSC, mouseEvent, user.parseInfo.localCreek, user.clientData, a.device, a.user, a.display, a.eventSource]
THEN [] ¬ UserInputLookahead.RestoreState[saved: user.parseInfo.localCreek, handle: user.parseInfo.inCreek]
ELSE GOTO ParseNormally;
}
ELSE GOTO ParseNormally;
EXITS
ParseNormally => {
IF user.parseInfo.tableHead#NIL THEN
SELECT a.kind FROM
$IntegerPosition, $Position, $Key, $Ref =>
results ¬ WideMatchEvent[user.parseInfo, a];
ENDCASE => ERROR; -- unexpected ActionKind
IF results#NIL THEN
user.notifyProc[results: results, clientData: user.clientData, device: a.device, user: a.user, display: a.display, eventSource: a.eventSource];
};
END;
CodeTimer.StopInt[$MatchLoop, $TIP];
};
WideParseOneEvent: PUBLIC PROC [parseInfo: TIPParseInfo] RETURNS [result: LIST OF REF ANY] = {
RETURN[WideMatchEvent[parseInfo, UserInputGetActions.GetInputActionBody[handle: parseInfo.inCreek, waitMode: forever, acceptance: clicksAndMotion]]];
};
transparentAction: REF UserInput.ActionBody ~ NEW[UserInput.ActionBody];
transparentResult: LIST OF REF ~ LIST[NIL, transparentAction];
DKW: gross hack to avoid excessive allocation when using a transparent TIP table
we trust that only one process is using this!
But Christian Jacobi is experimenting with multi-process worlds now. -- Bier, September 30, 1991
identityAction: UserInputGetActions.InputAction ← NEW[InputActionBody];
identityResult: LIST OF REF ~ LIST[NIL, identityAction];
MatchRefKey: PROC [action: InputActionBody, term: keyTrigger TIPTerm] RETURNS [eventMatch: BOOL ¬ FALSE] = {
See if this is a trackball key event.
WITH action.ref SELECT FROM
change: DeviceTypes.DeviceStateChange => {
deviceClassName: ATOM ¬ Devices.NameOfClass[change.class];
SELECT deviceClassName FROM
$FastTRAP => {
expanded: FastTRAPDevice.ExpandedChange;
expanded ¬ FastTRAPDevice.UnpackChange[change];
WITH c: expanded SELECT FROM
key => {
IF c.down THEN {
SELECT c.key FROM
left => { -- left button went down
eventMatch ¬ term.keyState.keySym = KeySymsTrackball.TrackballLeft AND term.keyState.state=down
};
middle => {
eventMatch ¬ term.keyState.keySym = KeySymsTrackball.TrackballMiddle AND term.keyState.state=down
};
right => { -- set up to scroll scene
eventMatch ¬ term.keyState.keySym = KeySymsTrackball.TrackballRight AND term.keyState.state=down
};
ENDCASE => ERROR;
}
ELSE {
SELECT c.key FROM
left => { -- left button went down
eventMatch ¬ term.keyState.keySym = KeySymsTrackball.TrackballLeft AND term.keyState.state=up
};
middle => {
eventMatch ¬ term.keyState.keySym = KeySymsTrackball.TrackballMiddle AND term.keyState.state=up
};
right => { -- set up to scroll scene
eventMatch ¬ term.keyState.keySym = KeySymsTrackball.TrackballRight AND term.keyState.state=up
};
ENDCASE => ERROR;
};
};
trackball => NULL;
wheel => NULL;
ENDCASE; -- strange trackball event
};
ENDCASE; -- not a FastTRAP
};
ENDCASE; -- not a change, that's strange.
};
MatchRefTrackball: PROC [action: InputActionBody, term: trackballTrigger TIPTerm] RETURNS [eventMatch: BOOL ¬ FALSE, trackballChange: Vector2.VEC ¬ [0,0]] = {
See if this is a FastTRAP trackball event.
WITH action.ref SELECT FROM
change: DeviceTypes.DeviceStateChange => {
deviceClassName: ATOM ¬ Devices.NameOfClass[change.class];
SELECT deviceClassName FROM
$FastTRAP => {
expanded: FastTRAPDevice.ExpandedChange;
expanded ¬ FastTRAPDevice.UnpackChange[change];
WITH c: expanded SELECT FROM
key => NULL;
trackball => {
trackballChange ← [c.deltaX, c.deltaY];
eventMatch ← TRUE;
};
wheel => NULL;
ENDCASE; -- strange trackball event
};
ENDCASE; -- not a FastTRAP
};
ENDCASE; -- not a change, that's strange.
};
MatchRefThumbwheel: PROC [action: InputActionBody, term: thumbwheelTrigger TIPTerm] RETURNS [eventMatch: BOOL ¬ FALSE, thumbwheelChange: INTEGER ¬ 0] = {
WITH action.ref SELECT FROM
change: DeviceTypes.DeviceStateChange => {
deviceClassName: ATOM ¬ Devices.NameOfClass[change.class];
SELECT deviceClassName FROM
$FastTRAP => {
expanded: FastTRAPDevice.ExpandedChange;
expanded ¬ FastTRAPDevice.UnpackChange[change];
WITH c: expanded SELECT FROM
key => NULL;
trackball => NULL;
wheel => {
thumbwheelChange ← c.delta;
eventMatch ← TRUE;
};
ENDCASE; -- strange trackball event
};
ENDCASE; -- not a FastTRAP
};
ENDCASE; -- not a change, that's strange.
};
MatchKeyKeyTrigger: PROC [handle: Handle, action: InputActionBody, term: keyTrigger TIPTerm] RETURNS [eventMatch: BOOL ¬ FALSE] = {
keySym: KeySym;
SELECT action.kind FROM
$Key => {
keySyms: KeySyms ¬ KeyMapping.GetKeySyms[handle.mapping, action.keyCode];
FOR i: NAT IN [0..keySyms.n) DO
keySym ¬ keySyms[i];
IF action.down THEN {
IF term.keyState.keySym = keySym AND term.keyState.state=down
THEN GOTO Found;
}
ELSE {
IF term.keyState.keySym = keySym AND term.keyState.state=up
THEN GOTO Found;
};
REPEAT
Found => eventMatch ¬ TRUE;
ENDLOOP;
};
$Ref => eventMatch ¬ MatchRefKey[action, term];
ENDCASE; -- surprise action from UserInput
};
MatchTimeTrigger: PROC [parseInfo: TIPParseInfo, handle: Handle, term: timeTrigger TIPTerm] RETURNS [eventMatch: BOOL ¬ FALSE, action: InputActionBody] = {
copy local handle for checking time since no "putback"
UserInputLookahead.SaveState[saved: parseInfo.timeCreek, handle: handle];
action ¬ UserInputGetActions.GetInputActionBody[handle: parseInfo.timeCreek,
waitMode: timed, waitInterval: term.mSecs,
acceptance: clicks];
Gets the next click event if one comes before term.mSecs. Otherwise, returns $TimeOut.
eventMatch ¬ SELECT action.kind FROM
$TimeOut => term.flavor=gt,
ENDCASE => term.flavor=lt;
UserInputOps.Close[parseInfo.timeCreek]; -- so garbage collection can proceed
};
WideMatchEvent: PUBLIC PROC [parseInfo: TIPParseInfo, a: InputActionBody] RETURNS [result: LIST OF REF ¬ NIL] = TRUSTED {
Invariants:
(1) Either (copied = FALSE and handle = parseInfo.inCreek) or copied = TRUE and handle = parseInfo.localCreek).
(2) GetAction is never performed on parseInfo.inCreek. If a match is found, the matched items are atomically removed from parseInfo.inCreek by the "result" case of MatchChoice.
(3) Upon return, parseInfo.creekStack[i] for i >= stackPointer and parseInfo.localCreek are closed.
handle: Handle;
action: InputActionBody;
firstAccess, copied: BOOL ¬ FALSE;
advanced: BOOL ¬ FALSE;
Tells whether the Handle on top of the stack has been changed at all
Used to eliminate unnecessary copying of handles
stackPointer: CARDINAL ¬ 0;
ClearHandleStack: PROC[] = TRUSTED {
FOR i: NAT IN [0..stackPointer) DO
UserInputOps.Close[parseInfo.creekStack[i]];
ENDLOOP;
stackPointer ¬ 0;
UserInputOps.Close[parseInfo.localCreek];
};
PushHandle: PROC[] = TRUSTED {
UserInputLookahead.SaveState[saved: parseInfo.creekStack[stackPointer], handle: handle];
stackPointer ¬ stackPointer + 1;
advanced ¬ FALSE;
};
CopyTopHandle: PROC = TRUSTED {
Uses parseInfo.localCreek as implicit parameter, assuming handle = localCreek
IF advanced THEN {
UserInputLookahead.RestoreState[parseInfo.creekStack[stackPointer-1], handle];
advanced ¬ FALSE;
};
};
PopHandle: PROC = TRUSTED {
stackPointer ¬ stackPointer - 1;
UserInputOps.Close[parseInfo.creekStack[stackPointer]];
};
GetHandleAction: PROC [acceptance: UserInputTypes.Acceptance ¬ clicks] = TRUSTED {
IF firstAccess
THEN {
firstAccess ¬ FALSE;
handle ¬ parseInfo.inCreek;
action ¬ a; -- the parameter of MatchEvent
copied ¬ FALSE;
}
ELSE {
IF ~copied THEN {
copied ¬ TRUE;
UserInputLookahead.SaveState[saved: parseInfo.localCreek, handle: parseInfo.inCreek];
handle ¬ parseInfo.localCreek;
};
action ¬ UserInputGetActions.GetInputActionBody[handle: handle,
waitMode: forever,
acceptance: acceptance];
advanced ¬ TRUE;
};
};
MatchChoice: PROC [choice: TIPChoice] RETURNS [result: LIST OF REF ¬ NIL] = TRUSTED {
eventMatch will stay TRUE until some term fails to match the event. If we get a complete match, we return it. Otherwise, by setting firstAccess to TRUE, we move back to the beginning of the handle so the next call to MatchChoice begins with the same event.
eventMatch: BOOL ¬ TRUE;
trackballChange: Vector2.VEC ← [0, 0];
thumbwheelChange: INTEGER ← 0;
To match this TIP choice ("line" of the TIP table), the current event much satisfy each of the terms (e.g., Red Up WHILE Yellow Up WHILE Blue Up).
FOR terms: TIPChoice ¬ choice, terms.rest UNTIL ~eventMatch OR terms=NIL DO
WITH term: terms.first SELECT FROM
keyTrigger => { -- e.g., "A Down =>" or "TrackballLeft Up =>"
GetHandleAction[clicks];
If this is the first term, then get the first action, whatever it is. Otherwise, skip over mouse actions until we find a key action (waiting forever if necessary)
eventMatch ¬ MatchKeyKeyTrigger[handle, action, term];
};
trackballTrigger => { -- e.g., "Trackball =>"
GetHandleAction[clicksAndMotion];
IF action.kind = $Ref THEN [eventMatch, trackballChange] ¬ MatchRefTrackball[action, term]
ELSE eventMatch ¬ FALSE;
};
thumbwheelTrigger => { -- e.g., "Thumbwheel =>"
GetHandleAction[clicksAndMotion];
IF action.kind = $Ref THEN [eventMatch, thumbwheelChange] ¬ MatchRefThumbwheel[action, term]
ELSE eventMatch ¬ FALSE;
};
mouseTrigger => { -- e.g., "Mouse =>"
GetHandleAction[clicksAndMotion];
eventMatch ¬ SELECT action.kind FROM
$Position, $IntegerPosition, $FakePosition => TRUE,
ENDCASE => FALSE;
};
timeTrigger => { -- e.g., "BEFORE 200" or "AFTER 200"
IF firstAccess THEN ERROR; -- time events can't be first
[eventMatch, action] ¬ MatchTimeTrigger[parseInfo, handle, term];
};
keyEnable => {
FastTRAPKeyNameFromKeySym: PROC [sym: KeySym] RETURNS [name: FastTRAPDevice.KeyName ¬ left, isFT: BOOL ¬ TRUE] = TRUSTED {
SELECT sym FROM
KeySymsTrackball.TrackballLeft => name ¬ left;
KeySymsTrackball.TrackballMiddle => name ¬ middle;
KeySymsTrackball.TrackballRight => name ¬ right;
ENDCASE => isFT ← FALSE;
};
keyState: UpDown;
ftName: FastTRAPDevice.KeyName;
isFT: BOOL ¬ FALSE;
[ftName, isFT] ¬ FastTRAPKeyNameFromKeySym[term.keyState.keySym];
IF isFT THEN {
ftState: DeviceState ← NARROW[handle.fastTrapState];
eventMatch ¬ FastTRAPDevice.IsDown[ftState, ftName] = (term.keyState.state = down)
}
ELSE {
keyState ¬ UserInputOps.GetKeySymState[handle, term.keyState.keySym];
eventMatch ¬ (term.keyState.state = keyState);
};
};
key2Enable => {
keyState1, keyState2: UpDown;
keyState1 ¬ UserInputOps.GetKeySymState[handle, term.keyState1.keySym];
keyState2 ¬ UserInputOps.GetKeySymState[handle, term.keyState2.keySym];
eventMatch ¬ (term.keyState1.state = keyState1)
OR (term.keyState2.state = keyState2);
};
keyEnableList => {
keyState: UpDown;
eventMatch ¬ FALSE;
FOR lst: LIST OF TIPKeyState ¬ term.lst, lst.rest UNTIL lst=NIL DO
keyState ¬ UserInputOps.GetKeySymState[handle, lst.first.keySym];
IF lst.first.state = keyState THEN {
eventMatch ¬ TRUE; EXIT };
ENDLOOP;
};
predEnable => {
predRef: REF;
found: BOOL;
predicate: REF TIPPredicate.TIPPredicate;
[found, predRef] ¬ RefTab.Fetch[predTable, term.predicate];
IF found
THEN {
predicate ¬ NARROW[predRef];
eventMatch ¬ predicate­[] }
ELSE { eventMatch ¬ FALSE };
};
char => TIPPrivate.stdChar­ ¬ AsciiAction[handle, action];
coords => {
mp: MousePosition ~ handle.mousePosition;
TIPPrivate.stdCoords­ ¬ [mouseX: mp.mouseX, mouseY: mp.mouseY, color: mp.color];
};
trackballChange => {
TIPPrivate.stdTrackballChange­ ¬ trackballChange;
};
thumbwheelChange => {
TIPPrivate.stdThumbwheelChange­ ¬ thumbwheelChange;
};
time => {
TIPPrivate.stdTime­ ¬ UserInputOps.GetTime[handle];
};
nested => {
PushHandle[];
FOR choices: TIPChoiceSeries ¬ term.statement, choices.rest UNTIL choices=NIL DO
result ¬ MatchChoice[choices.first];
IF result#NIL THEN RETURN[result];
CopyTopHandle[];
ENDLOOP;
PopHandle[];
eventMatch ¬ FALSE;
};
result => {
IF copied THEN UserInputLookahead.RestoreState[saved: handle, handle: parseInfo.inCreek];
We've actually made a match, remove all matched tokens from parseInfo.inCreek.
RETURN[term.list];
If coords is returned, term.list contains TIPPrivate.stdCoords.
};
ENDCASE => ERROR;
ENDLOOP;
};
actionKind: ATOM ¬ a.kind;
IF parseInfo.tableHead=transparentTIPTable OR parseInfo.tableHead=identityTIPTable OR parseInfo.tableHead=identityPlusTimeTIPTable THEN {
RETURN[LIST[parseInfo.inCreek, NEW[InputActionBody ¬ a] ]];
};
FOR table: TIPTable ¬ parseInfo.tableHead, IF table.opaque THEN NIL ELSE table.link UNTIL table=NIL DO
tableImpl: TIPTableImpl ~ table.impl;
SELECT actionKind FROM -- for efficiency
$IntegerPosition, $Position, $FakePosition => IF tableImpl.ignore.move THEN LOOP;
$Key => IF a.down THEN {IF tableImpl.ignore.down THEN LOOP}
ELSE {IF tableImpl.ignore.up THEN LOOP};
ENDCASE;
firstAccess ¬ TRUE;
stackPointer ¬ 0;
WITH t: tableImpl SELECT FROM
fast => {
GetHandleAction[]; -- updates action (and thus action)
SELECT action.kind FROM
$IntegerPosition, $Position, $FakePosition => {
result ¬ MatchChoice[t.mouse];
};
$Key => {
primaryKeySym: KeySym ← PrimaryKeySym[handle, action.keyCode];
keySyms: KeySyms ¬ KeyMapping.GetKeySyms[handle.mapping, action.keyCode];
keySym: KeySym;
choice: TIPChoice;
FOR i: NAT IN [0..keySyms.n) DO
keySym ¬ keySyms[i];
IF action.down THEN choice ¬ TIPFastTables.FetchFromFastTable[t.keyDown, keySym]
ELSE choice ¬ TIPFastTables.FetchFromFastTable[t.keyUp, keySym];
IF choice # NIL THEN {
result ¬ MatchChoice[choice];
EXIT;
};
ENDLOOP;
};
ENDCASE;
ClearHandleStack[]; -- so garbage collection proceeds
IF result#NIL THEN RETURN[result];
};
small => {
For each top-level line in the TIP table, try to match that line to the current event on the Handle.
FOR choices: TIPChoiceSeries ¬ t.all, choices.rest UNTIL choices=NIL DO
result ¬ MatchChoice[choices.first];
ClearHandleStack[]; -- so garbage collection proceeds
IF result#NIL THEN RETURN[result];
firstAccess ¬ TRUE;
ENDLOOP;
};
ENDCASE;
ENDLOOP;
};
RefCharFromCharArray: TYPE ~ ARRAY CHAR OF REF CHAR;
InitRefCharFromChar: PROC RETURNS [array: REF RefCharFromCharArray] ~ {
array ¬ NEW[RefCharFromCharArray ¬ ALL[NIL]];
FOR c: CHAR IN CHAR DO array[c] ¬ NEW[CHAR ¬ c] ENDLOOP;
};
refCharFromChar: REF RefCharFromCharArray ~ InitRefCharFromChar[];
StdCoordsRep: TYPE ~ TIPUser.TIPScreenCoordsRec;
StdTrackballChangeRep: TYPE ~ Vector2.VEC;
StdThumbwheelChangeRep: TYPE ~ INTEGER;
StdTimeRep: TYPE ~ TIPUser.TIPTimeObj;
MakeImmutable: PUBLIC PROC [results: LIST OF REF] RETURNS [LIST OF REF] ~ {
IF results=NIL THEN RETURN[NIL] ELSE {
rest: LIST OF REF ~ MakeImmutable[results.rest];
first: REF ¬ results.first;
WITH first SELECT FROM
x: REF CHAR => IF x=TIPPrivate.stdChar THEN first ¬ refCharFromChar[x­];
x: REF StdCoordsRep => IF x=TIPPrivate.stdCoords THEN
first ¬ NEW[StdCoordsRep ¬ x­];
x: REF StdTrackballChangeRep => IF x=TIPPrivate.stdTrackballChange THEN
first ¬ NEW[StdTrackballChangeRep ¬ x­];
x: REF StdThumbwheelChangeRep => IF x=TIPPrivate.stdThumbwheelChange THEN
first ¬ NEW[StdThumbwheelChangeRep ¬ x­];
x: REF StdTimeRep => IF x=TIPPrivate.stdTime THEN
first ¬ NEW[StdTimeRep ¬ x­];
ENDCASE;
RETURN[IF first=results.first AND rest=results.rest THEN results ELSE CONS[first, rest]];
};
};
AsciiAction: PROC [creek: Handle, creekAction: InputActionBody] RETURNS [c: CHAR] = {
If a key has just gone down, and we wish to interpret the key as the Ascii CHAR that a native user of the keyboard would expect to be typing, we find the preferred glyph on the key and convert it to Ascii.
SELECT creekAction.kind FROM
$Key => {
lockDown: BOOL ¬ FALSE;
char: CHAR ¬ PreferredChar[creek, creekAction.keyCode];
IF char=0c THEN RETURN['?];
To produce an ASCII Control Character, we have to use a special mechanism, because Control Characters are not technically glyphs. This is for compatibility with Cedar 7.0:
BEGIN
ctrlDown: BOOL ¬ FALSE;
ctrlDown ¬ UserInputOps.GetKeySymState[creek, KeySymsKB.LeftControl] = down OR UserInputOps.GetKeySymState[creek, KeySymsKB.RightControl] = down;
IF ctrlDown THEN char ¬ VAL[ORD[char] MOD 40B];
END;
RETURN[char];
};
ENDCASE => ERROR; -- Only works when keys go down
};
PreferredChar: PROC [creek: Handle, keyCode: KeyTypes.KeyCode] RETURNS [char: CHAR] = {
keysym: KeySym;
mapping: KeyMapping.Mapping ¬ UserInputOps.GetMapping[creek];
keySym0: KeySym ¬ KeyMapping.GetKeySym[mapping, keyCode, 0];
shiftDown: BOOL ¬ UserInputOps.GetKeySymState[creek, KeySymsKB.LeftShift] = down OR UserInputOps.GetKeySymState[creek, KeySymsKB.RightShift] = down;
IF shiftDown THEN {
IF keySym0 IN [KeySyms1.a..KeySyms1.z] THEN {
keysym ¬ [keySym0.val + KeySyms1.A.val - KeySyms1.a.val];
}
ELSE IF keySym0 IN [KeySyms1.A..KeySyms1.Z] THEN keysym ¬ keySym0
ELSE {
keySym1: KeySym ¬ KeyMapping.GetKeySym[mapping, keyCode, 1];
IF keySym1.val = 0
THEN keysym ¬ keySym0
ELSE keysym ¬ keySym1;
};
}
ELSE {
IF UserInputOps.GetKeySymState[creek, ShiftLock] = down OR UserInputOps.GetKeySymState[creek, CapsLock] = down THEN {
IF keySym0 IN [KeySyms1.a..KeySyms1.z]
THEN {
keysym ¬ [keySym0.val + KeySyms1.A.val - KeySyms1.a.val];
}
ELSE keysym ¬ keySym0;
}
ELSE {
IF keySym0 IN [KeySyms1.A..KeySyms1.Z]
THEN keysym ¬ [keySym0.val + KeySyms1.a.val - KeySyms1.A.val]
ELSE keysym ¬ keySym0;
};
};
char ¬ KeyChars.CharFromKeySym[keysym];
IF char=0C THEN {
count: NAT ¬ KeyMapping.CountKeySyms[mapping, keyCode];
Give the higher guys a chance firsts; we did already a try to consider the shift key
FOR n: NAT IN [2..count) DO
keysym ¬ KeyMapping.GetKeySym[mapping, keyCode, n];
char ¬ KeyChars.CharFromKeySym[keysym];
IF char#0C THEN RETURN [char];
ENDLOOP;
FOR n: NAT IN [0..MIN[count, 2]) DO
keysym ¬ KeyMapping.GetKeySym[mapping, keyCode, n];
char ¬ KeyChars.CharFromKeySym[keysym];
IF char#0C THEN RETURN [char];
ENDLOOP;
};
};
TIPUser facilities
predTable: PUBLIC RefTab.Ref ¬ RefTab.Create[]; -- table for user defined predicates
CreateTIPClient: PUBLIC PROC [notify: TIPNotifyProc ¬ NIL, buttons: TIPButtonProc ¬ NIL, clientData: REF ANY, name: Rope.ROPE ¬ NIL] RETURNS [self: TIPClient] = TRUSTED {
self ¬ NEW[TIPClientRec ¬ [
notifyProc: notify,
buttonProc: buttons,
clientData: clientData,
parseInfo: CreateParseInfo[NIL, name],
matcher: NIL
]];
};
GetInputHandle: PUBLIC PROC [tipClient: TIPClient] RETURNS [handle: Handle] = {
handle ¬ tipClient.parseInfo.inCreek;
};
StartTIPClient: PUBLIC PROC [tipClient: TIPClient] = {
doneFlag: REF BOOL ~ NEW[BOOL ¬ FALSE];
TRUSTED {Process.Detach[ FORK MatchProcess[tipClient, doneFlag] ]};
WHILE ~doneFlag­ DO --we wait just in case the continuation would access tipClient.matcher
Process.Pause[1]
ENDLOOP;
};
DestroyClient: PUBLIC PROC [self: TIPClient] = {
Interrupt[self, TRUE];
};
GetParseInfo: PUBLIC PROC [tipClient: TIPClient] RETURNS [parseInfo: TIPParseInfo] = {
parseInfo ¬ tipClient.parseInfo;
};
CreateParseInfo: PUBLIC PROC [parseTable: TIPTable ¬ NIL, name: Rope.ROPE ¬ NIL] RETURNS [new: TIPParseInfo] = {
StackName: PROC [i: NAT] RETURNS [atom: ATOM] = {
atom ¬ Atom.MakeAtom[IO.PutFR["%g/stack%g", [rope[name]], [integer[i]] ]];
};
PathName: PROC [secondPart: Rope.ROPE] RETURNS [atom: ATOM] = {
atom ¬ Atom.MakeAtom[IO.PutFR["%g/%g", [rope[name]], [rope[secondPart]] ]];
};
IF name=NIL THEN name ¬ "NoName";
new ¬ NEW[TIPParseInfoRec ¬ [
inCreek: UserInputOps.Create[NIL, NIL, PathName["inCreek"]],
localCreek: UserInputOps.Create[NIL, NIL, PathName["localCreek"]],
timeCreek: UserInputOps.Create[NIL, NIL, PathName["timeCreek"]],
tableHead: parseTable
]];
FOR i: NAT IN [0..TIPPrivate.maxTIPNesting) DO
new.creekStack[i] ¬ UserInputOps.Create[NIL, NIL, StackName[i]];
ENDLOOP;
};
PushTIPTable: PUBLIC PROC [user: TIPClient, table: TIPTable, opaque: BOOL] = {
t: TIPTable;
FOR t ¬ table, t.link UNTIL t.link=NIL DO ENDLOOP;
t.link ¬ user.parseInfo.tableHead;
user.parseInfo.tableHead ¬ table;
table.opaque ¬ opaque;
};
PopTIPTable: PUBLIC PROC [user: TIPClient] RETURNS [old: TIPTable] = {
garbage collector will get old table unless the client keeps a reference
old ¬ user.parseInfo.tableHead;
IF old#NIL THEN user.parseInfo.tableHead ¬ old.link;
};
Register: PUBLIC PROC [key: ATOM, p: TIPPredicate.TIPPredicate] = {
RegisterTIPPredicate[key, p];
};
RegisterTIPPredicate: PUBLIC PROC [key: ATOM, p: TIPPredicate.TIPPredicate] = {
a user-defined predicate may be included in the enables list of a TIPTable via this
association mechanism.
[] ¬ RefTab.Store[predTable, key, NEW[TIPPredicate.TIPPredicate ¬ p]];
};
END.