DIRECTORY
Atom USING [MakeAtom],
IO USING [GetBlock, GetChar, Handle],
Interminal USING [KeyName],
Rope USING [Equal, FromRefText, ROPE],
TIPPrivate,
TIPUser,
TIPTables;
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 };