
    <<TIPTableReader.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Last Edited by McGregor, June 10, 1982 12:41 pm>>
        <<Last Edited by: Maxwell, January 3, 1983 11:33 am>>
        <<Last Edited by: Paul Rovner, June 15, 1983 11:27 am>>
        <<Doug Wyatt, April 14, 1985 10:31:38 pm PST>>

    DIRECTORY
        Atom USING [MakeAtom],
        IO USING [GetBlock, GetChar, STREAM],
        Interminal USING [KeyName],
        Rope USING [Equal, FromRefText, ROPE],
        TIPPrivate USING [KeyOption, stdChar, stdCoords, stdTime, version],
        TIPTables USING [TIPChoice, TIPChoiceSeries, TIPKeyState, TIPResults, TIPTableImplRep, TIPTerm],
        TIPUser USING [TIPTable, TIPTableRep];

    TIPTableReader: CEDAR PROGRAM
    IMPORTS Atom, IO, 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] };
        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 {
            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
                choice: TIPChoice _ Choice[TRUE];
                IF last=NIL THEN series _ last _ LIST[choice]
                ELSE last _ last.rest _ 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 [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: TIPKeyState _ KeyState[];
                    IF last=NIL THEN term.lst _ last _ LIST[keyState]
                    ELSE last _ last.rest _ LIST[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;
            char: CHAR;
            IF Char[] # '( THEN ERROR BadTable;
            WHILE (char _ Char[]) # ') DO
                result: REF ANY _ Result[char];
                IF last=NIL THEN results _ last _ LIST[result]
                ELSE last _ last.rest _ LIST[result];
                ENDLOOP;
            };
        Result: PROC [char: CHAR] RETURNS [REF ANY] = TRUSTED {
            SELECT char FROM
            '1 => RETURN [GetAtom[]];
            '2 => RETURN [stdChar]; 
            '3 => { num: REF INT _ 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 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;
            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.