TP3/shell/Term.mod

IMPLEMENTATION MODULE Term ;

(* termios-based raw keyboard + ANSI screen output. *)

FROM Posix IMPORT read, write, tcgetattr, tcsetattr, cfmakeraw, poll ;
FROM SYSTEM IMPORT ADR, ADDRESS, BYTE ;
FROM TermCfg IMPORT Cfg, Default, Load ;

CONST
   TCSANOW = 0 ;
   STDIN   = 0 ;
   STDOUT  = 1 ;

VAR
   saved      : ARRAY [0..127] OF BYTE ;
   rawstate   : ARRAY [0..127] OF BYTE ;
   haveSaved  : BOOLEAN ;
   cfg        : Cfg ;

PROCEDURE Out (s : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
    n : LONGINT ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      n := write (STDOUT, ADR (s [i]), 1) ;
      INC (i)
   END
END Out ;

PROCEDURE LoadCfg ;
(* One fixed name, in the directory the shell is started from.  A text file,
   read once, never written: the shell does not patch itself. *)
VAR ok : BOOLEAN ;
BEGIN
   Load ("TP3.TRM", cfg, ok) ;
   IF NOT ok THEN
      (* missing or malformed: Load has already left the ANSI defaults in
         place for anything it did not read *)
   END
END LoadCfg ;

PROCEDURE Open ;
VAR r : INTEGER ;
BEGIN
   LoadCfg ;
   r := tcgetattr (STDIN, ADR (saved)) ;
   rawstate := saved ;
   cfmakeraw (ADR (rawstate)) ;
   r := tcsetattr (STDIN, TCSANOW, ADR (rawstate)) ;
   haveSaved := TRUE ;
   Out (cfg.clear)                    (* clear screen, home *)
END Open ;

PROCEDURE Close ;
VAR r : INTEGER ;
BEGIN
   IF haveSaved THEN
      r := tcsetattr (STDIN, TCSANOW, ADR (saved)) ;
      haveSaved := FALSE
   END ;
   Out (cfg.normal)                   (* normal attribute *)
END Close ;

PROCEDURE ClrScr ;
BEGIN
   Out (cfg.clear)
END ClrScr ;

PROCEDURE GotoXY (row, col : CARDINAL) ;
(* cfg.moveTo with %r replaced by the row and %c by the column, both decimal
   and 1-based (TP3's GotoXY is 1-based); %% is a literal percent. *)
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (cfg.moveTo)) AND (cfg.moveTo [i] # 0C) DO
      IF (cfg.moveTo [i] = '%') AND (i + 1 <= HIGH (cfg.moveTo)) THEN
         IF cfg.moveTo [i + 1] = 'r' THEN
            PutCard (row) ; INC (i, 2)
         ELSIF cfg.moveTo [i + 1] = 'c' THEN
            PutCard (col) ; INC (i, 2)
         ELSIF cfg.moveTo [i + 1] = 'R' THEN
            (* a single byte, row + 31: VT52's `ESC Y <row+32><col+32>' with a
               1-based row/column *)
            PutCh (CHR (row + 31)) ; INC (i, 2)
         ELSIF cfg.moveTo [i + 1] = 'C' THEN
            PutCh (CHR (col + 31)) ; INC (i, 2)
         ELSIF cfg.moveTo [i + 1] = '%' THEN
            PutCh ('%') ; INC (i, 2)
         ELSE
            PutCh (cfg.moveTo [i]) ; INC (i)
         END
      ELSE
         PutCh (cfg.moveTo [i]) ; INC (i)
      END
   END
END GotoXY ;

PROCEDURE PutCh (ch : CHAR) ;
VAR n : LONGINT ;
BEGIN
   n := write (STDOUT, ADR (ch), 1)
END PutCh ;

PROCEDURE PutStr (s : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
    n : LONGINT ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      n := write (STDOUT, ADR (s [i]), 1) ;
      INC (i)
   END
END PutStr ;

PROCEDURE PutCard (n : CARDINAL) ;
VAR dig : ARRAY [0..9] OF CHAR ;
    i   : CARDINAL ;
BEGIN
   IF n = 0 THEN
      PutCh ("0")
   ELSE
      i := 0 ;
      WHILE n > 0 DO
         dig [i] := CHR (ORD ("0") + (n MOD 10)) ;
         n := n DIV 10 ;
         INC (i)
      END ;
      WHILE i > 0 DO
         DEC (i) ;
         PutCh (dig [i])
      END
   END
END PutCard ;

PROCEDURE PutLongCard (n : LONGCARD) ;
VAR dig : ARRAY [0..19] OF CHAR ;
    i, m : CARDINAL ;
BEGIN
   IF n = 0 THEN
      PutCh ("0")
   ELSE
      i := 0 ;
      WHILE n > 0 DO
         m := n MOD 10 ;
         dig [i] := CHR (ORD ("0") + m) ;
         n := n DIV 10 ;
         INC (i)
      END ;
      WHILE i > 0 DO
         DEC (i) ;
         PutCh (dig [i])
      END
   END
END PutLongCard ;

PROCEDURE ScrnWide (n : CARDINAL) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE i < n DO
      PutCh (" ") ;
      INC (i)
   END
END ScrnWide ;

PROCEDURE Marked ;
BEGIN
   Out (cfg.marked)                  (* highlighted attribute *)
END Marked ;

PROCEDURE Normal ;
BEGIN
   Out (cfg.normal)
END Normal ;

PROCEDURE GetCh (VAR ch : CHAR) ;
VAR n : LONGINT ;
BEGIN
   n := read (STDIN, ADR (ch), 1) ;
   IF n # 1 THEN
      ch := 0C
   END
END GetCh ;

PROCEDURE Avail () : BOOLEAN ;
TYPE PollFd = RECORD
   fd      : CARDINAL ;
   events  : SHORTCARD ;
   revents : SHORTCARD ;
   END ;
VAR pfd : PollFd ;
    n   : INTEGER ;
BEGIN
   (* struct pollfd { int fd; short events; short revents; } *)
   pfd.fd := STDIN ;
   pfd.events := 1 ;             (* POLLIN *)
   pfd.revents := 0 ;
   n := poll (ADR (pfd), 1, 0) ;
   RETURN n > 0
END Avail ;

PROCEDURE GetKey (VAR ch : CHAR) ;
VAR n : LONGINT ;
BEGIN
   IF Avail () THEN
      n := read (STDIN, ADR (ch), 1) ;
      IF n # 1 THEN
         ch := 0C
      END
   ELSE
      ch := 0C
   END
END GetKey ;

PROCEDURE Beep ;
BEGIN
   Out (cfg.beep)
END Beep ;

BEGIN
   haveSaved := FALSE
END Term.