Controlling the terminal

Tagged as lisp, foss, console, clim

Written on 2020-05-26 by Daniel 'jackdaniel' Kochmański

When building a console backend for McCLIM there are three terminal capabilities that we need:

• configuring the terminal (raw mode, no echo, querying properties)
• drawing output (positioning the cursor and writing with attributes)
• reading events (keyboard, pointer, and window status changes)

Configuring the terminal

To know where the terminal is, we need to start the implementation from it and save the streams in a separate variable, because SWANK rebind them for the SLIME session.

(defvar *console-io* *terminal-io*)
(swank:create-server)
(loop (sleep most-positive-fixnum))

We can implement most things with ANSI escape sequences and various extensions to them. Unfortunately we can't turn off echo and line buffering from that way, we need to use a minimal C program to do that, which we will call with FFI.

/* This small program is written based on a tutorial found under URL:
   https://viewsourcecode.org/snaptoken/kilo/02.enteringRawMode.html */

#include <stdlib.h>
#include <termios.h>
#include <unistd.h>

struct termios *enable_raw() {
  struct termios *orig_termios = malloc(sizeof(struct termios));
  struct termios raw;
  tcgetattr(STDIN_FILENO, orig_termios);
  raw = *orig_termios;
  raw.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
  raw.c_oflag &= ~(OPOST);
  raw.c_cflag |= (CS8);
  raw.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
  tcsetattr(STDIN_FILENO, TCSAFLUSH, &raw);
  return orig_termios;
}

void disable_raw(struct termios *orig_termios) {
  tcsetattr(STDIN_FILENO, TCSAFLUSH, orig_termios);
  free(orig_termios);
}

And here's how we will use it. ASDF will compile the C file and load the resulting shared library. To allow interactive programming we'll use a function show-screen and call it once per second.

(defpackage #:eu.turtleware.charming-clim
  (:use #:cl)
  (:export #:start-display))
(in-package #:eu.turtleware.charming-clim)

;; gcc raw-mode.c -shared -o raw-mode.so
;; (cffi:load-foreign-library "/path/to/raw-mode.so")

(cffi:defcfun (enable-raw "enable_raw")
    :pointer)
(cffi:defcfun (disable-raw "disable_raw")
    :void
  (handler :pointer))

(defvar *console-io* *terminal-io*)

(defmacro with-console (opts &body body)
  (declare (ignore opts))
  (let ((handler (gensym)))
    `(let ((,handler (enable-raw)))
       (unwind-protect (progn ,@body)
         (disable-raw ,handler)))))

(declaim (notinline show-screen))
(defun show-screen ()
  (format *console-io* "~acHello World!" #\esc)
  (finish-output *console-io*))

(defun start-display ()
  (swank:create-server)
  (with-console ()
    (loop (sleep 1)
          (show-screen))))

Finally, to wrap things up, we need to define a loadable system. Let's name the C file "raw-mode.c", and the Lisp file "terminal.lisp". The directory will have a flat structure with the ASDF definition file eu.turtleware.charming-clim.asd.

(defpackage #:charming-clim-system
  (:use #:asdf #:cl)
  (:export #:cfile))
(in-package #:charming-clim-system)

(defclass cfile (c-source-file) ())

(defmethod output-files ((o compile-op) (c cfile))
  (list (make-pathname :name (component-name c) :type "so")))

(defmethod perform ((o compile-op) (c cfile))
  (let ((in  (first (input-files o c)))
        (out (first (output-files o c))))
    (uiop:run-program (format nil "cc -shared ~a -o ~a" in out))))

(defmethod perform ((o load-op) (c cfile))
  (let ((in (first (input-files o c))))
    (uiop:call-function "cffi:load-foreign-library" in)))

(defmethod operation-done-p ((o compile-op) (c cfile))
  (let ((in  (first (input-files o c)))
        (out (first (output-files o c))))
    (and (probe-file in)
         (probe-file out)
         (> (file-write-date out) (file-write-date in)))))

(defsystem "eu.turtleware.charming-clim"
  :defsystem-depends-on (#:cffi)
  :depends-on (#:cffi #:swank)
  :components ((:static-file "tutorial.org")
               (:cfile "raw-mode")
               (:file "terminal")))

Now it is enough to load the system eu.turtleware.charming-clim in a terminal (not in Emacs!), and call the function start-display to see on the screen a string "Hello World!". Now connect to a swank server and let the hacking begin!

Escape sequences

We will control the terminal by using ANSI escape sequences and with some few extensions to receive the pointer events. To understand better how escape sequences work you may read into the following:

wikipedia article : https://en.wikipedia.org/wiki/ANSI%5Fescape%5Fcode

control sequences : https://invisible-island.net/xterm/ctlseqs/ctlseqs.html

standard ecma-48 : https://www.ecma-international.org/publications/standards/Ecma-048.htm

Escape sequences usually start with the control sequence introducer and may accept parameters. Numbers are encoded with digit characters with delimiters. Character case matters. Let's define a few utilities.

(defun put (&rest args)
  "Put raw string on a console"
  (format *console-io* "~{~a~}" args)
  (finish-output *console-io*))

(defun esc (&rest args)
  "Escape sequence"
  (apply #'put (code-char #x1b) args))

(defun csi (&rest args)
  "Control sequence introducer"
  (apply #'esc #\[ args))

(defun sgr (&rest args)
  "Select Graphic Rendition"
  (apply #'csi (append args '("m"))))

Time to add a high-level interface. These few functions illustrate how the terminal is controlled. We'll add more functions when we need them.

(defun reset-console ()
  "Clears the screen, attributes, cursor position etc."
  (esc "c"))

(defun clear-console (&optional (mode 2))
  "Erase in display"
  ;; Defined modes:
  ;; 0 - clear from cursor to the end of the display
  ;; 1 - clear from cursor to the start of the display
  ;; 2 - clear entire display
  (csi mode "J"))

(defun clear-line (&optional (mode 2))
  "Erase in line."
  ;; Defined modes:
  ;; 0 - clear from cursor to the end of the line
  ;; 1 - clear from cursor to the start of the line
  ;; 2 - clear entire line
  (csi mode "K"))

(defun set-foreground-color (r g b)
  (sgr "38;2;" r ";" g ";" b))

(defun set-background-color (r g b)
  (sgr "48;2;" r ";" g ";" b))

(defun save-cursor-position ()
  (csi "s"))

(defun restore-cursor-position ()
  (csi "u"))

(defun set-cursor-position (row col)
  (cond ((and row col)
         (csi row ";" col "H"))
        ((not (null col))
         (csi row ";H"))
        ((not (null row))
         (csi ";" col "H"))))

(defmacro with-cursor-position ((row col) &body body)
  `(progn
     (save-cursor-position)
     (set-cursor-position ,row ,col)
     (unwind-protect (progn ,@body)
       (restore-cursor-position))))

(defun (setf cursor-visibility) (visiblep)
  (if visiblep
      (csi "?" 2 5 "h")
      (csi "?" 2 5 "l")))

Time to something more fun. Typing the following in a REPL while the terminal is open gives the most satisfying result. The example below shows an important property of the terminal: the first character is addressed with a coordinate [1, 1].

(defparameter *row* 2)
(defparameter *col* 2)
(defparameter *dir* 1)
(reset-console)
(setf (cursor-visibility) nil)
(set-background-color #x00 #x22 #x22)
(set-foreground-color #xff #x22 #x22)

(declaim (notinline show-screen))
(defun show-screen ()
  (clear-console)
  (let ((str "Hello World!"))
    (set-cursor-position *row* (incf *col* *dir*))
    (cond ((>= (+ (1- *col*) (length str)) 80)
           (setf *dir* -1))
          ((<= *col* 2)
           (setf *dir* +1)))

    (with-cursor-position (*row*  1) (put "|"))
    (with-cursor-position (*row* 81) (put "|"))
    (put str)))

Now we'll improve the loop in start-display to easily modify the configuration. This step will require restarting the application because we modify the entry point.

(defmacro with-console (opts &body body)
  (declare (ignore opts))
  (let ((handler (gensym)))
    `(let ((,handler (enable-raw)))
       (unwind-protect (progn ,@body)
         (disable-raw ,handler)
         (reset-console)))))

(defun show-screen ()
  (set-cursor-position (1+ (random 24))
                       (1+ (random 80)))
  (if (zerop (random 2))
      (put "+")
      (put "-")))

(defparameter *conf*
  (list :sleep 1/60
        :cursorp nil
        :foreground '(#xff #xa0 #xa0)
        :background '(#x00 #x22 #x22)))

(defun start-display ()
  (ignore-errors (swank:create-server))
  (loop
    (with-simple-restart (run-again "Run again")
      (with-console () (display-loop)))))

(defun display-loop ()
  (loop with conf
        with seconds
        do (unless (equalp conf *conf*)
             (setf conf (copy-list *conf*))
             (destructuring-bind (&key sleep cursorp
                                       foreground background)
                 conf
               (setf seconds sleep)
               (reset-console)
               (setf (cursor-visibility) (getf conf :cursorp))
               (apply #'set-background-color background)
               (apply #'set-foreground-color foreground)
               (clear-console)))
           (sleep seconds)
           (show-screen)))

Reading the input

We've configured the terminal to accept data in raw mode. Despite that we can only read input as it is provided by the display server, there is no portable way to access raw keycode press and release events. That is unfortunate.

There are two characters that have a special meaning. ESC starts the escape sequence and DEL is not a graphical character (despite not being a control character). We will signify their uniqueness by defining appropriate constants.

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +delete+ (code-char #x7f)
    "The DEL character (#\Rubout), last in the ASCII table.")
  (defconstant +escape+ (code-char #x1b)
    "The ESC character (#\esc)."))

From the parsing perspective when we read the input we may encounter one of the following situations:

• no characters are available
• character is a graphic character (may span few bytes)
• ESC starts the escape sequence which needs to be parsed
• DEL character is read
• character is a control character (needs to be parsed)

(defun read-input (&aux (ch (read-char-no-hang *console-io*)))
  ;; READ-CHAR may read more than one byte and return an alphanumeric
  ;; character. That's fine because we will return it as-is then.
  (cond ((or (null ch) (graphic-char-p ch))
         (return-from read-input ch))
        ((deletep ch))
        ((escapep ch))
        ((controlp ch))
        (t (error "Unknown input sequence, char code 0x~x~%."
                  (char-code ch)))))

We will use read-char-no-hang to avoid blocking. read-input will return either nil (for no available input), a graphical character, a keyword for known keys which are not graphical, or a gesture object if there are modifiers present (or a non-graphical character appears which doesn't have a keyword equivalent).

We may encounter four types of input: control characters (from C0 and C1 group), escape sequences, delete and other alphanumerical characters. Control sequence and other modifiers like Alt must be encoded, so we will define a simple class representing a gesture. The character which is read from the terminal will be always either a character, a keyword, or a gesture (or null when there's no input).

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant  +c1-mod+   16)
  (defconstant  +meta-mod+  8)
  (defconstant  +ctrl-mod+  4)
  (defparameter +alt-mod+   2)
  (defconstant  +alt-mod*+  2)
  (defconstant  +shift-mod+ 1))

(defclass gesture ()
  ((key  :initarg :key  :accessor gesture-key)
   (mods :initarg :mods :accessor gesture-mods)))

(defmethod print-object ((o gesture) s)
  (print-unreadable-object (o s :type nil :identity nil)
    (let ((key (gesture-key o))
          (mods (gesture-mods o)))
      (format s "~s ~s"
              key
              (loop for p in (list +c1-mod+
                                   +meta-mod+
                                   +ctrl-mod+
                                   +alt-mod*+
                                   +shift-mod+)
                    for k in '(:C1 :Meta :Ctrl :Alt :Shift)
                    unless (zerop (logand mods p))
                      collect k)))))

Implementing functions deletep and controlp is easy. In a case of the control character we return its canonical form with a modifier. It is worth noting, that C1 group is not part of ASCII characters.

(defun control-char-p (ch &aux (code (char-code ch)))
  (or (<= 0 code 31)
      (<= 128 code 159)))

(defun controlp (ch &aux (code (char-code ch)))
  "Predicate determining if the character is a control character.
Returns a generalized boolean (when true returns a gesture)."
  (cond ((<= 0 code 31)
         (make-instance 'gesture
                        :mods +ctrl-mod+
                        :key (code-char (+ code 64))))
        ((<= 128 code 159)
         (make-instance 'gesture
                        :mods +c1-mod+
                        :key (code-char (- code 64))))))

(defun deletep (ch)
  (when (char= ch +delete+)
    :delete))

Parsing an escape sequence requires more code. The exact sequence format for special keys varies between terminal emulators. On top of that some sequences are ambiguous. We are going to focus on the most popular ones which should be compatible with most emulators. When the escape character is read and there is no further input, we return the keyword :escape. Otherwise we try to parse the sequence.

(defun escapep (ch)
  (unless (char= ch +escape+)
    (return-from escapep nil))
  (alexandria:if-let ((next-ch (read-char-no-hang *console-io*)))
    ;; The escape sequence grammar: [\[NO](<num>)(;<num>)[~A-Z].
    (multiple-value-bind (num1 num2 terminator)
        (parse-escape-sequence)
      (resolve-key next-ch num1 num2 terminator))
    :escape))

When we parse the escape sequence there are few possibilities. For instance ESC [ is known as the Control Sequence Introducer, some terminals produce ESC <char> when we press Alt+ etc. Here is the approach we are going to take:

• if we read ESC <char> with no further input, assume Alt+
• if we read ESC <char> and there is further input we try to parse the sequence with two optional numbers and a terminating character
• we try to resolve the character by comparing with known sequences

Function parse-escape-sequence tries to read the sequence with two numbers defaulting to one and returns (values num1 num2 char). If there is nothing to read, the last value is NIL. Escape sequence looks like this: ESC GROUP-CHAR (NUM1) (';' NUM2) TERMINATING-CHAR.

(defun parse-escape-sequence ()
  (let ((char (read-char-no-hang *console-io*))
        (num1 1)
        (num2 1))
    (flet ((read-num ()
             (loop while (and char (digit-char-p char))
                   collecting char into num
                   do (setf char (read-char-no-hang *console-io*))
                   finally (when num
                             (return (parse-integer (coerce num 'string)))))))
      (setf num1 (or (read-num) 1))
      (when (null char)
        (return-from parse-escape-sequence (values num1 num2 char)))
      (when (char= char #\;)
        (setf char (read-char-no-hang *console-io*)
              num2 (or (read-num) 1)))
      (values num1 num2 char))))

We want to be able to define new escape sequences when needed, so we will create a small macro responsible for registering new ones. It will use the appropriate parser based on the group and the terminator character. The function accepts two numeric arguments.

(eval-when (:compile-toplevel :load-toplevel  :execute)
  (defvar *key-resolvers* (make-hash-table)))

(defmacro define-key-resolver (group terminator (num1 num2) &body body)
  `(setf (gethash ,(+ (char-code terminator)
                      (ash (char-code group) 8))
                  (progn *key-resolvers*))
         (lambda (,num1 ,num2)
           (declare (ignorable ,num1 ,num2))
           ,@body)))

Some escape sequences are used to encode keys. In that case the second number represents the key modifiers. When it is decremented by one, then it is a modifier bit-field. We also need to account for control characters. This is implemented in the utility called maybe-combo:

(defun maybe-combo (key num2)
  (alexandria:if-let ((ctrl (and (characterp key) (controlp key))))
    (prog1 ctrl
      (setf (gesture-mods ctrl) (logior (1- num2) +ctrl-mod+)))
    (or (and (= num2 1) key)
        (make-instance 'gesture :key key :mods (1- num2)))))

Now is time to define a handful of known sequences (from the CSI group and from the SS3):

(define-key-resolver #\[ #\~ (num1 num2)
  (let ((key (case num1
               (1 :home) (2  :insert) (3    :delete)
               (4  :end) (5 :page-up) (6 :page-down)
               (11  :f1) (12 :f2)  (13  :f3) (14  :f4) ; deprecated
               (15  :f5) (17 :f6)  (18  :f7) (19  :f8)
               (20  :f9) (21 :f10) (23 :f11) (24 :f12)
               (25 :f13) (26 :f14) (28 :f15) (29 :f16)
               (31 :f17) (32 :f18) (33 :f19) (34 :f20))))
    (maybe-combo key num2)))

(define-key-resolver #\[ #\A (num1 num2) (maybe-combo :key-up    num2))
(define-key-resolver #\[ #\B (num1 num2) (maybe-combo :key-down  num2))
(define-key-resolver #\[ #\C (num1 num2) (maybe-combo :key-right num2))
(define-key-resolver #\[ #\D (num1 num2) (maybe-combo :key-left  num2))

(define-key-resolver #\O #\P (num1 num2) (maybe-combo :f1 num2))
(define-key-resolver #\O #\Q (num1 num2) (maybe-combo :f2 num2))
(define-key-resolver #\O #\R (num1 num2) (maybe-combo :f3 num2))
(define-key-resolver #\O #\S (num1 num2) (maybe-combo :f4 num2))

And, finally, the function resolve-key which is called by escapep. When the read is incomplete, then it assumes a combination Alt+, otherwise it calls the key resolver. If there is no defined resolver for a sequence we create an "unknown" gesture, which may be inspected to learn the reported escape sequence.

(defun resolve-key (group num1 num2 |Hasta la vista, baby|)
  (if (null |Hasta la vista, baby|)
      ;; When there is no terminating character, then it is probably a
      ;; result of pressing ALT+<char>. This is ambiguous, i.e ALT+[
      ;; generates CSI. We try to be as robust as we can here.
      (maybe-combo (case group
                     (#.+escape+ :escape)
                     (#.+delete+ :delete)
                     (t group))
                   (1+ +alt-mod+))
      (funcall (gethash (+ (char-code |Hasta la vista, baby|)
                           (ash (char-code group) 8))
                        *key-resolvers*
                        #'(lambda (num1 num2)
                            (let ((k (format nil
                                             "Unknown sequence: ESC ~c ~d ~d ~c"
                                             group num1 num2
                                             |Hasta la vista, baby|)))
                              (make-instance 'gesture :key k :mods 0))))
               num1 num2)))

With all that in place, all what is left is the test code. It will print characters which are on the terminal, so we can verify if they are properly recognized. Notice, that we do not clear a whole line after printing the sequence (only the reminder of it) to avoid unnecessary flicker. Some key combinations like Alt+F4 may be intercepted by the window manager.

(let ((characters nil))
  (defun show-screen ()
    (loop for ch = (read-input)
          until (null ch)
          do (push ch characters))
    (setf characters (subseq characters 0 (min 12 (length characters))))
    (set-cursor-position (1+ (random 12))
                         (1+ (random 40)))
    (if (zerop (random 2))
        (put "+")
        (put "-"))
    (with-cursor-position (1 44)
      (loop for row from 1
            for ch in characters
            do (set-cursor-position row 44)
               (format *console-io* (format nil "Read: ~s" ch))
               (clear-line 0)))))

You might have noticed, that the +alt-mod+ is defined to be a parameter. This is to allow mapping the key ALT to META.

(defun (setf alt-is-meta) (bool)
  (if bool
      (setf +alt-mod+ +meta-mod+)
      (setf +alt-mod+ +alt-mod*+)))

Civilizing the interface

We can do quite a lot already. Our previous demo, despite being pretty basic, proves that. We want to add some interactive behavior to the application and assign actions to some key combinations. First though we'll refactor our abstraction so there is less global state. We will also isolate the low-level terminal access in init-console and close-console functions, so we may treat the handler as an opaque object. We retain the variable *console-io*, but we bind it only in the console context. We also bind there a variable *console*.

(defun init-console ()
  (prog1 (enable-raw)
    (reset-console)))

(defun close-console (handler)
  (disable-raw handler)
  (reset-console))

(defvar *console*)
(defvar *console-io*)

(defclass console ()
  ((ios :initarg :ios :accessor ios :documentation "I/O stream for the terminal.")
   (fgc :initarg :fgc :accessor fgc :documentation "Foregorund color.")
   (bgc :initarg :bgc :accessor bgc :documentation "Background color.")
   (pos :initarg :pos :accessor pos :documentation "Cursor position.")
   (cvp :initarg :cvp :accessor cvp :documentation "Cursor visibility.")
   (fps :initarg :fps :accessor fps :documentation "Desired framerate.")
   (app :initarg :app :accessor app :documentation "Application state.")
   (hnd               :accessor hnd :documentation "Terminal handler."))
  (:default-initargs
   :ios (error "I/O stream must be specified.")
   :fgc '(#xff #xa0 #xa0)
   :bgc '(#x00 #x22 #x22)
   :pos '(1 . 1)
   :cvp nil
   :fps 60
   :app nil))

(defmethod initialize-instance :after ((instance console) &key ios fgc bgc cvp)
  (setf (hnd instance) (init-console))
  (apply #'set-foreground-color fgc)
  (apply #'set-background-color bgc)
  (setf (cursor-visibility) cvp))

(defmacro with-console ((&rest args
                         &key ios fgc bgc cvp fps &allow-other-keys)
                        &body body)
  (declare (ignore fgc bgc cvp fps))
  `(let* ((*console-io* ,ios)
          (*console* (make-instance 'console ,@args)))
     (unwind-protect (progn ,@body)
       (close-console (hnd *console*)))))

(defun start-display ()
  (ignore-errors (swank:create-server))
  (loop
    (with-simple-restart (run-again "Run again")
      (with-console (:ios *terminal-io*)
        (display-loop)))))

(defun display-loop ()
  (clear-console)
  (loop (sleep (/ (fps *console*)))
        (show-screen)))

To add some interactive behavior we want to assign actions to keys. We'll define a predicate deciding whether a key matches supplied parameters.

(defun keyp (ch key &rest mods)
  (if (null mods)
      (eql ch key)
      (and (typep ch 'gesture)
           (eql (gesture-key ch) key)
           (eql (gesture-mods ch)
                (loop for m in mods
                      summing (ecase m
                                (:c1 +c1-mod+)
                                (:m  +meta-mod+)
                                (:c  +ctrl-mod+)
                                (:a  +alt-mod*+)
                                (:s  +shift-mod+)))))))

Now we will add three key combinations:

C-q : exit the application

C-r : clear the console (i.e to wipe glitches)

C-u : call the user function

(defun show-screen ()
  (loop for ch = (read-input)
        until (null ch)
        do (push ch (app *console*))
           (cond ((keyp ch #\Q :c)
                  (cl-user::quit))
                 ((keyp ch #\R :c)
                  (setf (app *console*) nil)
                  (clear-console))
                 ((keyp ch #\U :c)
                  (ignore-errors (user-action)))))
  (let ((ch (app *console*)))
    (setf (app *console*)
          (subseq ch 0 (min 12 (length ch)))))
  (set-cursor-position (1+ (random 12))
                       (1+ (random 40)))
  (if (zerop (random 2))
      (put "+")
      (put "-"))
  (with-cursor-position (1 44)
    (loop for row from 1
          for ch in (app *console*)
          do (set-cursor-position row 44)
             (format *console-io* (format nil "Read: ~s" ch))
             (clear-line 0))))

Notice that instead of a closure we use the slot app. Function user-action may be defined from REPL – when C-u is pressed it will be executed. It may be used for instance to change the configuration. We still need to add appropriate methods that set the console on the configuration change.

(defmethod (setf fgc) :after (rgb (instance console))
  (apply #'set-foreground-color rgb))

(defmethod (setf bgc) :after (rgb (instance console))
  (apply #'set-background-color rgb))

(defmethod (setf pos) :before (pos (instance console))
  (check-type (car pos) (integer 1))
  (check-type (cdr pos) (integer 1)))

(defmethod (setf pos) :after (pos (instance console))
  (set-cursor-position (car pos) (cdr pos)))

(defmethod (setf cvp) :after (cvp (instance console))
  (setf (cursor-visibility) (not (null cvp))))

;; for example
(defun user-action ()
  (setf (fgc *console*) (list (random 255) (random 255) (random 255)))
  (setf (bgc *console*) (list (random 255) (random 255) (random 255)))
  (clear-console))

We still don't have any means to limit the terminal region for output. This operation is known as clipping in graphics. We are going to implement a flexible mechanism based on dynamic variables. For simple clipping we provide min/max row/col, and for more complex use cases a custom predicate may be specified. The macro is called with-clipping and may be nested to achieve the intersection of the clipping areas.

The macro out allows specifying a row, a column, a foreground color and a background color. It respects clipping limitations by testing each character. The state of the console is left as it was before invoking the operator.

(defvar *row1* '(1))
(defvar *col1* '(1))
(defvar *row2* '(24))
(defvar *col2* '(80))
(defvar *fun* (list (constantly t)))

(defmacro with-clipping ((&key fun row1 col1 row2 col2) &body body)
  `(let (,@(when row1 `((*row1* (cons (max (car *row1*) ,row1) *row1*))))
         ,@(when col1 `((*col1* (cons (max (car *col1*) ,col1) *col1*))))
         ,@(when row2 `((*row2* (cons (min (car *row2*) ,row2) *row1*))))
         ,@(when col2 `((*col2* (cons (min (car *col2*) ,col2) *col2*))))
         ,@(when fun  `((*fun*  (cons (let ((old (car *fun*)))
                                        (lambda (row col)
                                          (and (funcall ,fun row col)
                                               (funcall old row col))))
                                      (progn *fun*))))))
     ,@body))

(defmacro letf (bindings &body body)
  (loop for (place value) in bindings
        for old-val = (gensym)
        collect `(,old-val ,place)      into saves
        collect `(setf ,place ,value)   into store
        collect `(setf ,place ,old-val) into restore
        finally (return `(let (,@saves)
                           (unwind-protect (progn ,@store ,@body)
                             ,@restore)))))

(defun inside (row col)
  (and (<= (car *row1*) row (car *row2*))
       (<= (car *col1*) col (car *col2*))
       (funcall (car *fun*) row col)))

(defmacro out ((&key row col fgc bgc) object)
  "Put an object on a console"
  (let ((pos (cond ((and row col) `(cons ,row ,col))
                   (row `(cons ,row (cdr (pos *console*))))
                   (col `(cons (car (pos *console*)) col)))))
    `(let ((str (princ-to-string ,object)))
       (assert (null (find #\newline str)))
       (letf (((pos *console*) (cons (or ,row (car (pos *console*)))
                                     (or ,col (cdr (pos *console*)))))
              ,@(when fgc `(((fgc *console*) ,fgc)))
              ,@(when bgc `(((bgc *console*) ,bgc))))
         (let* ((pos (pos *console*))
                (row (car pos))
                (col (cdr pos)))
           (loop for c from col
                 for s across str
                 when (inside row c)
                   do (put s)))))))

Another important functionality is a way to clear a specific region. That and other user-facing control utilities will be available from the operator ctl.

(defun clear-rectangle (r1 c1 r2 c2)
  (loop with str = (make-string (1+ (- c2 c1)) :initial-element #\space)
        for r from r1 upto r2
        do (out (:row r :col c1) str)))

(defmacro ctl (&rest operations)
  `(progn
     ,@(loop for op in operations
             collect (destructuring-bind (name &rest args) op
                       (ecase name
                         (:clr `(clear-rectangle ,@args))
                         (:fgc `(setf (fgc *console*) (list ,@args)))
                         (:bgc `(setf (bgc *console*) (list ,@args)))
                         (:cvp `(setf (cursor-visibility) ,@args))
                         (:pos `(setf (pos *console*) (cons ,(car args)
                                                            ,(cdr args)))))))))

Time to use our new tools to a new version of the function show-screen and the function user-action. In show-screen we define a local function ll which is a predicate responsible for clipping output to the lambda shape. In the first clipping body we limit drawing to said ad-hoc lambda and clip out the first and the last row for aesthetic reasons. The second body in with-clipping does the opposite: draws everywhere in the drawing plane except for the lambda drawing. Finally we implement a user action which clears part of the drawing area. To invoke it press C-u.

(defun show-screen ()
  (loop for ch = (read-input)
        until (null ch)
        do (push ch (app *console*))
           (cond ((keyp ch #\Q :c)
                  (cl-user::quit))
                 ((keyp ch #\R :c)
                  (setf (app *console*) nil)
                  (clear-console))
                 ((keyp ch #\U :c)
                  (ignore-errors (user-action)))))
  (let ((ch (app *console*)))
    (setf (app *console*)
          (subseq ch 0 (min 12 (length ch)))))
  (flet ((ll (row col)
           (or (and (< (abs (- (+ col row) 26)) 2)
                    (<= col 20))
               (< (abs (- (+ (- 40 col) row) 26)) 2))))
    (with-clipping (:fun #'ll :row1 2 :row2 11)
      (out (:row (1+ (random 12))
            :col (1+ (random 40))
            :bgc `(0 0 0)
            :fgc '(#xbb #x00 #x00))
           (alexandria:random-elt '("X" "O"))))
    (with-clipping (:fun (lambda (row col)
                           (or (= row 1)
                               (= row 12)
                               (funcall (complement #'ll) row col))))
      (out (:row (1+ (random 12))
            :col (1+ (random 40))
            :bgc `(0 0 0)
            :fgc (list #x00
                       (alexandria:random-elt '(#x44 #x44 #x44 #x44 #x66))
                       #x44))
           (alexandria:random-elt '("+" "-")))))
  (ctl (:clr 1 44 12 (car *col2*)))
  (loop for row from 1
        for ch in (app *console*)
        do (out (:row row :col 44)
                (prin1-to-string ch))))

(defun user-action ()
  (ctl (:fgc (random 255) (random 255) (random 255))
       (:bgc (random 255) (random 255) (random 255))
       (:clr 4 4 10 10)))

Clearing the screen part with (:clr 1 44 12 (car *col2*)) may cause a flicker on terminal emulators with slow refresh rate. For now we will reduce the FPS, but later we will take another approach to avoid this problem.

(defclass console ()
  (#|...|#)
  (:default-initargs
   #|...|#
   :fps 10
   #|...|#))

Determining the terminal dimensions

Time to learn how to determine the terminal size. We already know how to set a cursor position. Interesting property of this command is that if we request to set its position beyond the terminal limits, the cursor will be positioned on a terminal boundary instead. That's how we are going to determine the terminal size.

(defun request-cursor-position ()
  (csi 6 "n"))

(defun user-action ()
  (with-cursor-position (10 3)
    (request-cursor-position)))

When we execute the user command by pressing C-u our program will tell us, that an unknown sequence has been read: ESC [ 10 3 R. Indeed, that's the sequence that is documented as a result. We will define a condition to signal, that the cursor-position-report has arrived. When the sequence is read a condition is signaled and a gesture is returned.

(define-condition cursor-position-report ()
  ((rows :initarg :row :reader row)
   (cols :initarg :col :reader col)))

(define-key-resolver #\[ #\R (row col)
  (signal 'cursor-position-report :row row :col col)
  (make-instance 'gesture
                 :key (format nil "Cursor position: ~s ~s" row col)
                 :mods 0))

We will use it to print a character on the right bottom cell to see if it works. An important bit of information is that if we set the cursor beyond the terminal, it will be positioned over the last cell instead, so if we request the position back, we should receive a total number of rows and columns of the terminal.

To do that we'll add slots to the class console and add a handler above the read-input which will assign these slots. Moreover we will modify the user-action to request the cursor position after setting it a big value. Now when we press C-u, the character should appear on the bottom-right corner of the terminal. Notice, that we also update the clipping area (row2 and col2). Otherwise the character would have been filtered.

(defclass console ()
  (#|...|#
   (rows :accessor rows :initform 24 :documentation "Terminal number of rows.")
   (cols :accessor cols :initform 80 :documentation "Terminal number of cols."))
  #|...|#)

(defun show-screen ()
  (loop for ch = (handler-case (read-input)
                   (cursor-position-report (c)
                     (let ((row (row c))
                           (col (col c)))
                       (setf *row2* (list row))
                       (setf *col2* (list col))
                       (setf (rows *console*) row)
                       (setf (cols *console*) col)))
                     nil)
        #|...|#)
  #|...|#
  (out (:row (rows *console*)
        :col (cols *console*))
       "×"))

(defun user-action ()
  (with-cursor-position ((expt 2 16) (expt 2 16))
    (request-cursor-position)))

We are left with a few problems:

• old markers don't disappear unless we reset the whole console
• any cursor position request will end up in resizing of the console
• the console is not resized automatically

We could have incorporated installing a signal handler for the sigwinch, but we'll settle on a simpler solution which will be incorporated when we refactor the I/O model in the next post. For now we'll initialize the size when initializing the console and when resetting it.

(defun get-cursor-position ()
  (request-cursor-position)
  ;; If the appropriate key resolver is not defined, this will loop
  ;; forever and the application will freeze.
  (handler-case (loop (read-input))
    (cursor-position-report (c)
      (values (row c) (col c)))))

(defun update-console-dimensions ()
  (with-cursor-position ((expt 2 16) (expt 2 16))
    (multiple-value-bind (rows cols)
        (get-cursor-position)
      (setf (rows *console*) rows)
      (setf (cols *console*) cols)
      (setf *row2* (list rows))
      (setf *col2* (list cols)))))

(defmethod initialize-instance :after
    ((instance console) &key fgc bgc pos cvp)
  #| ... |#
  (let ((*console* instance))
    (update-console-dimensions)))

(defun show-screen ()
  (loop #| ... |#
    (cond (#| ... |#
           ((keyp ch #\R :c)
            (setf (app *console*) nil)
            (update-console-dimensions)
            (clear-console))
           #| ... |#)))
  #| ... |#)

Adding a mouse tracking support

Terminal emulators which are compatible with xterm allow tracking the mouse. There are few possible modes (i.e track only mouse clicks), as well as a few schemes for reporting events. We are interested in tracking all events reported in the extended scheme (because the "default" scheme has serious limitations due to byte encoding).

;;; (csi ? tracking ; encoding h/l)
;;; tracking: 1000 - normal, 1002 - button, 1003 - all motion
;;; encoding: 1006 - sgr encoding scheme
(defun (setf mouse-tracking) (enabledp)
  (if enabledp
      (csi "?" 1003 ";" 1006 "h")
      (csi "?" 1003 "l")))

Each event is reported as ESC [ > Cb;Cx;Cy m/M. Cb encodes pressed buttons, Cx and Cy are integers put in text for the event column and row. Until now we were only parsing input sequences which have two numbers, so it is time to improve the parse-escape-sequence function to accept any number of semicolon separated integers:

(defun parse-escape-sequence (&aux char)
  (flet ((read-num ()
           (loop while (and char (digit-char-p char))
                 collecting char into num
                 do (setf char (read-char-no-hang *console-io*))
                 finally (when num
                           (return (parse-integer (coerce num 'string)))))))
    (loop
      do (setf char (read-char-no-hang *console-io*))
      collect (or (read-num) 1) into nums
      until (or (null char)
                (char/= #\; char))
      finally (return (values nums char)))))

(defun escapep (ch)
  (unless (char= ch +escape+)
    (return-from escapep nil))
  (alexandria:if-let ((next-ch (read-char-no-hang *console-io*)))
    ;; A keycode: [\[NO](<num>)(;<num>)[~A-Z].
    (multiple-value-bind (nums terminator)
        (parse-escape-sequence)
      (destructuring-bind (&optional (num1 1) (num2 1)) nums
        (resolve-key next-ch num1 num2 terminator)))
    :escape))

Mouse state encoded in Cb works as follows:

• if the sixth bit (32) is "on", it is a motion event
• otherwise terminating character #\M is "press", #\m is "release"
• modifiers are encoded in third to fifth bits (shift, alt, ctrl)
• pressed mouse button is encoded in two first bits, and seventh/eight

This bit twiddling is a good opportunity to use ldb and ash as seen below:

(defun resolve-mouse (btn col row |Hasta la vista, baby|)
  (let ((state (cond ((not (zerop (ldb (cons 1 5) btn))) :motion)
                     ((char= #\M |Hasta la vista, baby|) :press)
                     ((char= #\m |Hasta la vista, baby|) :release)))
        (mods (+ (if (zerop (ldb (cons 1 2) btn)) 0 +shift-mod+)
                 (if (zerop (ldb (cons 1 3) btn)) 0 +alt-mod+)
                 (if (zerop (ldb (cons 1 4) btn)) 0 +ctrl-mod+)))
        (key (case (+ (ldb (cons 2 0) btn)
                      (ash (ldb (cons 2 6) btn) 2))
               (#b0000 :left)
               (#b0001 :middle)
               (#b0010 :right)
               (#b0011 :none)
               ;; 64
               (#b0100 :wheel-up)
               (#b0101 :wheel-down)
               (#b0110 :wheel-left)
               (#b0111 :wheel-right)
               ;; 128 (xterm >= 341)
               (#b1000 :extra-1)
               (#b1001 :extra-2)
               (#b1010 :extra-3)
               (#b1011 :extra-4))))
    (make-instance 'gesture
                   :key (format nil "row: ~2d col: ~2d [~a ~a] ~a"
                                row col key btn state)
                   :mods mods)))

Now we add handling mouse to the escapep function and allow enabling it in user-action:

(defun escapep (ch)
  (unless (char= ch +escape+)
    (return-from escapep nil))
  (alexandria:if-let ((next-ch (read-char-no-hang *console-io*)))
    ;; A keycode: [\[NO](<num>)(;<num>)[~A-Z].
    ;; SGR mouse: '[' '<' num ';' num ';' num ';' [Mm]
    (if (and (char= #\[ next-ch)
             (char= #\< (peek-char t *console-io* nil #\x))
             (read-char-no-hang *console-io*))
        (multiple-value-bind (nums terminator)
            (parse-escape-sequence)
          (destructuring-bind (num1 num2 num3) nums
            (resolve-mouse num1 num2 num3 terminator)))
        (multiple-value-bind (nums terminator)
            (parse-escape-sequence)
          (destructuring-bind (&optional (num1 1) (num2 1)) nums
            (resolve-key next-ch num1 num2 terminator))))
    :escape))

(defun user-action ()
  (setf (mouse-tracking) t))

When you press C-u now all mouse events should be reported i.e as #<"row: 13 col: 95 [LEFT 0] RELEASE" NIL>. It is noteworthy that some terminals despite claiming that they are xterm-compatible, may behave differently. I.e on KDE's Konsole mouse motion is reported only when any mouse button is pressed.

Finally, it is time to integrate the pointer tracking in our ctl interface and to the console class.

(defmacro ctl (&rest operations)
  #|...|#
  (:ptr `(setf (mouse-tracking) ,@args))
  #|...|#)

(defclass console ()
  (#|...|#
   (ptr :initarg :ptr :accessor ptr :documentation "Pointer tracking.")
   #|...|#)
  (:default-initargs #|...|# :ptr t #|... |#))


(defmethod initialize-instance :after
    ((instance console) &key fgc bgc pos cvp ptr)
  #|...|#
  (setf (mouse-tracking) ptr)
  #|...|#)

(defmethod (setf ptr) :after (ptr (instance console))
  (setf (mouse-tracking) (not (null ptr))))

Some terminal emulators bind the command "paste primary selection" to the middle button press action, so don't be surprised when they do.

Conclusions

This is the first part of a tutorial which is split in five:

1. Controlling the terminal
2. Rethinking the Input/Output
3. Rendering on the console
4. Rendering on the console (2)
5. Writing a McCLIM backend

In the second post we'll construct a frame manager with windows and animations as well as scrolling and other common abstractions. In the third one we'll go through state-of-the-art algorithms to be able to render lines, curves, and such. The fourth will extend concepts of the third one by adding styles and alpha blending. The fifth part will be a guide about how to write a backend for McCLIM.

There will be three outcomes of this case study:

• A standalone TUI toolkit independent of ncurses (and CLIM)
• McCLIM backend for the terminal based on the above
• Documentation for McCLIM on how to write new backends

My main motivations were to make some rendering issues in McCLIM apparent by growing a pixel into something as big and non-square as a terminal cell and to have plenty of fun while hacking something amusing. The second goal is already achieved!

I'd like to thank Jānis Džeriņš, Michał Herda and Christoph Keßler for offering the help with this text review and providing useful hints. All mistakes are mine :-). Please don't hesitate to contact me with questions and remarks.

If you feel like supporting me with my FLOSS contributions you may become my patron here https://www.patreon.com/jackdaniel%5Fkochmanski.