DIRECTORY
Atom USING [MakeAtom],
IO USING [GetBlock, GetChar, Handle],
Interminal USING [KeyName],
Rope USING [Equal, FromRefText, ROPE],
TIPPrivate,
TIPUser,
TIPTables;

TIPTableReader: CEDAR PROGRAM

IMPORTS Atom, IO, Rope, TIPPrivate, TIPUser
EXPORTS TIPPrivate = 

BEGIN 
OPEN TIPPrivate, TIPTables, TIPUser;

BadTable: PUBLIC ERROR = CODE;

ReadTIPTable: PUBLIC PROC [s: IO.Handle]
RETURNS [table: TIPTable, keyOption: KeyOption _ none] = {

text: REF TEXT _ NEW[TEXT[32]]; -- scratch text for atoms and such
opaque, up, down, move: BOOLEAN;
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 [BOOLEAN] = TRUSTED { RETURN [
SELECT Char[] FROM 'F => FALSE, 'T => TRUE, ENDCASE => ERROR BadTable] };
Int: PROC RETURNS [INT] = TRUSTED {
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 [LOOPHOLE[b]] };
StoreFlags: PROC = TRUSTED {
table.opaque _ opaque;
table.ignore.up _ up;
table.ignore.down _ down;
table.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: BOOLEAN _ 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
choice: TIPChoice _ Choice[TRUE];
IF last=NIL THEN series _ last _ qZ.LIST[choice]
ELSE last _ last.rest _ qZ.LIST[choice];
ENDLOOP };
Term: PROC [char: CHAR] RETURNS [term: TIPChoice] = TRUSTED {
SELECT char FROM
'1 => { -- keytrigger
keyTerm: keyTrigger TIPTerm;
keyTerm.keyState.key _ Key[];
keyTerm.keyState.state _ SELECT Char[] FROM
'U => up, 'D => down, ENDCASE => ERROR BadTable;
RETURN [qZ.LIST[keyTerm]] };
'2 => { -- mousetrigger
mouseTerm: mouseTrigger TIPTerm;
RETURN [qZ.LIST[mouseTerm]] };
'3 => { -- timetrigger
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 [qZ.LIST[timeTerm]] }; 
'4 => { -- keyenable
keyTerm: keyEnable TIPTerm;
keyTerm.keyState _ KeyState[];
RETURN [qZ.LIST[keyTerm]] };
'5 => { -- predenable
predTerm: predEnable TIPTerm;
predTerm.predicate _ GetAtom[];
RETURN [qZ.LIST[predTerm]] };
'6 => { -- char
charTerm: char TIPTerm;
charTerm.ch _ stdChar;
RETURN [qZ.LIST[charTerm]] };
'7 => { -- coords
coordsTerm: coords TIPTerm;
coordsTerm.xy _ stdCoords;
RETURN [qZ.LIST[coordsTerm]] };
'8 => { -- choiceseries
term: nested TIPTerm;
term.statement _ ChoiceSeries[];
RETURN [qZ.LIST[term]] };
'9 => { -- results
resultTerm: result TIPTerm;
resultTerm.list _ Results[];
RETURN [qZ.LIST[resultTerm]] };
'A => { -- key2Enable
term: key2Enable TIPTerm;
term.keyState1 _ KeyState[];
term.keyState2 _ KeyState[];
RETURN [qZ.LIST[term]] };
'B => { -- keyEnableList
term: keyEnableList TIPTerm;
char: CHAR;
last: LIST OF TIPKeyState;
IF Char[] # '( THEN ERROR BadTable;
WHILE (char _ Char[]) # ') DO
KeyFromChar: PROC [c: CHAR] RETURNS [Interminal.KeyName] =
TRUSTED INLINE { RETURN [LOOPHOLE[c]] };
keyState: TIPKeyState;
keyState.key _ KeyFromChar[char];
keyState.state _ SELECT Char[] FROM
'U => up, 'D => down, ENDCASE => ERROR BadTable;
IF last=NIL THEN term.lst _ last _ qZ.LIST[keyState]
ELSE last _ last.rest _ qZ.LIST[keyState];
ENDLOOP;
RETURN [qZ.LIST[term]] };
'C => { -- TIME
timeTerm: time TIPTerm;
timeTerm.time _ stdTime;
RETURN [qZ.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;
char: CHAR;
IF Char[] # '( THEN ERROR BadTable;
WHILE (char _ Char[]) # ') DO
result: REF ANY _ Result[char];
IF last=NIL THEN results _ last _ qZ.LIST[result]
ELSE last _ last.rest _ qZ.LIST[result];
ENDLOOP };
Result: PROC [char: CHAR] RETURNS [REF ANY] = TRUSTED {
SELECT char FROM
'1 => RETURN [GetAtom[]];
'2 => RETURN [stdChar]; 
'3 => {	num: REF INT _ qZ.NEW[LONG INTEGER _ Int[]];
RETURN [num] };
'4 => {	txt: REF TEXT;
Text[LOOPHOLE[Char[],NAT]];
txt _ NEW[TEXT[text.length]];
FOR i: NAT IN [0..text.length) DO txt[i] _ text[i]; ENDLOOP;
txt.length _ text.length;
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 table
small: REF small TIPTableRec _ qZ.NEW[small TIPTableRec];
table _ small;
StoreFlags;
small.all _ ChoiceSeries[] };
'F => { -- fast table
fast: REF fast TIPTableRec _ qZ.NEW[fast TIPTableRec];
key: Interminal.KeyName;
choice: TIPChoice;
table _ 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 {
IF t1.opaque # t2.opaque THEN ERROR;
IF t1.ignore # t2.ignore THEN ERROR;
WITH x:t1 SELECT FROM
small => WITH y:t2 SELECT FROM
small => EqualChoiceSeries[x.all,y.all];
fast => ERROR;
ENDCASE => ERROR;
fast => WITH y:t2 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	-- check each choice on list
IF c1=NIL THEN IF c2=NIL THEN RETURN ELSE ERROR
ELSE IF c2=NIL THEN ERROR;
EqualChoices[c1.first, c2.first];
c1 _ c1.rest;
c2 _ c2.rest;
ENDLOOP };

EqualChoices: PROC [c1, c2: TIPChoice] = TRUSTED {
DO	-- check each term on list
IF c1=NIL THEN IF c2=NIL THEN RETURN ELSE ERROR
ELSE IF 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 => EqualResults[x.list, y.list];
ENDCASE => ERROR;
ENDCASE => ERROR;
c1 _ c1.rest;
c2 _ c2.rest;
ENDLOOP };

EqualResults: PUBLIC PROC [c1, c2: TIPResults] = {
DO	-- check each term on list
IF c1=NIL THEN IF c2=NIL THEN RETURN ELSE ERROR
ELSE IF c2=NIL THEN ERROR;
IF c1.first = stdChar THEN IF c2.first = stdChar THEN NULL ELSE ERROR
ELSE IF c1.first = stdCoords THEN IF c2.first = stdCoords THEN NULL ELSE ERROR
ELSE WITH c1.first SELECT FROM
x: ATOM => WITH c2.first SELECT FROM
y: ATOM => IF x # y THEN ERROR;
ENDCASE => ERROR;
x: REF INT => WITH c2.first SELECT FROM
y: REF INT => IF x^ # y^ THEN ERROR;
ENDCASE => ERROR;
x: REF TEXT => WITH c2.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;
c1 _ c1.rest;
c2 _ c2.rest;
ENDLOOP };


END.


~TIPTableReader.mesa; 
Last Edited by McGregor, June 10, 1982 12:41 pm
Last Edited by: Maxwell, January 3, 1983 11:33 am
ΚΓ–
"Mesa" style˜Jš
Οc™Jš
/™/J™1J˜š
Οk	˜	Jšœžœ˜Jšžœ
žœ˜%Jšœžœ˜Jšœžœžœ˜&J˜J˜J˜
J˜—Jšœž
˜˜Jšžœžœ˜+Jšžœ˜J˜—šžœ
˜Jšžœ ˜$J˜—Jšœ
žœ
žœžœ
˜J˜šΟnœžœ
žœžœ˜(Jšžœ3˜:J˜Jš
œžœ
žœžœ
žœ"˜BJšœžœ
˜ Jšœžœ˜ J˜šŸœžœžœžœ˜&Jšžœžœ
žœ
˜!Jšžœžœžœ
žœ˜3šžœžœž˜7Jšžœ
˜—J˜—JšŸœžœ
žœžœžœ
žœžœžœ˜WJšŸœžœ
žœžœžœžœ˜Vš
Ÿœžœ
žœžœžœ˜(Jšœžœžœ˜ Jšžœ+˜1—šŸœžœ
žœžœžœžœ˜1Jšžœžœžœžœžœžœ
˜I—š
Ÿœžœ
žœžœžœ˜#š	œžœžœ
ž	œ
žœ˜(J˜J˜-—J˜	Jšœ
žœ	˜Jšœ
žœ	˜Jšœ
žœ	˜Jšœ
žœ	˜Jšžœžœ˜—šŸ
œžœžœ˜J˜J˜J˜J˜—šŸ
œžœ
žœ0žœ˜Qšžœž˜Jšœžœžœ
žœ˜Jšœžœ
˜Jšžœžœ
˜—J˜J˜Jšžœ
žœ
žœ˜%—šŸœžœžœžœžœžœ˜OJ˜Jšœžœ
˜Jšžœ
žœ
žœ
žœ
˜0šžœž˜J˜Jšžœžœ
žœ˜%Jšžœ˜Jšžœ˜
——šŸœžœ
žœžœ˜@J˜Jšžœ
žœ
žœ
˜#šžœ
ž˜Jšœžœ˜!Jšžœžœ
žœžœ˜0Jšžœžœ	˜(Jšžœ˜
——š
Ÿœžœžœžœžœ˜=Jšžœž˜šœ
˜J˜J˜šœžœž˜+Jšœžœžœ
˜0—Jšžœžœ
˜—šœ˜J˜ Jšžœžœ˜—šœ˜J˜Jšœžœ
˜šœžœž˜$Jšœžœžœ
˜.—Jšœžœžœ˜&Jšœžœžœ˜*J˜Jšžœžœ˜—šœ˜J˜J˜Jšžœžœ
˜—šœ
˜J˜J˜Jšžœžœ˜—šœ˜J˜J˜Jšžœžœ˜—šœ	˜J˜J˜Jšžœžœ˜—šœ˜J˜J˜ Jšžœžœ
˜—šœ
˜J˜J˜Jšžœžœ˜—šœ
˜J˜J˜J˜Jšžœžœ
˜—šœ˜J˜Jšœžœ
˜Jšœžœ
žœ
˜Jšžœ
žœ
žœ
˜#šžœž˜šŸœžœžœžœ˜:Jšžœ
žœžœžœ˜(—Jš
œ˜Jš
œ!˜!šœžœž˜#Jšœžœžœ
˜0—Jšžœžœ
žœžœ
˜4Jšžœžœ˜*Jšžœ
˜—Jšžœžœ
˜—šœ˜J˜J˜Jšžœžœ˜—Jšžœžœ˜—šŸœžœ
žœžœ˜:J˜šœžœž˜#Jšœžœžœ˜2——šŸœžœ
žœžœ˜7J˜Jšœžœ
˜Jšžœ
žœ
žœ
˜#šžœž˜Jšœžœ
žœ˜Jšžœžœ
žœžœ˜1Jšžœžœ	˜(Jšžœ˜
——šŸœžœžœžœžœ
žœžœ˜7Jšžœž˜Jšœžœ
˜Jšœžœ˜šœ
žœ
žœžœ
žœ
žœ
˜4Jšžœ	˜—šœ
žœ
žœ
˜Jšœžœžœ˜Jšœžœ
žœ˜Jš
žœžœ
žœžœžœ
˜<J˜Jšžœ	˜—Jšœžœ˜Jšœžœ˜Jšžœžœ˜J˜—J˜Jšžœžœžœžœžœ
žœ˜RJšžœžœ
žœ
˜(J˜šœžœž˜Jšœ0žœžœ
˜J—J˜*Jšžœž˜šœ˜Jšœžœžœ˜9J˜J˜J˜—šœ
˜Jšœžœžœ˜6J˜J˜J˜
J˜J˜Jšžœ
žœ
žœ
˜#Jšžœ
žœ
žœ
˜#šžœ˜Jšžœžœ
žœ
žœ
˜J˜Jšžœ
˜—Jšžœ
žœ
žœ
˜#Jšžœ
žœ
žœ
˜#šžœ˜Jšžœžœ
žœ
žœ
˜J˜Jšžœ˜	—J˜—Jšžœžœ
˜J˜šŸœžœ
žœžœ˜7Jšžœžœ
žœ
˜$Jšžœžœ
žœ
˜$Jšžœžœ
ž˜šœ	žœžœ
ž˜J˜(Jšœžœ
˜Jšžœžœ
˜—šœžœžœ
ž˜˜	J˜šžœžœž˜4J˜,Jšžœ
˜—šžœžœž˜4J˜(Jšžœ
˜—J˜—Jšœ	žœ
˜Jšžœžœ
˜—Jšžœžœ˜J˜—šŸœžœ˜5šžœ
˜Jšžœžœ
žœ
žœžœ
žœ
žœ
žœ
ž˜/Jš
žœ
žœžœ
žœ
žœ
˜J˜!J˜
J˜
Jšžœ˜
J˜——šŸœžœžœ˜2šžœ
˜Jšžœžœ
žœ
žœžœ
žœ
žœ
žœ
ž˜/Jš
žœ
žœžœ
žœ
žœ
˜Jšžœžœ
ž˜šœžœžœ
ž˜)Jšœžœžœ
žœ
˜4Jšžœžœ
˜—šœžœžœ
ž˜+Jšœžœ
˜Jšžœžœ
˜—šœžœžœ
ž˜*Jš	œžœžœžœ
žœ
˜FJšžœžœ
˜—šœ
žœžœ
ž˜(Jšœ
žœžœ
žœ˜4Jšžœžœ
˜—šœžœžœ
ž˜)Jš	œžœžœžœ
žœ˜TJšžœžœ
˜—šœžœžœ
ž˜,˜Jšœžœ
žœ˜"Jšœžœ
žœ˜"š
ž˜Jšžœžœ
žœ
žœžœ
žœ
žœ
žœ
žœ
˜6Jšžœžœ
žœ
žœ
˜Jšžœžœ
žœ˜'J˜J˜Jšžœ˜
——Jšžœžœ
˜—šœžœžœ
ž˜)Jšœžœžœ
žœ
˜6Jšžœžœ
˜—šœžœžœ
ž˜#Jšœžœ
˜
Jšžœžœ
˜—šœ
žœžœ
ž˜%Jšœ
žœ
˜Jšžœžœ
˜—šœ
žœžœ
ž˜%J˜6Jšžœžœ
˜—šœ
žœžœ
ž˜%J˜'Jšžœžœ
˜—Jšžœžœ
˜J˜
J˜
Jšžœ˜
J˜——šŸœžœ
žœ˜2šžœ
˜Jšžœžœ
žœ
žœžœ
žœ
žœ
žœ
ž˜/Jš
žœ
žœžœ
žœ
žœ
˜Jš
žœžœ
žœžœ
žœ
žœ
ž˜EJšžœ
žœžœ
žœžœ
žœ
žœ
ž˜NJšžœ
žœ
žœ
ž˜šœžœžœ
žœ
ž˜$Jš	œžœžœžœ
žœ
˜Jšžœžœ
˜—š
œžœ
žœžœ
žœ
ž˜'Jšœžœ
žœžœ	žœ
žœ
˜$Jšžœžœ
˜—š
œžœ
žœžœ
žœ
ž˜(šœžœ
žœ˜Jšžœžœ
žœ
˜"šžœžœ
žœž˜Jšžœ
žœ
žœ
˜Jšžœ˜
——Jšžœžœ
˜—Jšžœžœ
˜J˜
J˜
Jšžœ˜
J˜J˜———Jšžœ
˜J˜J˜—…—%θ6)