
    <<EmTermCapImpl.Mesa>>
<<Last Edited by: Spreitzer, March 14, 1985 11:51:46 am PST>>

    DIRECTORY Ascii, Atom, Basics, BasicTime, CharDisplays, Convert, DisplayControllers, EmTermCap, FS, IO, OrderedSymbolTableRef, 
    Rope, TermCaps;

    EmTermCapImpl: CEDAR PROGRAM
        IMPORTS Atom, DisplayControllers, IO, Rope, TermCaps
        EXPORTS EmTermCap

         = {OPEN CharDisplays, DisplayControllers, TermCaps;

        AtomList: TYPE = EmTermCap.AtomList;

        Cant: PUBLIC ERROR [msg: ROPE] = CODE;

        NumChars: INT _ 1 + (LAST[CHAR] - FIRST[CHAR]);

        MakeTermController: PUBLIC PROC [term: Term, allowPartial: BOOL _ FALSE] RETURNS [cp: ControlProgram, det: DisplayDetails, 
        unGrokked: AtomList] = {
            tabStr: ROPE _ NIL;
            tabDat: ATOM _ $dontTouch;
            PerCap: PROC [cap: Cap] RETURNS [stop: BOOL] = {
                Int: PROC RETURNS [i: INT] = {
                    WITH cap.val SELECT FROM
                        ri: RefInt => RETURN [ri^];
                        ENDCASE => Cant[cap.name.Cat[" not an int"]]};
                Str: PROC RETURNS [r: ROPE] = {
                    WITH cap.val SELECT FROM
                        s: String => RETURN [s.str];
                        ENDCASE => Cant[cap.name.Cat[" not a str"]]};
                key: ATOM _ Atom.MakeAtom[cap.name];
                stop _ FALSE;
                WITH cap.val SELECT FROM
                    s: String => {IF s.str.Length[] = 0 AND s.pad = 0.0 THEN RETURN};
                    ENDCASE;
                SELECT key FROM
                $ae => NULL--ignore alt char set--;
                $al => AddInstruction[cp, LIST[Str[]], [Line, $ins]];
                $am => det.autoMargins _ TRUE;
                $as => NULL--ignore alt char set--;
                $bc => AddInstruction[cp, LIST[Str[]], [MC, $left]];
                $bl => AddInstruction[cp, LIST[Str[]], flash];
                $bs => AddInstruction[cp, LIST["\010"], [MC, $left]];
                $cd => AddInstruction[cp, LIST[Str[]], [ClrTo, $eos]];
                $ce => AddInstruction[cp, LIST[Str[]], [ClrTo, $eol]];
                $ch => AddInstruction[cp, CMProg[Str[], FALSE, TRUE], [CM, $h]];
                $cl => AddInstruction[cp, LIST[Str[]], clearScreen];
                $cm => AddInstruction[cp, CMProg[Str[], TRUE, TRUE], [CM, $hv]];
                    $co => det.columns _ Int[];
                $cr => AddInstruction[cp, LIST[Str[]], cr];
                $cv => AddInstruction[cp, CMProg[Str[], TRUE, FALSE], [CM, $v]];
                $dB, $dC, $dF, $dN, $dT => NULL--ignore delay specs--;
                $dc => AddInstruction[cp, LIST[Str[]], deleteChar];
                $dl => AddInstruction[cp, LIST[Str[]], [Line, $del]];
                $dm => NULL--try ignoring delete mode shifts--;
                $do => AddInstruction[cp, LIST[Str[]], [MC, $down]];
                $ed => NULL--try ignoring delete mode shifts--;
                $ei => AddInstruction[cp, LIST[Str[]], [SM, $insCharOff]];
                $eo => NULL --always true--;
                $ho => AddInstruction[cp, LIST[Str[]], home];
                $hz => NULL --why not?--;
                $ic => AddInstruction[cp, LIST[Str[]], insertSpace];
                $if => NULL;
                $im => AddInstruction[cp, LIST[Str[]], [SM, $insCharOn]];
                $is => NULL;
                $ff => AddInstruction[cp, LIST[Str[]], clearScreen];
                $kl, $kr, $ku, $kd, $kh => NULL-- no keypad here--;
                $kb, $kh, $kn => NULL;
                $k0, $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8, $k9 => NULL--no fn keys--;
                $l0, $l1, $l2, $l3, $l4, $l5, $l6, $l7, $l8, $l9 => NULL--no fn keys--;
                $ko => NULL--who cares?--;
                $le => AddInstruction[cp, LIST[Str[]], [MC, $left]];
                    $li => det.lines _ Int[];
                $ma => NULL--ignore arrow map--;
                $mi => NULL;
                $ms => NULL--always true--;
                $MT => NULL;
                $nd => AddInstruction[cp, LIST[Str[]], [MC, $right]];
                $nl => AddInstruction[cp, LIST[Str[]], [MC, $down]];
                $pc => AddInstruction[cp, LIST[Str[]], null];
                $pt => NULL;
                $se => AddInstruction[cp, LIST[Str[]], [SM, $standoutOff]];
                $so => AddInstruction[cp, LIST[Str[]], [SM, $standoutOn]];
                $sr => AddInstruction[cp, LIST[Str[]], scrollBack];
                $ta => tabStr _ Str[];
                $uc => AddInstruction[cp, LIST[Str[]], uc];
                $ue => AddInstruction[cp, LIST[Str[]], [SM, $underlineOff]];
                $up => AddInstruction[cp, LIST[Str[]], [MC, $up]];
                $us => AddInstruction[cp, LIST[Str[]], [SM, $underlineOn]];
                    $vb => AddInstruction[cp, LIST[Str[]], flash];
                    $xs => NULL;
                    $xt => tabDat _ $blanken;
                    ENDCASE => IF allowPartial
                        THEN unGrokked _ CONS[key, unGrokked]
                        ELSE Cant[IO.PutFR["Can't do feature: %g", IO.rope[cap.name]]];
                };
            cp _ NewControlProgram[];
            det.autoMargins _ FALSE;
            unGrokked _ NIL;
            EnumerateCaps[term, PerCap];
            IF tabStr.Length[] > 0 THEN AddInstruction[cp, LIST[tabStr], [Tab, tabDat]];
            };

        cr: Action _ [CR];
        CR: PROC [dc: DisplayController, clientData: REF ANY] =
            {dc.cd.class.CursorMove[dc.cd, 0, 0, FALSE, FALSE]};

        home: Action _ [Home];
        Home: PROC [dc: DisplayController, clientData: REF ANY] =
            {dc.cd.class.CursorMove[dc.cd, 0, 0, FALSE]};

        scrollBack: Action _ [ScrollBack];
        ScrollBack: PROC [dc: DisplayController, clientData: REF ANY] = {
            oldLine: INT _ dc.cd.line;
            oldCol: INT _ dc.cd.col;
            dc.cd.class.CursorMove[cd: dc.cd, line: dc.cd.det.lines-1, col: 0];
            dc.cd.class.Line[dc.cd, FALSE];
            dc.cd.class.CursorMove[cd: dc.cd, line: 0, col: 0];
            dc.cd.class.Line[dc.cd, TRUE];
            dc.cd.class.CursorMove[cd: dc.cd, line: oldLine, col: oldCol];
            };

        clearScreen: Action _ [ClearScreen];
        ClearScreen: PROC [dc: DisplayController, clientData: REF ANY] = {
            dc.cd.class.ClearAll[dc.cd];
            dc.cd.class.CursorMove[dc.cd, 0, 0];
            };

        deleteChar: Action _ [DeleteChar];
        DeleteChar: PROC [dc: DisplayController, clientData: REF ANY] =
            {dc.cd.class.DeleteChar[dc.cd]};

        uc: Action _ [UC];
        UC: PROC [dc: DisplayController, clientData: REF ANY] = {
            dc.cd.class.Emphasize[dc.cd, underline, TRUE];
            dc.cd.class.CursorMove[dc.cd, 0, 1, TRUE];
            };

        ClrTo: PROC [dc: DisplayController, clientData: REF ANY] =
            {where: Where;
            SELECT clientData FROM
                $eos => where _ EndOfScreen;
                $eol => where _ EndOfLine;
                ENDCASE => ERROR;
            dc.cd.class.ClearTo[dc.cd, where]};

        MC: PROC [dc: DisplayController, clientData: REF ANY] =
            {dLine, dCol: INT _ 0;
            SELECT clientData FROM
                $down => dLine _ 1;
                $up => dLine _ -1;
                $right => dCol _ 1;
                $left => dCol _ -1;
                ENDCASE => ERROR;
            dc.cd.class.CursorMove[dc.cd, dLine, dCol, TRUE]};

        CMProg: PROC [r: ROPE, doLine, doCol: BOOL] RETURNS [sl: StepList] = {
            tl: StepList _ NIL;
            Append: PROC [s: Step] = {
                this: StepList _ LIST[s];
                IF tl = NIL THEN sl _ this ELSE tl.rest _ this;
                tl _ this};
            rs: IO.STREAM _ IO.RIS[r];
            d: DecodeRep _ [line];
            toDo: LIST OF RegID _ NIL;
            Do: PROC = {
                d.reg _ toDo.first;
                Append[NEW [DecodeRep _ d]];
                toDo _ toDo.rest;
                };
            IF doCol THEN toDo _ CONS[col, toDo];
            IF doLine THEN toDo _ CONS[line, toDo];
            WHILE NOT rs.EndOf[] DO
                char: CHAR _ rs.GetChar[];
                SELECT char FROM
                    '% => {
                        IF rs.EndOf[] THEN {Append[Rope.FromChar[char]]; EXIT};
                        char _ rs.GetChar[];
                        SELECT char FROM
                            'd => {d.base _ 10; d.org _ '0; d.len _ 0; Do[]};
                            '2 => {d.base _ 10; d.org _ '0; d.len _ 2; Do[]};
                            '3 => {d.base _ 10; d.org _ '0; d.len _ 3; Do[]};
                            '. => {d.base _ NumChars; d.org _ 0C; d.len _ 1; Do[]};
                            'r => {toDo _ CONS[toDo.rest.first, CONS[toDo.first, toDo.rest.rest]]};
                            'i => d.offset _ 1;
                            '% => Append[Rope.FromChar[char]];
                            '+ => {
                                IF rs.EndOf[] THEN {Append[Rope.FromChar[char]]; EXIT};
                                char _ rs.GetChar[];
                                d.base _ NumChars; d.org _ char; d.len _ 1; Do[];
                                };
                            ENDCASE => ERROR;
                        };
                    ENDCASE => Append[Rope.FromChar[char]];
                ENDLOOP;
            rs.Close[];
            };

        CM: PROC [dc: DisplayController, clientData: REF ANY] =
            {doLine, doCol: BOOL _ TRUE;
            SELECT clientData FROM
                $h => doLine _ FALSE;
                $v => doCol _ FALSE;
                $hv => NULL;
                ENDCASE => ERROR;
            dc.cd.class.CursorMove[dc.cd, dc.cps.regs[line], dc.cps.regs[col], FALSE, doLine, doCol]};

        Line: PROC [dc: DisplayController, clientData: REF ANY] = {
            insert: BOOL _ SELECT clientData FROM
                $ins => TRUE,
                $del => FALSE,
                ENDCASE => ERROR;
            dc.cd.class.Line[dc.cd, insert]};

        SM: PROC [dc: DisplayController, clientData: REF ANY] = {
            mode: Mode;
            on: BOOL;
            SELECT clientData FROM
                $insCharOn => {mode _ insertChar; on _ TRUE};
                $insCharOff => {mode _ insertChar; on _ FALSE};
                $underlineOn => {mode _ underline; on _ TRUE};
                $underlineOff => {mode _ underline; on _ FALSE};
                $standoutOn => {mode _ standout; on _ TRUE};
                $standoutOff => {mode _ standout; on _ FALSE};
                ENDCASE => ERROR;
            dc.cd.class.SetMode[dc.cd, mode, on]};

        insertSpace: Action _ [InsertSpace, NIL];
        InsertSpace: PROC [dc: DisplayController, clientData: REF ANY] = {
            news: BOOL _ PushMode[dc.cd, insertChar];
            line: INT _ dc.cd.line;
            col: INT _ dc.cd.col;
            dc.cd.class.TakeChar[dc.cd, Ascii.SP];
            PopMode[dc.cd, insertChar, news];
            dc.cd.class.CursorMove[dc.cd, 0, -1, TRUE];
            };

        PushMode: PROC [cd: CharDisplay, mode: Mode] RETURNS [news: BOOL] =
            {IF (news _ NOT cd.modes[mode]) THEN cd.class.SetMode[cd, mode, TRUE]};

        PopMode: PROC [cd: CharDisplay, mode: Mode, news: BOOL] =
            {IF news THEN cd.class.SetMode[cd, mode, FALSE]};

        flash: Action _ [Flash];
        Flash: PROC [dc: DisplayController, clientData: REF ANY] =
            {dc.cd.class.Flash[dc.cd]};

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

        Tab: PROC [dc: DisplayController, clientData: REF ANY] = {
            delta: INT _ (8 - (dc.cd.col MOD 8)) MOD 8;
            SELECT clientData FROM
                $blanken => {
                    FOR i: INT IN [0 .. delta) DO
                        dc.cd.class.TakeChar[dc.cd, Ascii.SP];
                        ENDLOOP;
                    };
                $dontTouch => dc.cd.class.CursorMove[dc.cd, 0, delta, TRUE];
                ENDCASE => ERROR;
            };

        }.