<> <> <> <> DIRECTORY Ascii USING [BS, CR, DEL, ESC, LF, SP, TAB], ClassIncreek USING [Acceptance, ActionBody, ActionKind, CopyIncreek, GetAction, GetPositionFrom, GetTime, Increek, NewStdIncreek, SetAtLatest, SetMouseGrain, ViewPosition], Interminal USING [DownUp, KeyName, KeyState, MousePosition], Process USING [Abort, GetCurrent], RefTab USING [Create, Fetch, Ref, Store], TIPPrivate USING [stdChar, stdCoords, stdTime, TIPButtonProc, TIPClient, TIPClientRec, TIPNotifyProc, TIPParseInfo, TIPParseInfoRec], TIPTables USING [TIPChoice, TIPChoiceSeries, TIPKeyState, TIPTableImplRep], TIPUser USING [TIPPredicate, TIPScreenCoords, TIPScreenCoordsRec, TIPTable, TIPTableRep]; TIPMatcher: CEDAR PROGRAM IMPORTS ClassIncreek, Process, RefTab, TIPPrivate EXPORTS TIPUser, TIPPrivate = { OPEN TIPUser, TIPTables, TIPPrivate; TIPTableImpl: TYPE ~ REF TIPTableImplRep; TIPTableImplRep: PUBLIC TYPE ~ TIPTables.TIPTableImplRep; mouseGrainCreek: ClassIncreek.Increek _ NIL; -- only for setting recording grain transparentTIPTable: TIPTable ~ MakeTransparentTIPTable[]; MakeTransparentTIPTable: PROC RETURNS [TIPTable] = { impl: TIPTableImpl ~ NEW[TIPTableImplRep _ [variants: transparent[]]]; RETURN[NEW[TIPTableRep _ [impl: impl]]]; }; TransparentTIPTable: PUBLIC PROC RETURNS [table: TIPTable] = { RETURN[transparentTIPTable]; }; DiscardTypeAhead: PUBLIC SAFE PROC [user: TIPClient] = TRUSTED { <> ClassIncreek.SetAtLatest[user.parseInfo.inCreek]; }; ResetTIPContext: PUBLIC PROC [user: TIPClient, table: TIPTable, notify: TIPNotifyProc, interrupt: BOOL _ FALSE] = TRUSTED { user.parseInfo.tableHead _ table; user.notifyProc _ notify; ClassIncreek.SetMouseGrain[mouseGrainCreek, IF table=NIL THEN 50 ELSE table.mouseTicks, 1]; IF interrupt THEN Process.Abort[user.matcher]; }; InterruptTIP: PUBLIC UNSAFE PROC [self: TIPClient] = UNCHECKED {Process.Abort[self.matcher]}; <> <> MatchProcess: PUBLIC PROC [user: TIPClient] = TRUSTED { creekAction: ClassIncreek.ActionBody; results: LIST OF REF ANY; <> privateTSC: TIPScreenCoords _ NEW[TIPScreenCoordsRec _ [0, 0, FALSE]]; userTSC: TIPScreenCoords _ NEW[TIPScreenCoordsRec]; UNTIL user.matcher=NIL DO -- until TIP client instance is flushed... ENABLE ABORTED => LOOP; <> <<1) when DestroyClient is called to flush the tip process (inCreek=NIL)>> <<2) InterruptTIP is called to change the table and flush pending state>> < flush type-ahead>> <> <> <> ClassIncreek.CopyIncreek[user.parseInfo.localCreek, user.parseInfo.inCreek]; <> creekAction _ ClassIncreek.GetAction[self: user.parseInfo.inCreek, waitMode: forever, acceptance: clicksAndMotion]; <> <> <> <> <> IF user.buttonProc#NIL THEN WITH action: creekAction SELECT FROM mousePosition, deltaMouse => { p: Interminal.MousePosition ~ ClassIncreek.GetPositionFrom[user.parseInfo.inCreek].mousePosition; userTSC^ _ privateTSC^ _ [mouseX: p.mouseX, mouseY: p.mouseY, color: p.color]; IF user.buttonProc[userTSC, motion, user.parseInfo.localCreek] THEN { [] _ ClassIncreek.CopyIncreek[user.parseInfo.inCreek, user.parseInfo.localCreek]; LOOP; }; }; keyUp => SELECT action.value FROM Red, Yellow, Blue => { userTSC^ _ privateTSC^; IF user.buttonProc[userTSC, buttonUp, user.parseInfo.localCreek] THEN { [] _ ClassIncreek.CopyIncreek[user.parseInfo.inCreek, user.parseInfo.localCreek]; LOOP; }; }; ENDCASE; keyDown => SELECT action.value FROM Red, Yellow, Blue => { userTSC^ _ privateTSC^; IF user.buttonProc[userTSC, buttonDown, user.parseInfo.localCreek] THEN { [] _ ClassIncreek.CopyIncreek[user.parseInfo.inCreek, user.parseInfo.localCreek]; LOOP; }; }; ENDCASE; ENDCASE; IF user.parseInfo.tableHead#NIL THEN WITH action: creekAction SELECT FROM mousePosition, deltaMouse, keyUp, keyDown => results _ MatchEvent[user.parseInfo, creekAction]; ENDCASE => ERROR; -- unexpected ActionKind IF results#NIL THEN user.notifyProc[results]; ENDLOOP; }; ParseOneEvent: PUBLIC SAFE PROC [parseInfo: TIPParseInfo] RETURNS [result: LIST OF REF ANY] = TRUSTED { RETURN[MatchEvent[parseInfo, ClassIncreek.GetAction[self: parseInfo.inCreek, waitMode: forever, acceptance: clicksAndMotion]]]; }; <> MatchEvent: PROC [parseInfo: TIPParseInfo, creekAction: ClassIncreek.ActionBody] RETURNS [result: LIST OF REF ANY _ NIL] = TRUSTED { increek: ClassIncreek.Increek; increekAction: ClassIncreek.ActionBody; firstAccess, copied: BOOL; advanced: BOOL; <> <> stackPointer: CARDINAL; ClearIncreekStack: PROC[] = TRUSTED INLINE { stackPointer _ 0; }; PushIncreek: PROC[] = TRUSTED INLINE { ClassIncreek.CopyIncreek[parseInfo.creekStack[stackPointer], increek]; stackPointer _ stackPointer + 1; advanced _ FALSE; }; CopyTopIncreek: PROC = TRUSTED INLINE { IF advanced THEN { ClassIncreek.CopyIncreek[increek, parseInfo.creekStack[stackPointer]]; advanced _ FALSE; }; }; PopIncreek: PROC = TRUSTED INLINE { stackPointer _ stackPointer - 1; }; <> <> <> <> GetIncreekAction: PROC [acceptance: ClassIncreek.Acceptance _ clicks] = TRUSTED INLINE { IF firstAccess THEN { firstAccess _ FALSE; increek _ parseInfo.inCreek; increekAction _ creekAction; -- the parameter of MatchEvent copied _ FALSE; } ELSE { IF ~copied THEN { copied _ TRUE; ClassIncreek.CopyIncreek[parseInfo.localCreek, parseInfo.inCreek]; increek _ parseInfo.localCreek; }; increekAction _ ClassIncreek.GetAction[self: increek, waitMode: forever, acceptance: acceptance]; advanced _ TRUE; }; }; MatchChoice: PROC [choice: TIPChoice] RETURNS [result: LIST OF REF ANY _ NIL] = TRUSTED { valid: BOOL _ TRUE; -- go ahead, you're about to match an event FOR terms: TIPChoice _ choice, terms.rest UNTIL ~valid OR terms=NIL DO WITH term: terms.first SELECT FROM keyTrigger => { GetIncreekAction[clicks]; valid _ WITH ca: increekAction SELECT FROM keyDown => (term.keyState.key=ca.value AND term.keyState.state=down), keyUp => (term.keyState.key=ca.value AND term.keyState.state=up), ENDCASE => FALSE; -- suprise action from Increek }; mouseTrigger => { GetIncreekAction[clicksAndMotion]; valid _ WITH increekAction SELECT FROM mousePosition => TRUE, deltaMouse => TRUE, ENDCASE => FALSE; }; timeTrigger => { IF firstAccess THEN ERROR; -- time events can't be first <> ClassIncreek.CopyIncreek[parseInfo.timeCreek, increek]; increekAction _ ClassIncreek.GetAction[self: parseInfo.timeCreek, waitMode: timed, waitInterval: term.mSecs, acceptance: clicks]; valid _ WITH ca: increekAction SELECT FROM timedOut => term.flavor=gt, ENDCASE => term.flavor=lt; }; keyEnable => { creekKeyState: Interminal.KeyState _ ClassIncreek.GetPositionFrom[increek].keyState; valid _ (term.keyState.state = creekKeyState.bits[term.keyState.key]); }; key2Enable => { creekKeyState: Interminal.KeyState _ ClassIncreek.GetPositionFrom[increek].keyState; valid _ (term.keyState1.state = creekKeyState.bits[term.keyState1.key]) OR (term.keyState2.state = creekKeyState.bits[term.keyState2.key]); }; keyEnableList => { creekKeyState: Interminal.KeyState _ ClassIncreek.GetPositionFrom[increek].keyState; valid _ FALSE; FOR lst: LIST OF TIPKeyState _ term.lst, lst.rest UNTIL lst=NIL DO IF lst.first.state = creekKeyState.bits[lst.first.key] THEN { valid _ TRUE; EXIT }; ENDLOOP; }; predEnable => { predRef: REF; found: BOOL; predicate: REF TIPUser.TIPPredicate; [found, predRef] _ RefTab.Fetch[predTable, term.predicate]; IF found THEN { predicate _ NARROW[predRef]; valid _ predicate^[] } ELSE { valid _ FALSE }; }; char => stdChar^ _ AsciiAction[increek, increekAction]; coords => { mp: Interminal.MousePosition ~ ClassIncreek.GetPositionFrom[increek].mousePosition; stdCoords^ _ [mouseX: mp.mouseX, mouseY: mp.mouseY, color: mp.color]; }; time => { stdTime^ _ ClassIncreek.GetTime[increek]; }; nested => { PushIncreek[]; FOR choices: TIPChoiceSeries _ term.statement, choices.rest UNTIL choices=NIL DO result _ MatchChoice[choices.first]; IF result#NIL THEN RETURN[result]; CopyTopIncreek[]; ENDLOOP; PopIncreek[]; valid _ FALSE; }; result => { IF copied THEN ClassIncreek.CopyIncreek[parseInfo.inCreek, increek]; RETURN[term.list]; }; ENDCASE => ERROR; ENDLOOP; }; actionKind: ClassIncreek.ActionKind _ creekAction.kind; IF parseInfo.tableHead=transparentTIPTable THEN { -- just pass creek and action through result _ LIST[parseInfo.inCreek, NEW[ClassIncreek.ActionBody _ creekAction]]; RETURN; }; FOR table: TIPTable _ parseInfo.tableHead, IF table.opaque THEN NIL ELSE table.link UNTIL table=NIL DO impl: TIPTableImpl ~ table.impl; SELECT actionKind FROM -- for efficiency mousePosition => IF impl.ignore.move THEN LOOP; deltaMouse => IF impl.ignore.move THEN LOOP; keyDown => IF impl.ignore.down THEN LOOP; keyUp => IF impl.ignore.up THEN LOOP; ENDCASE; firstAccess _ TRUE; ClearIncreekStack[]; WITH t: impl SELECT FROM fast => { GetIncreekAction[]; WITH action: increekAction SELECT FROM mousePosition => result _ MatchChoice[t.mouse]; deltaMouse => result _ MatchChoice[t.mouse]; keyUp => result _ MatchChoice[t.keyUp[action.value]]; keyDown => result _ MatchChoice[t.keyDown[action.value]]; ENDCASE; IF result#NIL THEN RETURN[result]; }; small => { FOR choices: TIPChoiceSeries _ t.all, choices.rest UNTIL choices=NIL DO result _ MatchChoice[choices.first]; IF result#NIL THEN RETURN[result]; firstAccess _ TRUE; ClearIncreekStack[]; ENDLOOP; }; ENDCASE; ENDLOOP; }; KeyItem: TYPE ~ RECORD[normal, shift: CHAR] _ [0C, 0C]; nullKeyItem: KeyItem ~ [0C, 0C]; DefaultingKeyItem: TYPE ~ KeyItem _ nullKeyItem; KeyTable: TYPE ~ ARRAY Interminal.KeyName OF DefaultingKeyItem; keyTable: REF KeyTable ~ NEW[KeyTable _ [ ESC: [Ascii.ESC, Ascii.ESC], -- Alto ESC (upper left), DLion CENTER (top row, left end) One: ['1, '!], -- 1 and ! Two: ['2, '@], -- 2 and @ Three: ['3, '#], -- 3 and # Four: ['4, '$], -- 4 and $ Five: ['5, '%], -- 5 and % Six: ['6, '~], -- 6 and ~ Seven: ['7, '&], -- 7 and & Eight: ['8, '*], -- 8 and * Nine: ['9, '(], -- 9 and ( Zero: ['0, ')], -- 0 and ) Dash: ['-, '], -- Alto - and , DLion - Equal: ['=, '+], -- = and + BackSlash: ['\\, '|], -- Alto \ and |, DLion DEFAULTS (top row, right end) LF: [Ascii.LF, Ascii.LF], -- Alto LF (upper right), DLion COPY (left group) DEL: [Ascii.DEL, Ascii.DEL], -- Alto DEL, DLion DELETE (left group) TAB: [Ascii.TAB, Ascii.TAB], -- Alto TAB, DLion (large key left of Q) Q: ['q, 'Q], W: ['w, 'W], E: ['e, 'E], R: ['r, 'R], T: ['t, 'T], Y: ['y, 'Y], U: ['u, 'U], I: ['i, 'I], O: ['o, 'O], P: ['p, 'P], LeftBracket: ['[, '{], -- [ and { RightBracket: ['], '}], -- ] and } Arrow: ['_, '^], -- Alto _ and ^, DLion open quotes BS: [Ascii.BS, Ascii.BS], -- Alto BS (upper right), DLion _ (large key, upper right) A: ['a, 'A], S: ['s, 'S], D: ['d, 'D], F: ['f, 'F], G: ['g, 'G], H: ['h, 'H], J: ['j, 'J], K: ['k, 'K], L: ['l, 'L], SemiColon: [';, ':], --; and : Quote: ['\', '\"], -- ' and " (close quotes on DLion) Return: [Ascii.CR, Ascii.CR], -- Alto RETURN, DLion (double-height key, right side) Z: ['z, 'Z], X: ['x, 'X], C: ['c, 'C], V: ['v, 'V], B: ['b, 'B], N: ['n, 'N], M: ['m, 'M], Comma: [',, '<], -- , and < Period: ['., '>], -- . and > Slash: ['/, '?], -- / and ? Space: [Ascii.SP, Ascii.SP], -- the space bar Spare1: ['\201, '\204], Spare2: ['\202, '\205], Spare3: ['\203, '\206] ]]; AsciiAction: PROC [inCreek: ClassIncreek.Increek, creekAction: ClassIncreek.ActionBody] RETURNS [c: CHAR] = TRUSTED { p: ClassIncreek.ViewPosition = ClassIncreek.GetPositionFrom[inCreek]; WITH action: creekAction SELECT FROM keyDown => { kI: KeyItem = keyTable[action.value]; char: CHAR _ kI.normal; IF kI=nullKeyItem THEN ERROR; -- not a character SELECT Interminal.DownUp[down] FROM p.keyState.bits[Ctrl] => char _ VAL[ORD[char] MOD 40B]; p.keyState.bits[LeftShift], p.keyState.bits[RightShift] => char _ kI.shift; p.keyState.bits[Lock] => IF char IN['a..'z] THEN char _ kI.shift; ENDCASE; RETURN[char]; }; ENDCASE => ERROR; -- why are they asking for a char? }; <> predTable: PUBLIC RefTab.Ref _ RefTab.Create[]; -- table for user defined predicates CreateClient: PUBLIC PROC [notify: TIPNotifyProc _ NIL, buttons: TIPButtonProc _ NIL] RETURNS [self: TIPClient] = TRUSTED { self _ NEW[TIPClientRec _ [ notifyProc: notify, buttonProc: buttons, parseInfo: CreateParseInfo[], matcher: ]]; self.matcher _ LOOPHOLE[Process.GetCurrent[]]; <> self.matcher _ FORK MatchProcess[self]; }; DestroyClient: PUBLIC PROC [self: TIPClient] = TRUSTED { self.matcher _ NIL; -- force matcher to terminate }; CreateParseInfo: PUBLIC PROC [parseTable: TIPTable _ NIL] RETURNS [new: TIPParseInfo] = TRUSTED { new _ NEW[TIPParseInfoRec _ [ inCreek: ClassIncreek.NewStdIncreek[], localCreek: ClassIncreek.NewStdIncreek[], timeCreek: ClassIncreek.NewStdIncreek[], creekStack: ALL[ClassIncreek.NewStdIncreek[]], tableHead: parseTable ]]; }; 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] = { <> IF (old_user.parseInfo.tableHead)#NIL THEN user.parseInfo.tableHead _ user.parseInfo.tableHead.link; }; RegisterTIPPredicate: PUBLIC PROC [key: ATOM, p: TIPPredicate] = { <> <> [] _ RefTab.Store[predTable, key, NEW[TIPPredicate _ p]]; }; <> TRUSTED { mouseGrainCreek _ ClassIncreek.NewStdIncreek[]; -- only for setting recording grain ClassIncreek.SetMouseGrain[mouseGrainCreek, 100, 1]; }; }.