cl-tty/org/backend-protocol.org

#+TITLE: cl-tty Backend Protocol — v0.0.1
#+STARTUP: content
#+FILETAGS: :cl-tty:backend:v0.0.1:
#+OPTIONS: ^:nil

* Backend Protocol

The backend protocol is the rendering abstraction layer. Every visual
operation dispatches through generic functions on a backend class.
Two implementations exist: =modern-backend= (raw escape sequences,
truecolor, modern terminal features) and =simple-backend= (ASCII art,
universal compatibility).

** Contract

*** Backend Lifecycle

- =(initialize-backend backend)= → backend
  Initialize the terminal, set raw mode, enable features.
  Returns the backend instance.

- =(shutdown-backend backend)= → nil
  Restore terminal to cooked mode, reset colors, show cursor.
  Must be called on exit regardless of how the image stops.

- =(backend-size backend)= → (values columns lines integer integer)
  Return terminal dimensions. First value = columns, second = lines.

- =(backend-write backend string)= → integer
  Write raw string to terminal output. Returns number of bytes written.

- =(backend-clear backend)= → nil
  Clear the entire screen and reset cursor to (0,0).

*** Rendering Primitives

- =(draw-text backend x y string fg bg &key bold italic underline reverse dim blink)= → nil
  Render text at position (x, y). fg and bg are hex color strings
  (e.g. "#FFD700") or nil for default. Attributes are booleans.

- =(draw-border backend x y width height &key style fg bg title title-align)= → nil
  Draw a border rectangle. Style is :single, :double, or :rounded.

- =(draw-rect backend x y width height &key bg)= → nil
  Fill a rectangle with background color.

- =(draw-link backend x y string url &key fg bg)= → nil
  Render clickable hyperlink (OSC 8 escape sequence).

- =(draw-ellipsis backend x y width &key fg bg)= → nil
  Render "..." truncated text marker at position.

*** Cursor Operations

- =(cursor-move backend x y)= → nil
  Move cursor to position (x, y). Origin is top-left (0,0).

- =(cursor-hide backend)= → nil
- =(cursor-show backend)= → nil

- =(cursor-style backend shape &key blink)= → nil
  shape is :block, :bar, or :underline.

*** Synchronization

- =(begin-sync backend)= → nil
  Start synchronized update (DECICM). All subsequent output is buffered
  by the terminal until =end-sync=.

- =(end-sync backend)= → nil
  Flush synchronized update buffer. The entire frame appears at once.

*** Input

- =(read-event backend &key timeout)= → (values keyword list)
  Read next input event. Blocks until event or timeout.
  Returns event type keyword and event data plist.

- =(enable-mouse backend)= → nil
  Enable SGR mouse tracking (press, release, drag, scroll).

- =(enable-bracketed-paste backend)= → nil
  Enable bracketed paste mode.

*** Capability Queries

- =(capable-p backend feature)= → boolean
  Feature is :truecolor, :osc8, :sync, :mouse, :bracketed-paste,
  :kitty-keyboard, :sixel, :cursor-style.

** Backend Classes

*** Simple Backend

=(make-simple-backend)= → simple-backend

The minimal backend. ASCII borders, no color, no modern features.
Works everywhere — SSH, serial, pipes, ancient terminals.

Borders:
- Single: + - |
- Double: + = |
- Rounded: + - |  (same as single — no rounded chars)

No color, no bold, no italic, no links, no mouse, no sync.

*** Modern Backend

=(make-modern-backend)= → modern-backend

Full-featured backend. Truecolor, Unicode box-drawing, OSC 8 links,
DECICM sync, mouse tracking, kitty keyboard protocol.

Borders:
- Single: ┌ ─ ┐ │ └ ┘
- Double: ╔ ═ ╗ ║ ╚ ╝
- Rounded: ╭ ─ ╮ │ ╰ ╯

** Test Suite

#+BEGIN_SRC lisp
(defpackage :cl-tty-backend-test
  (:use :cl :fiveam)
  (:export #:run!))
(in-package :cl-tty-backend-test)

(def-suite backend-suite :description "Backend protocol tests")
(in-suite backend-suite)

;; ── Simple Backend ──────────────────────────────────────────────

(test simple-backend-lifecycle
  "simple-backend can be created and shut down"
  (let ((b (make-simple-backend)))
    (is (typep b 'simple-backend))
    (initialize-backend b)
    (is (capable-p b :truecolor) nil "simple backend has no truecolor")
    (shutdown-backend b)))

(test simple-backend-draw-text
  "simple-backend renders text at position, ignoring style"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (draw-text b 0 0 "hello" nil nil)
    ;; No crash = pass (simple backend writes to *standard-output*)
    (shutdown-backend b)
    (is-t t)))

(test simple-backend-border-single
  "simple-backend draws ASCII single border"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (draw-border b 0 0 10 5 :style :single)
    (shutdown-backend b)
    (is-t t)))

(test simple-backend-border-rounded
  "simple-backend falls back to straight edges for rounded"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (draw-border b 0 0 10 5 :style :rounded)
    ;; No error — rounded falls back to single on simple
    (shutdown-backend b)
    (is-t t)))

;; ── Backend Capabilities ───────────────────────────────────────

(test capable-p-known-features
  "capable-p returns nil for all features on simple-backend"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (dolist (f '(:truecolor :osc8 :sync :mouse :bracketed-paste
                 :kitty-keyboard :sixel :cursor-style))
      (is (capable-p b f) nil
          (format nil "~s should not be supported on simple-backend" f)))
    (shutdown-backend b)))

;; ── Backend Size ───────────────────────────────────────────────

(test backend-size-returns-integers
  "backend-size returns two integer values"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (multiple-value-bind (cols lines) (backend-size b)
      (is (integerp cols))
      (is (integerp lines))
      (is (>= cols 10))
      (is (>= lines 3)))
    (shutdown-backend b)))

;; ── Drawing Primitives ─────────────────────────────────────────

(test draw-rect-fills-area
  "draw-rect fills a rectangular area with background"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (draw-rect b 0 0 5 3 :bg nil)
    (shutdown-backend b)
    (is-t t)))

(test draw-text-multi-line
  "draw-text handles strings with newlines"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (draw-text b 0 0 "line1~%line2" nil nil)
    (shutdown-backend b)
    (is-t t)))

;; ── Synchronization ────────────────────────────────────────────

(test sync-is-noop-on-simple
  "begin-sync and end-sync are no-ops on simple-backend"
  (let ((b (make-simple-backend)))
    (initialize-backend b)
    (begin-sync b)
    (draw-text b 0 0 "in sync" nil nil)
    (end-sync b)
    (shutdown-backend b)
    (is-t t)))
#+END_SRC

** Implementation

*** Package

#+BEGIN_SRC lisp
(defpackage :cl-tty.backend
  (:use :cl)
  (:export
   ;; Backend classes
   #:backend #:simple-backend
   ;; Lifecycle
   #:initialize-backend #:shutdown-backend
   #:backend-size #:backend-write #:backend-clear
   ;; Drawing
   #:draw-text #:draw-border #:draw-rect
   #:draw-link #:draw-ellipsis
   ;; Cursor
   #:cursor-move #:cursor-hide #:cursor-show #:cursor-style
   ;; Sync
   #:begin-sync #:end-sync
   ;; Input
   #:read-event #:enable-mouse #:enable-bracketed-paste
   ;; Queries
   #:capable-p
   ;; Constructors
   #:make-simple-backend))
(in-package :cl-tty.backend)
#+END_SRC

*** Backend Base Class

#+BEGIN_SRC lisp
(defclass backend () ())

(defgeneric initialize-backend (backend)
  (:method ((b backend)) b))

(defgeneric shutdown-backend (backend)
  (:method ((b backend)) (values)))

(defgeneric backend-size (backend)
  (:method ((b backend))
    (values 80 24)))

(defgeneric backend-write (backend string))

(defgeneric backend-clear (backend)
  (:method ((b backend))
    (backend-write b (string #\escape) "[2J")
    (cursor-move b 0 0)))

(defgeneric draw-text (backend x y string fg bg &key
                       bold italic underline reverse dim blink))

(defgeneric draw-border (backend x y width height
                         &key style fg bg title title-align))

(defgeneric draw-rect (backend x y width height &key bg))

(defgeneric draw-link (backend x y string url &key fg bg))

(defgeneric draw-ellipsis (backend x y width &key fg bg))

(defgeneric cursor-move (backend x y))

(defgeneric cursor-hide (backend)
  (:method ((b backend)) (values)))

(defgeneric cursor-show (backend)
  (:method ((b backend)) (values)))

(defgeneric cursor-style (backend shape &key blink)
  (:method ((b backend) shape &key blink) (values)))

(defgeneric begin-sync (backend)
  (:method ((b backend)) (values)))

(defgeneric end-sync (backend)
  (:method ((b backend)) (values)))

(defgeneric read-event (backend &key timeout)
  (:method ((b backend) &key timeout) (values nil nil)))

(defgeneric enable-mouse (backend)
  (:method ((b backend)) (values)))

(defgeneric enable-bracketed-paste (backend)
  (:method ((b backend)) (values)))

(defgeneric capable-p (backend feature)
  (:method ((b backend) feature)
    (declare (ignore feature))
    nil))
#+END_SRC

*** Simple Backend

#+BEGIN_SRC lisp
(defclass simple-backend (backend)
  ((output-stream :initform *standard-output*
                  :accessor backend-output-stream)))

(defmethod initialize-backend ((b simple-backend))
  b)

(defmethod shutdown-backend ((b simple-backend))
  (values))

(defmethod backend-size ((b simple-backend))
  ;; Try ioctl, fall back to 80x24
  (values 80 24))

(defmethod backend-write ((b simple-backend) string)
  (let ((stream (backend-output-stream b)))
    (write-string string stream)
    (finish-output stream)
    (length string)))

(defmethod draw-text ((b simple-backend) x y string fg bg
                      &key bold italic underline reverse dim blink)
  (declare (ignore x y fg bg bold italic underline reverse dim blink))
  (backend-write b string))

(defun %simple-border-char (edge-style pos)
  "Return ASCII border character for EDGE-STYLE at POS.
POS is :top-left, :top-right, :bottom-left, :bottom-right,
:horizontal, or :vertical."
  (case pos
    ((:top-left :top-right :bottom-left :bottom-right) #\+)
    (:horizontal #\-)
    (:vertical #\|)))

(defmethod draw-border ((b simple-backend) x y width height
                        &key style fg bg title title-align)
  (declare (ignore style fg bg title title-align))
  (let ((h (%simple-border-char nil :horizontal))
        (v (%simple-border-char nil :vertical)))
    ;; Top edge
    (backend-write b (format nil "~%~v@{~a~:*~}" width h))
    ;; Sides
    (loop for i from 1 below (1- height)
          do (backend-write b (format nil "~%|~v@{~a~:*~}|" (- width 2) #\space)))
    ;; Bottom edge
    (backend-write b (format nil "~%~v@{~a~:*~}" width h))))

(defmethod draw-rect ((b simple-backend) x y width height
                      &key bg)
  (declare (ignore x y width height bg))
  ;; On simple backend, background fill is a no-op
  (values))

(defmethod draw-link ((b simple-backend) x y string url
                      &key fg bg)
  (declare (ignore url fg bg))
  (draw-text b x y string nil nil))

(defmethod draw-ellipsis ((b simple-backend) x y width
                          &key fg bg)
  (declare (ignore x y width fg bg))
  (backend-write b "..."))
#+END_SRC