EmSunConsole.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Last Edited by: Neil Gunther, November 1, 1985 2:58:57 pm PST
Crow, August 24, 1988 11:07:01 am PDT
Last tweaked by Mike Spreitzer on July 25, 1988 6:18:03 pm PDT
Spreitzer, February 19, 1986 8:51:31 pm PST
Norman Adams, March 5, 1990 3:33 pm PST
DIRECTORY
CharDisplays USING [ ],
DisplayControllers USING [ ActionProc, AddInstruction, DecodeRep, Naught,
   NewControlProgram ],
DisplayControllerSteps USING [ Beep, CarriageReturn, ClrTo, DeleteChar, Home, InsertSpace,
   JumpCursor, Line, SetEmph, SkipCursor, Tab ],
FS  USING [ ExpandName ],
Rope  USING [ ROPE ],
TermProgs  USING [ RegTerm, Term, TermRep ];
Emulates a Sun Console (or text window) as described in CONSOLE(4S).
EmSunConsole: CEDAR PROGRAM
IMPORTS DisplayControllers, DisplayControllerSteps, FS, TermProgs = BEGIN
OPEN DisplayControllers, DisplayControllerSteps, TermProgs;
ROPE: TYPE ~ Rope.ROPE;
Term: TYPE ~ TermProgs.Term;
TermRep: TYPE ~ TermProgs.TermRep;
ActionProc: TYPE ~ DisplayControllers.ActionProc;
tipName: ROPE ~ FS.ExpandName["SunKeyboard.tip"].fullFName;
MakeSunConsole: PROC RETURNS [t: Term] = {
t ¬ NEW [TermRep ¬ [cp: NewControlProgram[], tipTableName: tipName]];
Control Characters
t.det.lines ¬ 34;    -- set to 34-line window
AddInstruction[t.cp, LIST["\000"], [Naught]];  -- control-@ (null)
AddInstruction[t.cp, LIST["\007"], [Beep]];  -- control-G (bell)
AddInstruction[t.cp, LIST["\010"], [SkipCursor, $left]]; -- control-H (backspace)
AddInstruction[t.cp, LIST["\011"], [Tab, $dontTouch]]; -- control-I (tab)
AddInstruction[t.cp, LIST["\012"], [SkipCursor, $down]]; -- control-J (linefeed)
AddInstruction[t.cp, LIST["\013"], [SkipCursor, $up]]; -- control-K (un-linefeed)
AddInstruction[t.cp, LIST["\014"], [FormFeed]];  -- control-L (formfeed)
AddInstruction[t.cp, LIST["\015"], [CarriageReturn]]; -- control-M (return)
Escape Sequences
AddInstruction[t.cp, LIST["\033[@"], [InsertSpace]]; -- insert character
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "@"], [InsertSpaces, $v]];
AddInstruction[t.cp, LIST["\033[A"], [SkipCursor, $up]]; -- move cursor
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "A"], [CursorMove, $up]];
AddInstruction[t.cp, LIST["\033[B"], [SkipCursor, $down]];
AddInstruction[
t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "B"], [CursorMove, $down]];
AddInstruction[t.cp, LIST["\033[C"], [SkipCursor, $right]];
AddInstruction[
t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "C"], [CursorMove, $right]];
AddInstruction[t.cp, LIST["\033[D"], [SkipCursor, $left]];
AddInstruction[
t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "D"], [CursorMove, $left]];
  
AddInstruction[t.cp, LIST["\033[E"], [NextLine]];  -- next line (CRLF)
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "E"], [SkipLines]];
AddInstruction[t.cp, LIST["\033[f"], [Home]];  -- position cursor
AddInstruction[t.cp, LIST["\033[H"], [Home]];  -- home
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "f"], [StartOfLine]];
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "H"], [StartOfLine]];
AddInstruction[t.cp,     -- position using "f"
LIST["\033[", NEW [DecodeRep ¬ [reg: line]], ";", NEW [DecodeRep ¬ [reg: col]], "f"],
[NormCursor]
];
AddInstruction[t.cp,    -- position using "H"
LIST["\033[", NEW [DecodeRep ¬ [reg: line]], ";", NEW [DecodeRep ¬ [reg: col]], "H"],
[NormCursor]
];
AddInstruction[t.cp, LIST["\033[J"], [ClrTo, $eos]];  -- erase rest of display
AddInstruction[t.cp, LIST["\033[K"], [ClrTo, $eol]];  -- erase rest of line
AddInstruction[t.cp, LIST["\033[L"], [Line, $ins]];  -- insert line
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "L"], [Lines, $ins]];
AddInstruction[t.cp, LIST["\033[M"], [Line, $del]];  -- delete line
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "M"], [Lines, $del]];
AddInstruction[t.cp, LIST["\033[P"], [DeleteChar]];   -- delete character
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "P"], [DeleteChars]];
AddInstruction[t.cp, LIST["\033[m"], [SetEmph, $inverseOff]]; -- select graphic rendition
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "m"], [InvertChars]];
AddInstruction[t.cp, LIST["\033[p"], [Naught]]; -- set screen Black on White
AddInstruction[t.cp, LIST["\033[q"], [Naught]]; -- set screen White on Black
AddInstruction[t.cp, LIST["\033[r"], [Naught]];  -- set scrolling
AddInstruction[t.cp, LIST["\033[", NEW [DecodeRep ¬ [reg: line]], "r"], [Naught]];
AddInstruction[t.cp, LIST["\033[s"], [Reset]];  -- reset modes to default
AddInstruction[t.cp, LIST["\033[",
NEW [DecodeRep ¬ [reg: line]], ";",
NEW [DecodeRep ¬ [reg: col]], ";",
NEW [DecodeRep ¬ [reg: col]], "t"], [Naught]]; -- Meiko junk
};
FormFeed: ActionProc = {
Home[dc, NIL];
ClrTo[dc, $eos];
};
InsertSpaces: ActionProc = {
count: INTEGER ¬ dc.cps.regs[line];
FOR i: NAT IN [0..count) DO InsertSpace[dc, NIL]; ENDLOOP;
};
CursorMove: ActionProc = {
direction: REF ANY ¬ clientData;
count: INTEGER ¬ dc.cps.regs[line];
FOR i: NAT IN [0..count) DO SkipCursor[dc, direction]; ENDLOOP;
};
NextLine: ActionProc = {
CarriageReturn[dc, NIL];
SkipCursor[dc, $down];
};
SkipLines: ActionProc = {
CarriageReturn[dc, NIL];
CursorMove[dc, $down]
};
StartOfLine: ActionProc = {
dc.cps.regs[col] ¬ 1;
NormCursor[dc, NIL];
};
NormCursor: ActionProc = {
-- normalize cursor, cursor motion codes index from 1, but internally we index from 0
dc.cps.regs[line] ← MIN[33, dc.cps.regs[line]-1]; -- some things want 34 line sun screen
    -- ... but not me -nia
dc.cps.regs[line] ¬ MIN[dc.cd.det.lines, dc.cps.regs[line]] - 1; 
dc.cps.regs[col] ¬ MIN[dc.cd.det.columns, dc.cps.regs[col]] - 1;
JumpCursor[dc, $hv];
};
Lines: ActionProc = {
insertOrDelete: REF ANY ¬ clientData;
count: INTEGER ¬ dc.cps.regs[line];
FOR i: NAT IN [0..count) DO Line[dc, insertOrDelete]; ENDLOOP;
};
DeleteChars: ActionProc = {
count: INTEGER ¬ dc.cps.regs[line];
FOR i: NAT IN [0..count) DO DeleteChar[dc, NIL]; ENDLOOP;
};
InvertChars: ActionProc = {
SELECT dc.cps.regs[line] FROM
0 => SetEmph[dc, $inverseOff];
ENDCASE => SetEmph[dc, $inverseOn];
};
Reset: ActionProc = {
SetEmph[dc, $inverseOff];
};
{
t: Term ¬ MakeSunConsole[];
RegTerm["sunconsole", t];
RegTerm["sun", t];
};
END...