<<>>
    <<DisplayControllersImpl.Mesa>>
        <<Copyright Ó 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Mike Spreitzer August 26, 1986 9:23:58 pm PDT>>
        <<Last tweaked by Mike Spreitzer on November 6, 1989 3:34:13 pm PST>>
        <<Norman Adams, March 13, 1990 2:05 pm PST>>
            <<Add conditional to FlushDisplay, add method for putBlock.>>

    DIRECTORY Ascii, Basics, CharDisplays, DisplayControllers, IO, RefText, Rope;

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

         = {OPEN DisplayControllers;

        neverMind: Action Ź [proc: Naught, overrideable: TRUE];
        print: Action Ź [proc: Print, overrideable: TRUE];

        displayDriverClass: ATOM = $TermEmDisplayController;

        displayDriverProcs: REF IO.StreamProcs Ź IO.CreateStreamProcs[
            variety: output,
            class: displayDriverClass,
            flush: FlushDisplay,
            putChar: ConsumeChar,
            putBlock: ConsumeChars
            ];

        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
                ]];
            IF cp.Init # NIL THEN cp.Init[dc];
            dc.toDisplay Ź IO.CreateStream[streamProcs: displayDriverProcs, streamData: dc];
            };

        SetDriver: PUBLIC PROC [dc: DisplayController, driver: IO.STREAM] = {
            dc.driver Ź driver;
            };

        FlushDisplay: PROC [self: IO.STREAM] = {
            dc: DisplayController = NARROW[self.streamData];
            IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
            IF dc.cd.class.Flush # NIL THEN dc.cd.class.Flush[dc.cd];
            };

        ConsumeChar: PROC [self: IO.STREAM, char: CHAR] = {
            dc: DisplayController Ź NARROW[self.streamData];
            consumed: BOOL Ź FALSE;
            IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
            SELECT dc.cp.bits FROM
                7 => char Ź VAL[Basics.BITAND[ORD[char], 127]];
                8 => NULL;
                ENDCASE => ERROR;
            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
                ENABLE CharDisplays.DisplayDestroyed => ERROR IO.Error[StreamClosed, self];
                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;
            <<Consider Flushing:>>
                {driver: IO.STREAM = dc.driver;
                flush: BOOL Ź driver = NIL;
                IF NOT flush THEN flush Ź driver.CharsAvail[!IO.Error => {flush Ź TRUE; CONTINUE}] = 0;
                IF flush AND dc.cd.class.Flush # NIL THEN dc.cd.class.Flush[dc.cd];
                };
            };

        ConsumeChars: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT Ź 0, count: NAT Ź NAT.LAST] = {
            ENABLE CharDisplays.DisplayDestroyed => ERROR IO.Error[StreamClosed, self];

            dc: DisplayController Ź NARROW[self.streamData];

            IF startIndex+count > block.maxLength THEN count Ź block.length - startIndex;

            FOR i: INT IN [startIndex..startIndex+count) DO
                char: CHAR Ź block[i];
                consumed: BOOL Ź FALSE;

                IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
                SELECT dc.cp.bits FROM
                    7 => char Ź VAL[Basics.BITAND[ORD[char], 127]];
                    8 => NULL;
                    ENDCASE => ERROR;
                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;

                ENDLOOP;

                -- Consider flushing
                IF dc.cd.class.Flush # NIL THEN  {
                    IF (dc.driver#NIL) AND (dc.driver.CharsAvail[!IO.Error=>CONTINUE] >0 ) THEN RETURN;
                    dc.cd.class.Flush[dc.cd]
                    }
                };

        NewControlProgram: PUBLIC PROC [Init: PROC [dc: DisplayController] Ź NIL, clientData: REF ANY Ź NIL, bits: [7 .. 8] Ź 8] RETURNS 
        [cp: ControlProgram] = {
            sv: Vertex Ź NEW [VertexRep Ź [repStyle: array]];
            sv.edgeArray Ź NEW [TransitionArrayRep Ź ALL[[print, sv]]];
            cp Ź NEW [ControlProgramRep Ź [
                start: sv,
                Init: Init,
                clientData: clientData,
                bits: bits]];
            };

        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
                                THEN v Ź Merge[cp: cp, char: t[i], v: v, last: TRUE, a: final]
                                ELSE v Ź Merge[cp: cp, char: t[i], v: v, last: FALSE];
                            ENDLOOP;
                        IF lastStep THEN final Ź neverMind;
                        };
                    r: ROPE => {
                        lastI: INT = r.Length[]-1;
                        FOR i: INT IN [0 .. lastI] DO
                            IF lastStep AND i=lastI
                                THEN v Ź Merge[cp: cp, char: r.Fetch[i], v: v, last: TRUE, a: final]
                                ELSE v Ź Merge[cp: cp, char: r.Fetch[i], v: v, last: FALSE];
                            ENDLOOP;
                        IF lastStep THEN final Ź neverMind;
                        };
                    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=neverMind, a: dec, v: v];
                                ENDLOOP;
                            };
                        };
                    ENDCASE => ERROR;
                IF (v = cp.start) # (lastStep AND final = neverMind) THEN ERROR;
                ENDLOOP;
            IF final # neverMind THEN {
                IF v = cp.start THEN ERROR;
                v Ź Append[cp: cp, a: final, from: v, to: cp.start]};
            IF v # cp.start THEN ERROR;
            };

        Replaceable: PROC [cp: ControlProgram, t: Transition, from: Vertex, a: Action] RETURNS [boring: BOOL] = {
            boring Ź t.action.overrideable OR ActionEqual[t.action, a]};

        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
                xc: CHAR Ź 0C + XOR[c-0C, d.xor];
                ans: Vertex Ź Merge[cp: cp, last: last, char: xc, 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 = [print, 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: [print, cp.start]]];
                from.t Ź [a, newV];
                };
            };

        Merge: PROC
            [
                cp: ControlProgram,
                last: BOOL,
                char: CHAR,
                to: Vertex Ź NIL,
                a: Action Ź neverMind,
                v: Vertex]
            RETURNS [newV: Vertex]
            = {
            NextV: PROC RETURNS [v: Vertex] = {
                v Ź IF to # NIL
                    THEN to
                    ELSE NEW [VertexRep Ź [repStyle: list, t: DefaultEnd[cp]]];
                };
            Update: PROC [oldT: Transition] RETURNS [newT: Transition] = {
                oldNext: Vertex Ź oldT.newVertex;
                rbl: BOOL Ź Replaceable[cp, oldT, v, a];
                IF oldNext # to THEN {
                    IF to # NIL AND ((NOT rbl) OR oldNext # cp.start) THEN ERROR;
                    IF to = NIL AND (NOT rbl) AND (oldNext = cp.start OR NOT a.overrideable) THEN ERROR;
                    };
                newT Ź oldT;
                IF rbl THEN {
                    IF oldNext = cp.start OR to # NIL THEN newT Ź [a, NextV[]] ELSE newT.action Ź a;
                    }
                ELSE IF to # NIL AND NOT a.overrideable THEN newT Ź AddEpsilon[newT, a];
                };
            IF last THEN {
                IF to = NIL THEN to Ź cp.start ELSE IF to # cp.start THEN ERROR;
                IF a = neverMind THEN a Ź print;
                };
            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: v.t], v.edgeList];
                    newV Ź (el.first.transition Ź Update[el.first.transition]).newVertex;
                    };
                array => {
                    newV Ź (v.edgeArray[char] Ź Update[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: print, 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
                + (XOR[c-0C, dd.d.xor] - (dd.d.org - 0C))
                + dd.d.offset;
            };

        XOR: PROC [i1, i2: INTEGER] RETURNS [i3: INTEGER] =
            TRUSTED {i3 Ź Basics.BITXOR[i1, i2]};

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

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

        }.