
    <<DisplayControllersImpl.Mesa>>
<<Last Edited by: Spreitzer, March 13, 1985 12:31:21 pm PST>>

    DIRECTORY Ascii, DisplayControllers, IO, RefText, Rope;

    DisplayControllersImpl: CEDAR PROGRAM
        IMPORTS IO, RefText, Rope
        EXPORTS DisplayControllers

         = {OPEN DisplayControllers;

        naught: PUBLIC Action _ [proc: Naught, clientData: NIL];
        cmdFailed: Action _ [proc: CmdFailed, clientData: NIL];
        print: Action _ [proc: Print, clientData: NIL];

        displayDriverClass: ATOM = $TermEmDisplayController;

        displayDriverProcs: REF IO.StreamProcs _ IO.CreateStreamProcs[
            variety: input,
            class: displayDriverClass,
            putChar: ConsumeChar];

        Create: PUBLIC PROC [cd: CharDisplay, cp: ControlProgram] RETURNS [dc: DisplayController] = {
            dc _ NEW [DisplayControllerRep _ [
                cd: cd,
                cp: cp,
                cps: NEW [ControlProgramStateRep _ [
                    curVertex: cp.start,
                    chars: RefText.New[10]]],
                toDisplay: NIL,
                fromDisplay: cd.fromDisplay
                ]];
            dc.toDisplay _ IO.CreateStream[streamProcs: displayDriverProcs, streamData: dc];
            };

        ConsumeChar: PROC [self: IO.STREAM, char: CHAR] = {
            dc: DisplayController _ NARROW[self.streamData];
            consumed: BOOL _ FALSE;
            IF dc.cps.curVertex = dc.cp.start THEN dc.cps.chars.length _ 0;
            WHILE dc.cps.chars.length >= dc.cps.chars.maxLength DO dc.cps.chars _ RefText.New[dc.cps.chars.maxLength*2] ENDLOOP;
            dc.cps.chars _ RefText.InlineAppendChar[dc.cps.chars, char];
            DO
                Do: PROC [t: Transition] = INLINE {
                    t.action.proc[dc: dc, clientData: t.action.clientData];
                    dc.cps.curVertex _ t.newVertex};
                v: Vertex _ dc.cps.curVertex;
                SELECT v.repStyle FROM
                    epsilon => Do[v.t];
                    list => {
                        el: EdgeList _ NIL;
                        IF consumed THEN EXIT;
                        consumed _ TRUE;
                        FOR el _ v.edgeList, el.rest WHILE el # NIL DO
                            IF el.first.char = char THEN {Do[el.first.transition]; EXIT};
                            ENDLOOP;
                        IF el = NIL THEN Do[v.t];
                        };
                    array => {
                        IF consumed THEN EXIT;
                        consumed _ TRUE;
                        Do[v.edgeArray[char]];
                        };
                    ENDCASE => ERROR;
                ENDLOOP;
            };

        NewControlProgram: PUBLIC PROC [clientData: REF ANY _ NIL] RETURNS [cp: ControlProgram] = {
            sv: Vertex _ NEW [VertexRep _ [repStyle: array]];
            sv.edgeArray _ NEW [TransitionArrayRep _ ALL[[print, sv]]];
            cp _ NEW [ControlProgramRep _ [
                start: sv,
                clientData: clientData]];
            };

        AddInstruction: PUBLIC PROC [cp: ControlProgram, steps: StepList, final: Action] = {
            v: Vertex _ cp.start;
            FOR steps _ steps, steps.rest WHILE steps # NIL DO
                lastStep: BOOL _ steps.rest = NIL;
                WITH steps.first SELECT FROM
                    t: REFTEXT => {
                        lastI: INT = t.length-1;
                        FOR i: INT IN [0 .. lastI] DO
                            IF lastStep AND i=lastI AND final # naught
                                THEN {v _ Merge[cp: cp, last: TRUE, char: t[i], a: final, v: v];
                                    final _ naught}
                                ELSE v _ Merge[cp: cp, last: lastStep AND i=lastI AND final=naught, char: t[i], v: v];
                            ENDLOOP;
                        };
                    r: ROPE => {
                        lastI: INT = r.Length[]-1;
                        FOR i: INT IN [0 .. lastI] DO
                            IF lastStep AND i=lastI AND final # naught
                                THEN {v _ Merge[cp: cp, last: TRUE, char: r.Fetch[i], a: final, v: v];
                                    final _ naught}
                                ELSE v _ Merge[cp: cp, last: lastStep AND i=lastI AND final=naught, char: r.Fetch[i], v: v];
                            ENDLOOP;
                        };
                    d: Decode => {
                        IF d.len = 0 THEN {
                            dec0: Action _ DecodeAction[d, 0];
                            dec1: Action _ DecodeAction[d, 1];
                            IF lastStep THEN ERROR;
                            v _ MergeDigits[d: d, cp: cp, last: FALSE, a: dec0, v: v];
                            IF v # MergeDigits[d: d, cp: cp, last: FALSE, to: v, a: dec1, v: v] THEN ERROR;
                            }
                        ELSE {
                            FOR i: INT IN [0 .. d.len) DO
                                dec: Action _ DecodeAction[d, i];
                                v _ MergeDigits[d: d, cp: cp, last: lastStep AND i=d.len-1 AND final=naught, a: dec, v: v];
                                ENDLOOP;
                            };
                        };
                    ENDCASE => ERROR;
                ENDLOOP;
            IF final # naught THEN {
                IF v = cp.start THEN ERROR;
                v _ Append[cp: cp, a: final, from: v, to: cp.start]};
            IF v # cp.start THEN ERROR;
            };

        Boring: PROC [cp: ControlProgram, t: Transition, from: Vertex, a: Action] RETURNS [boring: BOOL] = {
            boring _ ActionEqual[t.action, a] OR (t.action = naught) OR (t.newVertex = cp.start AND t.action = cmdFailed) OR (from = cp.start 
            AND t.action = print)};

        ActionEqual: PROC [a1, a2: Action] RETURNS [eq: BOOL] = {
            IF a1.proc # a2.proc THEN RETURN [FALSE];
            IF a1.clientData = a1.clientData THEN RETURN [TRUE];
            WITH a1.clientData SELECT FROM
                dd1: DecodeData => WITH a2.clientData SELECT FROM
                    dd2: DecodeData => RETURN [dd1.i = dd2.i AND dd1.d^ = dd2.d^];
                    ENDCASE => RETURN [FALSE];
                ENDCASE => RETURN [FALSE];
            };

        AddEpsilon: PROC [t: Transition, a: Action] RETURNS [u: Transition] = {
            u _ [
                action: a,
                newVertex: NEW [VertexRep _ [epsilon, t]]
                ]};

        MergeDigits: PROC
            [
                d: Decode,
                cp: ControlProgram,
                last: BOOL,
                to: Vertex _ NIL,
                a: Action,
                v: Vertex]
            RETURNS [newV: Vertex] = {
            deltaMax: NAT _ MIN[(LAST[CHAR] - d.org), d.base-1];
            newV _ to;
            FOR c: CHAR IN [d.org .. d.org + deltaMax] DO
                ans: Vertex _ Merge[cp: cp, last: last, char: c, to: newV, a: a, v: v];
                IF newV = NIL THEN newV _ ans ELSE IF newV # ans THEN ERROR;
                ENDLOOP;
            };

        Append: PROC [cp: ControlProgram, a: Action, from, to: Vertex _ NIL] RETURNS [newV: Vertex] = {
            IF NOT (from.repStyle = list AND from.edgeList = NIL AND from.t = [cmdFailed, cp.start]) THEN ERROR;
            from.repStyle _ epsilon;
            IF to # NIL THEN {
                IF to # from.t.newVertex THEN ERROR;
                from.t.action _ a;
                newV _ from.t.newVertex;
                }
            ELSE {
                newV _ NEW [VertexRep _ [repStyle: list, t: [cmdFailed, cp.start]]];
                from.t _ [a, newV];
                };
            };

        Merge: PROC
            [
                cp: ControlProgram,
                last: BOOL,
                char: CHAR,
                to: Vertex _ NIL,
                a: Action _ naught,
                v: Vertex]
            RETURNS [newV: Vertex]
            = {
            NextV: PROC RETURNS [v: Vertex] = {v _
                IF last THEN cp.start ELSE
                IF to # NIL THEN to ELSE
                NEW [VertexRep _ [repStyle: list, t: DefaultEnd[cp]]];
                };
            StepAction: PROC RETURNS [a: Action] =
                {a _ IF last THEN cmdFailed ELSE naught};
            IF last AND to # NIL THEN ERROR;
            SELECT v.repStyle FROM
                epsilon => ERROR;
                list => {
                    el: EdgeList _ NIL;
                    FOR el _ v.edgeList, el.rest WHILE el # NIL DO
                        IF el.first.char = char THEN EXIT;
                        ENDLOOP;
                    IF el = NIL THEN v.edgeList _ el _ CONS[[char: char, transition: [action: StepAction[], newVertex: NextV[]]], v.edgeList]
                    ELSE IF to # NIL AND el.first.transition.newVertex # to THEN ERROR;
                    IF Boring[cp, el.first.transition, v, a] THEN el.first.transition.action _ a
                    ELSE IF a # naught THEN el.first.transition _ AddEpsilon[el.first.transition, a];
                    newV _ el.first.transition.newVertex;
                    };
                array => {
                    IF
                        v.edgeArray[char].newVertex = cp.start
                        AND (NOT last)
                        AND (
                            v.edgeArray[char].action = cmdFailed
                            OR (v.edgeArray[char].action = print AND v = cp.start))
                        THEN v.edgeArray[char] _ [action: StepAction[], newVertex: NextV[]];
                    IF Boring[cp, v.edgeArray[char], v, a] THEN v.edgeArray[char].action _ a
                    ELSE IF a # naught THEN v.edgeArray[char] _ AddEpsilon[v.edgeArray[char], a];
                    newV _ v.edgeArray[char].newVertex;
                    };
                ENDCASE => ERROR;
            DO
                SELECT newV.repStyle FROM
                    epsilon => newV _ newV.t.newVertex;
                    list, array => EXIT;
                    ENDCASE => ERROR;
                ENDLOOP;
            IF last AND newV # cp.start THEN ERROR;
            };

        DefaultEnd: PROC [cp: ControlProgram] RETURNS [t: Transition] =
            {t _ [action: cmdFailed, newVertex: cp.start]};

        ClearRegAction: PROC [d: Decode] RETURNS [a: Action] =
            {a _ [proc: ClearReg, clientData: d]};

        ClearReg: PROC [dc: DisplayController, clientData: REF ANY] = {
            d: Decode _ NARROW[clientData];
            dc.cps.regs[d.reg] _ d.offset};

        DecodeData: TYPE = REF DecodeDataRep;
        DecodeDataRep: TYPE = RECORD [
            d: Decode,
            i: NAT];

        DecodeAction: PROC [d: Decode, i: NAT] RETURNS [a: Action] =
            {a _ [proc: DecodeReg, clientData: NEW [DecodeDataRep _ [d, i]]]};

        DecodeReg: PROC [dc: DisplayController, clientData: REF ANY] = {
            dd: DecodeData _ NARROW[clientData];
            c: CHAR _ dc.cps.chars[dc.cps.chars.length-1];
            IF dd.i = 0 THEN dc.cps.regs[dd.d.reg] _ dd.d.offset;
            dc.cps.regs[dd.d.reg] _
                (dc.cps.regs[dd.d.reg] - dd.d.offset) * dd.d.base
                + (c - dd.d.org)
                + dd.d.offset;
            };

        Naught: PROC [dc: DisplayController, clientData: REF ANY] = {};

        CmdFailed: PROC [dc: DisplayController, clientData: REF ANY] = {
            Do: PROC [c: CHAR] = INLINE {dc.cd.class.TakeChar[dc.cd, c]};
            Do['?];
            FOR i: INT IN [0 .. dc.cps.chars.length) DO Do[dc.cps.chars[i]] ENDLOOP;
            Do['?];
            };

        Print: PROC [dc: DisplayController, clientData: REF ANY] = {
            cd: CharDisplay _ dc.cd;
            c: CHAR _ dc.cps.chars[dc.cps.chars.length-1];
            cd.class.TakeChar[cd, c];
            };

        }.