<> <> <> <> DIRECTORY Atom USING [GetPName, MakeAtom], IO USING [GetBlock, GetChar, PutBlock, PutChar, STREAM], Interminal USING [KeyName], PrincOpsUtils USING [LongCopy], Rope USING [Equal, FromRefText, ROPE], TerminalDefs USING [KeyName], TIPPrivate USING [KeyOption, stdChar, stdCoords, stdTime, version], TIPTables USING [TIPChoice, TIPChoiceSeries, TIPKeyState, TIPResults, TIPTableImplRep, TIPTerm], TIPUser USING [TIPTable, TIPTableRep]; TIPTableReaderWriter: CEDAR PROGRAM IMPORTS Atom, IO, PrincOpsUtils, Rope, TIPPrivate EXPORTS TIPPrivate, TIPUser = BEGIN OPEN TIPPrivate, TIPTables, TIPUser; TIPTableImpl: TYPE ~ REF TIPTableImplRep; TIPTableImplRep: PUBLIC TYPE ~ TIPTables.TIPTableImplRep; BadTable: PUBLIC ERROR = CODE; ReadTIPTable: PUBLIC PROC [s: IO.STREAM] RETURNS [table: TIPTable, keyOption: KeyOption _ none] = { text: REF TEXT _ NEW[TEXT[32]]; -- scratch text for atoms and such opaque, up, down, move: BOOL; where: INT _ 0; -- for debugging Text: PROC [len: CARDINAL] = TRUSTED { IF len > 255 THEN ERROR BadTable; IF len > text.maxLength THEN text _ NEW[TEXT[len]]; IF (text.length _ IO.GetBlock[s,text,0,len]) # len THEN ERROR BadTable; where _ where+len; }; Char: PROC RETURNS [CHAR] = TRUSTED INLINE { where _ where+1; RETURN [IO.GetChar[s]]; }; Key: PROC RETURNS [Interminal.KeyName] = TRUSTED INLINE { RETURN [LOOPHOLE[Char[]]]; }; GetAtom: PROC RETURNS [ATOM] = TRUSTED { Text[LOOPHOLE[Char[],CARDINAL]]; RETURN [Atom.MakeAtom[Rope.FromRefText[text]]]; }; Flag: PROC RETURNS [BOOL] = TRUSTED { RETURN [SELECT Char[] FROM 'F => FALSE, 'T => TRUE, ENDCASE => ERROR BadTable]; }; StoreFlags: PROC = TRUSTED { impl: TIPTableImpl ~ table.impl; table.opaque _ opaque; impl.ignore.up _ up; impl.ignore.down _ down; impl.ignore.move _ move; }; ChoiceItem: PROC RETURNS [key: Interminal.KeyName, choice: TIPChoice] = TRUSTED { SELECT Char[] FROM ') => RETURN [BS,NIL]; '( => NULL; ENDCASE => ERROR BadTable; key _ Key[]; choice _ Choice[]; IF Char[] # ') THEN ERROR BadTable; }; Choice: PROC [skipPar: BOOL _ FALSE] RETURNS [choice: TIPChoice] = TRUSTED { last: TIPChoice; char: CHAR; IF ~skipPar AND Char[] # '( THEN ERROR BadTable; WHILE (char _ Char[]) # ') DO term: TIPChoice _ Term[char]; IF last=NIL THEN choice _ last _ term ELSE last _ last.rest _ term; ENDLOOP; }; ChoiceSeries: PROC RETURNS [series: TIPChoiceSeries] = TRUSTED { last: TIPChoiceSeries; IF Char[] # '( THEN ERROR BadTable; WHILE Char[] # ') DO choices: TIPChoiceSeries _ LIST[Choice[TRUE]]; IF last=NIL THEN series _ last _ choices ELSE last _ last.rest _ choices; ENDLOOP; }; Term: PROC [char: CHAR] RETURNS [term: TIPChoice] = TRUSTED { SELECT char FROM '1 => { <> keyTerm: keyTrigger TIPTerm; keyTerm.keyState.key _ Key[]; keyTerm.keyState.state _ SELECT Char[] FROM 'U => up, 'D => down, ENDCASE => ERROR BadTable; RETURN [LIST[keyTerm]] }; '2 => { <> mouseTerm: mouseTrigger TIPTerm; RETURN [LIST[mouseTerm]] }; '3 => { <> timeTerm: timeTrigger TIPTerm; msecs: CARDINAL; timeTerm.flavor _ SELECT Char[] FROM 'G => gt, 'L => lt, ENDCASE => ERROR BadTable; msecs _ LOOPHOLE[Char[],CARDINAL]*256; msecs _ msecs + LOOPHOLE[Char[],CARDINAL]; timeTerm.mSecs _ msecs; RETURN [LIST[timeTerm]] }; '4 => { <> keyTerm: keyEnable TIPTerm; keyTerm.keyState _ KeyState[]; RETURN [LIST[keyTerm]] }; '5 => { <> predTerm: predEnable TIPTerm; predTerm.predicate _ GetAtom[]; RETURN [LIST[predTerm]] }; '6 => { <> charTerm: char TIPTerm; charTerm.ch _ stdChar; RETURN [LIST[charTerm]] }; '7 => { <> coordsTerm: coords TIPTerm; coordsTerm.xy _ stdCoords; RETURN [LIST[coordsTerm]] }; '8 => { <> term: nested TIPTerm; term.statement _ ChoiceSeries[]; RETURN [LIST[term]] }; '9 => { <> resultTerm: result TIPTerm; resultTerm.list _ Results[]; RETURN [LIST[resultTerm]] }; 'A => { <> term: key2Enable TIPTerm; term.keyState1 _ KeyState[]; term.keyState2 _ KeyState[]; RETURN [LIST[term]] }; 'B => { <> term: keyEnableList TIPTerm; last: LIST OF TIPKeyState; IF Char[] # '( THEN ERROR BadTable; WHILE Char[] # ') DO keyState: LIST OF TIPKeyState _ LIST[KeyState[]]; IF last=NIL THEN term.lst _ last _ keyState ELSE last _ last.rest _ keyState; ENDLOOP; RETURN [LIST[term]] }; 'C => { <> timeTerm: time TIPTerm; timeTerm.time _ stdTime; RETURN [LIST[timeTerm]]; }; ENDCASE => ERROR BadTable; }; KeyState: PROC RETURNS [keyState: TIPKeyState] = TRUSTED { keyState.key _ Key[]; keyState.state _ SELECT Char[] FROM 'U => up, 'D => down, ENDCASE => ERROR BadTable; }; Results: PROC RETURNS [results: TIPResults] = TRUSTED { last: TIPResults _ NIL; char: CHAR; IF Char[] # '( THEN ERROR BadTable; WHILE (char _ Char[]) # ') DO result: LIST OF REF ANY _ LIST[Result[char]]; IF last=NIL THEN results _ last _ result ELSE last _ last.rest _ result; ENDLOOP; }; Result: PROC [char: CHAR] RETURNS [REF ANY] = TRUSTED { SELECT char FROM '1 => RETURN [GetAtom[]]; '2 => RETURN [stdChar]; '3 => { Bytes: TYPE = MACHINE DEPENDENT RECORD [ byte0(0:0..7), byte1(0:8..15), byte2(1:0..7), byte3(1:8..15): [0..255] _ 0]; b: Bytes; <> b.byte0 _ LOOPHOLE[Char[]]; b.byte1 _ LOOPHOLE[Char[]]; b.byte2 _ LOOPHOLE[Char[]]; b.byte3 _ LOOPHOLE[Char[]]; RETURN [NEW[INT _ LOOPHOLE[b]]]; }; '4 => { c: NAT _ Char[]-0C; txt: REF TEXT _ NEW[TEXT[c]]; head: NAT = SIZE[TEXT[0]]; Text[c]; txt.length _ c; PrincOpsUtils.LongCopy[ from: LOOPHOLE[text, LONG POINTER]+head, nwords: SIZE[TEXT[c]]-head, to: LOOPHOLE[txt, LONG POINTER]+head ]; RETURN [txt]; }; '5 => RETURN [stdCoords]; '6 => RETURN [stdTime]; ENDCASE => ERROR BadTable; }; Text[8]; TRUSTED {IF ~Rope.Equal["TIPTABLE",LOOPHOLE[text,Rope.ROPE]] THEN ERROR BadTable}; IF Char[] # version THEN ERROR BadTable; opaque _ Flag[]; keyOption _ SELECT Char[] FROM 'N => none, 'P => printKeys, 'D => defaultKeys, ENDCASE => ERROR BadTable; up _ Flag[]; down _ Flag[]; move _ Flag[]; SELECT Char[] FROM 'S => { <> small: REF small TIPTableImplRep _ NEW[small TIPTableImplRep]; table _ NEW[TIPTableRep _ [impl: small]]; StoreFlags[]; small.all _ ChoiceSeries[]; }; 'F => { <> fast: REF fast TIPTableImplRep _ NEW[fast TIPTableImplRep]; key: Interminal.KeyName; choice: TIPChoice; table _ NEW[TIPTableRep _ [impl: fast]]; StoreFlags[]; fast.mouse _ Choice[]; IF Char[] # 'U THEN ERROR BadTable; IF Char[] # '( THEN ERROR BadTable; DO [key,choice] _ ChoiceItem[]; IF choice=NIL THEN EXIT; fast.keyUp[key] _ choice; ENDLOOP; IF Char[] # 'D THEN ERROR BadTable; IF Char[] # '( THEN ERROR BadTable; DO [key,choice] _ ChoiceItem[]; IF choice=NIL THEN EXIT; fast.keyDown[key] _ choice; ENDLOOP; fast.time _ Choice[]; }; ENDCASE => ERROR BadTable; }; EqualTables: PUBLIC PROC [t1, t2: TIPTable] = TRUSTED { impl1: TIPTableImpl ~ t1.impl; impl2: TIPTableImpl ~ t2.impl; IF t1.opaque # t2.opaque THEN ERROR; IF impl1.ignore # impl1.ignore THEN ERROR; WITH x:impl1 SELECT FROM small => WITH y:impl2 SELECT FROM small => EqualChoiceSeries[x.all,y.all]; fast => ERROR; ENDCASE => ERROR; fast => WITH y:impl2 SELECT FROM fast => { EqualChoices[x.mouse,y.mouse]; FOR key: Interminal.KeyName IN Interminal.KeyName DO EqualChoices[x.keyDown[key],y.keyDown[key]]; ENDLOOP; FOR key: Interminal.KeyName IN Interminal.KeyName DO EqualChoices[x.keyUp[key],y.keyUp[key]]; ENDLOOP; EqualChoices[x.time,y.time]; }; small => ERROR; ENDCASE => ERROR; ENDCASE => ERROR; }; EqualChoiceSeries: PROC [c1, c2: TIPChoiceSeries] = { DO <> IF c1 = c2 THEN RETURN; IF c1 = NIL OR c2 = NIL THEN ERROR; EqualChoices[c1.first, c2.first]; c1 _ c1.rest; c2 _ c2.rest; ENDLOOP; }; EqualChoices: PROC [c1, c2: TIPChoice] = TRUSTED { DO <> IF c1 = c2 THEN RETURN; IF c1 = NIL OR c2 = NIL THEN ERROR; WITH x: c1.first SELECT FROM keyTrigger => WITH y: c2.first SELECT FROM keyTrigger => IF x.keyState # y.keyState THEN ERROR; ENDCASE => ERROR; mouseTrigger => WITH y: c2.first SELECT FROM mouseTrigger => NULL; ENDCASE => ERROR; timeTrigger => WITH y: c2.first SELECT FROM timeTrigger => IF x.flavor # y.flavor OR x.mSecs # y.mSecs THEN ERROR; ENDCASE => ERROR; keyEnable => WITH y: c2.first SELECT FROM keyEnable => IF x.keyState # y.keyState THEN ERROR; ENDCASE => ERROR; key2Enable => WITH y: c2.first SELECT FROM key2Enable => IF x.keyState1 # y.keyState1 OR x.keyState2 # y.keyState2 THEN ERROR; ENDCASE => ERROR; keyEnableList => WITH y: c2.first SELECT FROM keyEnableList => { lst1: LIST OF TIPKeyState _ x.lst; lst2: LIST OF TIPKeyState _ y.lst; DO IF lst1 = NIL THEN IF lst2 = NIL THEN EXIT ELSE ERROR; IF lst2 = NIL THEN ERROR; IF lst1.first # lst2.first THEN ERROR; lst1 _ lst1.rest; lst2 _ lst2.rest; ENDLOOP }; ENDCASE => ERROR; predEnable => WITH y: c2.first SELECT FROM predEnable => IF x.predicate # y.predicate THEN ERROR; ENDCASE => ERROR; char => WITH y: c2.first SELECT FROM char => NULL; ENDCASE => ERROR; coords => WITH y: c2.first SELECT FROM coords => NULL; ENDCASE => ERROR; nested => WITH y: c2.first SELECT FROM nested => EqualChoiceSeries[x.statement, y.statement]; ENDCASE => ERROR; result => WITH y: c2.first SELECT FROM result => { cList1: TIPResults _ x.list; cList2: TIPResults _ y.list; DO <> SELECT TRUE FROM cList1 = cList2 => RETURN; cList1=NIL, cList2=NIL => ERROR; cList1.first = cList2.first => {}; cList1.first = stdChar, cList2.first = stdChar => ERROR; cList1.first = stdCoords, cList2.first = stdCoords => ERROR; ENDCASE => WITH cList1.first SELECT FROM x: ATOM => WITH cList2.first SELECT FROM y: ATOM => IF x # y THEN ERROR; ENDCASE => ERROR; x: REF INT => WITH cList2.first SELECT FROM y: REF INT => IF x^ # y^ THEN ERROR; ENDCASE => ERROR; x: REF TEXT => WITH cList2.first SELECT FROM y: REF TEXT => { IF x.length # y.length THEN ERROR; FOR i:NAT IN [0..x.length) DO IF x[i] # y[i] THEN ERROR; ENDLOOP }; ENDCASE => ERROR; ENDCASE => ERROR; cList1 _ cList1.rest; cList2 _ cList2.rest; ENDLOOP; }; ENDCASE => ERROR; ENDCASE => ERROR; c1 _ c1.rest; c2 _ c2.rest; ENDLOOP; }; KeyName: TYPE ~ TerminalDefs.KeyName; debug: BOOL = FALSE; debugStream: IO.STREAM; WriteTIPTable: PUBLIC PROC [table: TIPTable, keyOption: KeyOption, s: IO.STREAM] = { impl: TIPTableImpl ~ table.impl; Char: PROC [c: CHAR] = { IO.PutChar[s,c]; IF debug THEN IO.PutChar[debugStream,c]; }; String: PROC [str: REF READONLY TEXT] = { IO.PutBlock[s,str]; IF debug THEN IO.PutBlock[debugStream,str]; }; Text: PROC [txt: REF READONLY TEXT] = { IF txt.length > 255 THEN ERROR; Char[LOOPHOLE[txt.length]]; String[txt]; }; Flag: PROC [flag: BOOL] = { Char[IF flag THEN 'T ELSE 'F] }; Key: PROC [k: KeyName] = { Char[LOOPHOLE[k]] }; Int: PROC [x: INT] = { Bytes: TYPE = MACHINE DEPENDENT RECORD [ byte0(0:0..7), byte1(0:8..15), byte2(1:0..7), byte3(1:8..15): [0..255] _ 0]; b: Bytes _ LOOPHOLE[x]; Char[LOOPHOLE[b.byte0]]; Char[LOOPHOLE[b.byte1]]; Char[LOOPHOLE[b.byte2]]; Char[LOOPHOLE[b.byte3]]; }; ChoiceItem: PROC [k: KeyName, c: TIPChoice] = { IF c=NIL THEN RETURN; Char['(]; Key[k]; Choice[c]; Char[')] }; ChoiceSeries: PROC [cs: TIPChoiceSeries] = { Char['(]; FOR x: TIPChoiceSeries _ cs, x.rest UNTIL x=NIL DO Choice[x.first]; ENDLOOP; Char[')]; }; Choice: PROC [c: TIPChoice] = { Char['(]; FOR x: TIPChoice _ c, x.rest UNTIL x=NIL DO Term[x.first]; ENDLOOP; Char[')]; }; KeyState: PROC [keyState: TIPKeyState] = { Key[keyState.key]; Char[SELECT keyState.state FROM up => 'U, down => 'D, ENDCASE => ERROR] }; Term: PROC [t: TIPTerm] = TRUSTED { WITH x:t SELECT FROM keyTrigger => { Char['1]; Key[x.keyState.key]; Char[SELECT x.keyState.state FROM up => 'U, down => 'D, ENDCASE => ERROR] }; mouseTrigger => Char['2]; timeTrigger => { Char['3]; Char[SELECT x.flavor FROM gt => 'G, lt => 'L, ENDCASE => ERROR]; Char[LOOPHOLE[x.mSecs / 256]]; Char[LOOPHOLE[x.mSecs MOD 256]] }; keyEnable => { Char['4]; KeyState[x.keyState] }; predEnable => { Char['5]; Text[LOOPHOLE[Atom.GetPName[x.predicate]]] }; char => Char['6]; coords => Char['7]; nested => { Char['8]; ChoiceSeries[x.statement] }; result => { Char['9]; Results[x.list] }; key2Enable => { Char['A]; KeyState[x.keyState1]; KeyState[x.keyState2] }; keyEnableList => { Char['B]; Char['(]; FOR lst: LIST OF TIPKeyState _ x.lst, lst.rest UNTIL lst=NIL DO KeyState[lst.first]; ENDLOOP; Char[')] }; time => Char['C]; ENDCASE => ERROR; }; Results: PROC [c: TIPResults] = { Char['(]; FOR x: TIPResults _ c, x.rest UNTIL x=NIL DO Result[x.first]; ENDLOOP; Char[')] }; Result: PROC [r: REF ANY] = TRUSTED { IF r=stdCoords THEN Char['5] ELSE IF r=stdChar THEN Char['2] ELSE IF r=stdTime THEN Char['6] ELSE WITH r SELECT FROM x: ATOM => { Char['1]; Text[LOOPHOLE[Atom.GetPName[x]]] }; x: REF INT => { Char['3]; Int[x^] }; x: REF TEXT => { Char['4]; Text[x] }; ENDCASE => ERROR }; <> String["TIPTABLE"]; Char[version]; Flag[table.opaque]; Char[SELECT keyOption FROM none => 'N, printKeys => 'P, defaultKeys => 'D, ENDCASE => ERROR]; Flag[impl.ignore.up]; Flag[impl.ignore.down]; Flag[impl.ignore.move]; WITH impl SELECT FROM x: REF small TIPTableImplRep => { Char['S]; ChoiceSeries[x.all] }; x: REF fast TIPTableImplRep => { Char['F]; Choice[x.mouse]; Char['U]; Char['(]; FOR k: KeyName IN KeyName DO ChoiceItem[k, x.keyUp[k]] ENDLOOP; Char[')]; Char['D]; Char['(]; FOR k: KeyName IN KeyName DO ChoiceItem[k, x.keyDown[k]] ENDLOOP; Char[')]; Choice[x.time]; }; ENDCASE => ERROR; }; END.