[Cyan]<Cedar6.0>TIP>TIPTableReaderWriter.mesa!2

TIPTableReaderWriter.mesa

Doug Wyatt, April 14, 1985 10:31:38 pm PST

Russ Atkinson (RRA) October 30, 1985 7:13:58 pm PST

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 => {

keytrigger

keyTerm: keyTrigger TIPTerm;

keyTerm.keyState.key ← Key[];

keyTerm.keyState.state ← SELECT Char[] FROM

'U => up, 'D => down, ENDCASE => ERROR BadTable;

RETURN [LIST[keyTerm]] };

'2 => {

mousetrigger

mouseTerm: mouseTrigger TIPTerm;

RETURN [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 [LIST[timeTerm]] };

'4 => {

keyenable

keyTerm: keyEnable TIPTerm;

keyTerm.keyState ← KeyState[];

RETURN [LIST[keyTerm]] };

'5 => {

predenable

predTerm: predEnable TIPTerm;

predTerm.predicate ← GetAtom[];

RETURN [LIST[predTerm]] };

'6 => {

char

charTerm: char TIPTerm;

charTerm.ch ← stdChar;

RETURN [LIST[charTerm]] };

'7 => {

coords

coordsTerm: coords TIPTerm;

coordsTerm.xy ← stdCoords;

RETURN [LIST[coordsTerm]] };

'8 => {

choiceseries

term: nested TIPTerm;

term.statement ← ChoiceSeries[];

RETURN [LIST[term]] };

'9 => {

results

resultTerm: result TIPTerm;

resultTerm.list ← Results[];

RETURN [LIST[resultTerm]] };

'A => {

key2Enable

term: key2Enable TIPTerm;

term.keyState1 ← KeyState[];

term.keyState2 ← KeyState[];

RETURN [LIST[term]] };

'B => {

keyEnableList

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 => {

TIME

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;

Note: don't depend on left-to-right evaluation

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 table

small: REF small TIPTableImplRep ← NEW[small TIPTableImplRep];

table ← NEW[TIPTableRep ← [impl: small]];

StoreFlags[];

small.all ← ChoiceSeries[];

};

'F => {

fast table

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;

};

EqualChoiceSeries: PROC [c1, c2: TIPChoiceSeries] = {

check each choice on list

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 {

check each term on list

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;

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;

check each term on list

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;

cList1 ← cList1.rest;

cList2 ← cList2.rest;

ENDLOOP;

};

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 };

IF debug THEN debugStream ← IO.CreateViewerStreams["TIPTableWriterDebugLog"].out;

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.