VT100/Ansi.mod

IMPLEMENTATION MODULE Ansi;

IMPORT ASCII;
FROM STextIO IMPORT WriteChar, WriteString;
FROM NumberIO IMPORT WriteCard;
IMPORT IO, termios, FIO;

VAR
  savedTerm : termios.TERMIOS;
  flushFlag : INTEGER;
  haveTerm : BOOLEAN;

PROCEDURE CSI;
BEGIN WriteChar(ASCII.esc); WriteChar("["); END CSI;

PROCEDURE CSIq;
BEGIN WriteChar(ASCII.esc); WriteString("[?"); END CSIq;

PROCEDURE CSIe;
BEGIN WriteChar(ASCII.esc); WriteString("[="); END CSIe;

PROCEDURE ESC1(c : CHAR);
BEGIN WriteChar(ASCII.esc); WriteChar(c); END ESC1;

(* Cursor *)
PROCEDURE Home; BEGIN CSI; WriteChar("H"); END Home;

PROCEDURE Position(line, col : CARDINAL);
BEGIN CSI; WriteCard(line, 1); WriteChar(";"); WriteCard(col, 1); WriteChar("H"); END Position;

PROCEDURE HVPosition(line, col : CARDINAL);
BEGIN CSI; WriteCard(line, 1); WriteChar(";"); WriteCard(col, 1); WriteChar("f"); END HVPosition;

PROCEDURE Up(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("A"); END Up;
PROCEDURE Down(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("B"); END Down;
PROCEDURE Right(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("C"); END Right;
PROCEDURE Left(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("D"); END Left;
PROCEDURE NextLine(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("E"); END NextLine;
PROCEDURE PrevLine(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("F"); END PrevLine;
PROCEDURE ToColumn(n : CARDINAL); BEGIN CSI; WriteCard(n, 1); WriteChar("G"); END ToColumn;
PROCEDURE CursorUpScroll; BEGIN ESC1("M"); END CursorUpScroll;
PROCEDURE SaveDEC; BEGIN ESC1("7"); END SaveDEC;
PROCEDURE RestoreDEC; BEGIN ESC1("8"); END RestoreDEC;
PROCEDURE SaveSCO; BEGIN CSI; WriteChar("s"); END SaveSCO;
PROCEDURE RestoreSCO; BEGIN CSI; WriteChar("u"); END RestoreSCO;
PROCEDURE RequestPosition; BEGIN CSI; WriteString("6n"); END RequestPosition;

(* Erase *)
PROCEDURE EraseDown; BEGIN CSI; WriteChar("J"); END EraseDown;
PROCEDURE EraseUp; BEGIN CSI; WriteString("1J"); END EraseUp;
PROCEDURE EraseScreen; BEGIN CSI; WriteString("2J"); END EraseScreen;
PROCEDURE EraseSavedLines; BEGIN CSI; WriteString("3J"); END EraseSavedLines;
PROCEDURE EraseLineRight; BEGIN CSI; WriteChar("K"); END EraseLineRight;
PROCEDURE EraseLineLeft; BEGIN CSI; WriteString("1K"); END EraseLineLeft;
PROCEDURE EraseLine; BEGIN CSI; WriteString("2K"); END EraseLine;

(* SGR *)
PROCEDURE SGRCode(n : CARDINAL);
BEGIN CSI; WriteCard(n, 1); WriteChar("m"); END SGRCode;

PROCEDURE SGR(a : Attr);
BEGIN
  CASE a OF
    ResetA : SGRCode(0) |
    BoldA : SGRCode(1) |
    DimA : SGRCode(2) |
    ItalicA : SGRCode(3) |
    UnderlineA : SGRCode(4) |
    BlinkA : SGRCode(5) |
    InverseA : SGRCode(7) |
    HiddenA : SGRCode(8) |
    StrikeA : SGRCode(9)
  END;
END SGR;

PROCEDURE SGRReset; BEGIN SGRCode(0); END SGRReset;
PROCEDURE SGRResetBoldDim; BEGIN CSI; WriteString("22m"); END SGRResetBoldDim;
PROCEDURE SGRResetItalic; BEGIN CSI; WriteString("23m"); END SGRResetItalic;
PROCEDURE SGRResetUnderline; BEGIN CSI; WriteString("24m"); END SGRResetUnderline;
PROCEDURE SGRResetBlink; BEGIN CSI; WriteString("25m"); END SGRResetBlink;
PROCEDURE SGRResetInverse; BEGIN CSI; WriteString("27m"); END SGRResetInverse;
PROCEDURE SGRResetHidden; BEGIN CSI; WriteString("28m"); END SGRResetHidden;
PROCEDURE SGRResetStrike; BEGIN CSI; WriteString("29m"); END SGRResetStrike;

PROCEDURE FGCode(n : CARDINAL);
BEGIN CSI; WriteCard(n, 1); WriteChar("m"); END FGCode;

PROCEDURE FGNum(c : Color) : CARDINAL;
BEGIN
  CASE c OF
    Black : RETURN 30 |
    Red : RETURN 31 |
    Green : RETURN 32 |
    Yellow : RETURN 33 |
    Blue : RETURN 34 |
    Magenta : RETURN 35 |
    Cyan : RETURN 36 |
    White : RETURN 37 |
    Default : RETURN 39 |
    BrightBlack : RETURN 90 |
    BrightRed : RETURN 91 |
    BrightGreen : RETURN 92 |
    BrightYellow : RETURN 93 |
    BrightBlue : RETURN 94 |
    BrightMagenta : RETURN 95 |
    BrightCyan : RETURN 96 |
    BrightWhite : RETURN 97
  END;
END FGNum;

PROCEDURE BGNum(c : Color) : CARDINAL;
BEGIN
  CASE c OF
    Black : RETURN 40 |
    Red : RETURN 41 |
    Green : RETURN 42 |
    Yellow : RETURN 43 |
    Blue : RETURN 44 |
    Magenta : RETURN 45 |
    Cyan : RETURN 46 |
    White : RETURN 47 |
    Default : RETURN 49 |
    BrightBlack : RETURN 100 |
    BrightRed : RETURN 101 |
    BrightGreen : RETURN 102 |
    BrightYellow : RETURN 103 |
    BrightBlue : RETURN 104 |
    BrightMagenta : RETURN 105 |
    BrightCyan : RETURN 106 |
    BrightWhite : RETURN 107
  END;
END BGNum;

PROCEDURE AttrNum(a : Attr) : CARDINAL;
BEGIN
  CASE a OF
    ResetA : RETURN 0 |
    BoldA : RETURN 1 |
    DimA : RETURN 2 |
    ItalicA : RETURN 3 |
    UnderlineA : RETURN 4 |
    BlinkA : RETURN 5 |
    InverseA : RETURN 7 |
    HiddenA : RETURN 8 |
    StrikeA : RETURN 9
  END;
END AttrNum;

PROCEDURE FG(c : Color); BEGIN FGCode(FGNum(c)); END FG;
PROCEDURE BG(c : Color); BEGIN FGCode(BGNum(c)); END BG;

PROCEDURE SetAttr(a : Attr; fg, bg : Color);
BEGIN
  CSI; WriteCard(AttrNum(a), 1); WriteChar(";");
  WriteCard(FGNum(fg), 1); WriteChar(";");
  WriteCard(BGNum(bg), 1); WriteChar("m");
END SetAttr;

PROCEDURE FG256(id : CARDINAL);
BEGIN CSI; WriteString("38;5;"); WriteCard(id, 1); WriteChar("m"); END FG256;

PROCEDURE BG256(id : CARDINAL);
BEGIN CSI; WriteString("48;5;"); WriteCard(id, 1); WriteChar("m"); END BG256;

PROCEDURE FGRGB(r, g, b : CARDINAL);
BEGIN CSI; WriteString("38;2;"); WriteCard(r, 1); WriteChar(";");
  WriteCard(g, 1); WriteChar(";"); WriteCard(b, 1); WriteChar("m"); END FGRGB;

PROCEDURE BGRGB(r, g, b : CARDINAL);
BEGIN CSI; WriteString("48;2;"); WriteCard(r, 1); WriteChar(";");
  WriteCard(g, 1); WriteChar(";"); WriteCard(b, 1); WriteChar("m"); END BGRGB;

(* DOS modes *)
PROCEDURE DosMode(v : CARDINAL);
BEGIN CSIe; WriteCard(v, 1); WriteChar("h"); END DosMode;

PROCEDURE DosModeReset(v : CARDINAL);
BEGIN CSIe; WriteCard(v, 1); WriteChar("l"); END DosModeReset;

PROCEDURE WrapOn; BEGIN CSIe; WriteString("7h"); END WrapOn;
PROCEDURE WrapOff; BEGIN CSIe; WriteString("7l"); END WrapOff;

(* Private *)
PROCEDURE CursorInvisible; BEGIN CSIq; WriteString("25l"); END CursorInvisible;
PROCEDURE CursorVisible; BEGIN CSIq; WriteString("25h"); END CursorVisible;
PROCEDURE ScreenSave; BEGIN CSIq; WriteString("47h"); END ScreenSave;
PROCEDURE ScreenRestore; BEGIN CSIq; WriteString("47l"); END ScreenRestore;
PROCEDURE AltBufferOn; BEGIN CSIq; WriteString("1049h"); END AltBufferOn;
PROCEDURE AltBufferOff; BEGIN CSIq; WriteString("1049l"); END AltBufferOff;

(* Print *)
PROCEDURE PrintScreen; BEGIN CSI; WriteChar("i"); END PrintScreen;
PROCEDURE PrintLine; BEGIN CSI; WriteString("1i"); END PrintLine;
PROCEDURE StopLog; BEGIN CSI; WriteString("4i"); END StopLog;
PROCEDURE StartLog; BEGIN CSI; WriteString("5i"); END StartLog;

(* Control chars *)
PROCEDURE Bell; BEGIN WriteChar(CHR(7)); END Bell;
PROCEDURE Backspace; BEGIN WriteChar(CHR(8)); END Backspace;
PROCEDURE HTab; BEGIN WriteChar(CHR(9)); END HTab;
PROCEDURE LineFeed; BEGIN WriteChar(CHR(10)); END LineFeed;
PROCEDURE VTab; BEGIN WriteChar(CHR(11)); END VTab;
PROCEDURE FormFeed; BEGIN WriteChar(CHR(12)); END FormFeed;
PROCEDURE CarriageReturn; BEGIN WriteChar(CHR(13)); END CarriageReturn;

(* Terminal input mode (cf. Editor/Tests/T17.mod): Unbuffered
   saves the termios state and disables line buffering so device
   replies can be read char by char; Buffered restores it. *)
PROCEDURE Unbuffered;
BEGIN
  flushFlag := termios.tcsflush();
  savedTerm := termios.InitTermios();
  haveTerm := termios.tcgetattr(FIO.StdIn, savedTerm) # -1;
  IO.UnBufferedMode(0, TRUE);
  IO.UnBufferedMode(1, TRUE);
END Unbuffered;

PROCEDURE Buffered;
VAR res : INTEGER;
BEGIN
  IO.BufferedMode(0, TRUE);
  IO.BufferedMode(1, TRUE);
  IF haveTerm THEN
    haveTerm := FALSE;
    res := termios.tcsetattr(FIO.StdIn, flushFlag, savedTerm);
  END;
END Buffered;

END Ansi.