Files
cl-tty/org/framebuffer.org
Hermes Agent d5caaf296d fix: restore original text-input.lisp in org to fix handle-text-input
The tangled handle-text-input used (key-event-text event) for character
insertion, but the test suite creates key events with :code not :text.
Restored the original handle-text-input which uses
(code-char (key-event-code event)) — matching the test expectations.
2026-05-12 17:52:43 +00:00

19 KiB

Rendering Pipeline — Framebuffer (v0.13.0)

Overview

A framebuffer-based rendering pipeline that sits between the component tree and the backend protocol. Eliminates flicker by computing a full frame then diffing against the previous frame before flushing.

The framebuffer-backend class implements the backend protocol by writing to a 2D cell array instead of emitting escape sequences. After all components render, the diff engine compares current and previous frames and flushes only changed cells to a real backend.

Benefits:

  • Flicker-free output (only changed cells are sent)
  • Enables text selection (each cell knows its content)
  • Enables click-to-open-link (each cell knows its URL)
  • Scissor clipping for nested containers

Contract**

  • cell — immutable struct with char, fg, bg, bold, italic, underline, link-url
  • make-framebuffer width height → 2D array of cell
  • framebuffer-backend — subclass of backend that renders to cell array
  • make-framebuffer-backend &key width height → framebuffer-backend
  • diff-framebuffers prev curr → list of (x y cell) for changed cells
  • flush-framebuffer prev-fb curr-fb backend → writes changes, returns count
  • with-scissor (fb x y w h) &body body — clip drawing to rectangle

Plan

See docs/plans/2026-05-11-rendering-pipeline.md for full implementation plan.

  1. Create org file with code blocks
  2. Tangle → framebuffer.lisp
  3. Add to ASDF
  4. Write tests
  5. Run, commit

Tests

;; Tests for framebuffer pipeline — manually added to tests/framebuffer-tests.lisp

(defpackage :cl-tty-framebuffer-test
  (:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
(in-package :cl-tty-framebuffer-test)

(def-suite framebuffer-suite :description "Framebuffer rendering pipeline tests")
(in-suite framebuffer-suite)

(test make-framebuffer-creates-correct-size
  (let ((fb (make-framebuffer 80 24)))
    (is (= 24 (framebuffer-height fb)))
    (is (= 80 (framebuffer-width fb)))))

(test cell-defaults-are-space
  (let ((cell (aref (make-framebuffer 10 10) 0 0)))
    (is (eql #\space (cell-char cell)))
    (is (null (cell-fg cell)))
    (is (null (cell-bg cell)))))

(test draw-text-on-fb-sets-cells
  (let ((fb (make-framebuffer-backend)))
    (draw-text fb 2 3 "abc" :red nil)
    (let ((cells (fb-framebuffer fb)))
      (is (eql #\a (cell-char (aref cells 3 2))))
      (is (eql #\b (cell-char (aref cells 3 3))))
      (is (eql #\c (cell-char (aref cells 3 4))))
      (is (eql :red (cell-fg (aref cells 3 2)))))))

(test draw-text-clips-at-bounds
  (let ((fb (make-framebuffer-backend :width 10 :height 5)))
    (draw-text fb 8 2 "hello" nil nil)
    (let ((cells (fb-framebuffer fb)))
      (is (eql #\h (cell-char (aref cells 2 8))))
      (is (eql #\e (cell-char (aref cells 2 9))))
      (is (eql #\space (cell-char (aref cells 2 0))) "out of bounds text is ignored"))))

(test diff-identical-fbs-returns-empty
  (let ((fb1 (make-framebuffer 80 24))
        (fb2 (make-framebuffer 80 24)))
    (is (null (diff-framebuffers fb1 fb2)))))

(test diff-changed-fb-returns-changes
  (let* ((fb1 (make-framebuffer 10 10))
         (fb2 (make-framebuffer 10 10)))
    (setf (aref fb2 5 5) (make-cell :char #\X :fg :red))
    (let ((changes (diff-framebuffers fb1 fb2)))
      (is (= 1 (length changes)))
      (destructuring-bind (x y cell) (first changes)
        (is (= 5 x))
        (is (= 5 y))
        (is (eql #\X (cell-char cell)))))))

(test with-scissor-clips-drawing
  (let ((fb (make-framebuffer-backend :width 20 :height 10)))
    (with-scissor (fb 5 5 3 3)
      (draw-text fb 6 6 "ABC" nil nil)
      (draw-text fb 1 1 "OUTSIDE" nil nil))
    (let ((cells (fb-framebuffer fb)))
      (is (eql #\A (cell-char (aref cells 6 6))) "inside scissor draws")
      (is (eql #\space (cell-char (aref cells 1 1))) "outside scissor is clipped"))))

(test flush-fb-copies-to-backend
  (let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
         (fb (make-framebuffer-backend)))
    (draw-text fb 0 0 "X" :red nil)
    (let ((changed (flush-framebuffer (make-framebuffer 80 24) (fb-framebuffer fb) real-be)))
      (is (>= changed 1)))))

Implementation

Package and data structures

(defpackage :cl-tty.rendering
  (:use :cl :cl-tty.backend)
  (:export
   #:cell #:make-cell #:cell-char #:cell-fg #:cell-bg
   #:cell-bold #:cell-italic #:cell-underline #:cell-link-url
   #:framebuffer-backend #:make-framebuffer-backend
   #:make-framebuffer #:fb-framebuffer
   #:framebuffer-width #:framebuffer-height
   #:diff-framebuffers #:flush-framebuffer
   #:with-scissor
   #:extract-text #:fb-cell-link-url))
(in-package :cl-tty.rendering)

;;; ─── Cell — immutable per-cell state ─────────────────────────────────────────

(defstruct cell
  "A single terminal cell — character, colors, and attributes."
  (char #\space :type character)
  (fg nil)
  (bg nil)
  (bold nil :type boolean)
  (italic nil :type boolean)
  (underline nil :type boolean)
  (link-url nil))

;;; ─── Framebuffer — 2D array of cells ────────────────────────────────────────

(defun make-framebuffer (width height)
  "Create a 2D array of CELL with dimensions HEIGHT x WIDTH."
  (make-array (list height width)
              :initial-element (make-cell)
              :element-type 'cell))

(defun framebuffer-width (fb)
  "Return the width (columns) of framebuffer FB."
  (if (arrayp fb) (array-dimension fb 1) 0))

(defun framebuffer-height (fb)
  "Return the height (rows) of framebuffer FB."
  (if (arrayp fb) (array-dimension fb 0) 0))

;;; ─── Framebuffer Backend — implements backend protocol ─────────────────────

(defclass framebuffer-backend (backend)
  ((framebuffer :initform nil :accessor fb-framebuffer)
   (scissor-x :initform 0 :accessor fb-scissor-x)
   (scissor-y :initform 0 :accessor fb-scissor-y)
   (scissor-w :initform nil :accessor fb-scissor-w)
   (scissor-h :initform nil :accessor fb-scissor-h)))

(defun make-framebuffer-backend (&key (width 80) (height 24))
  "Create a framebuffer-backend with a fresh framebuffer."
  (let ((fb (make-instance 'framebuffer-backend)))
    (setf (fb-framebuffer fb) (make-framebuffer width height))
    fb))

Drawing methods

;;; ─── Drawing methods ─────────────────────────────────────────────────────────

(defun %in-scissor-p (fb cx cy)
  "Check if (CX, CY) falls within the current scissor rectangle."
  (let ((sx (fb-scissor-x fb)) (sy (fb-scissor-y fb))
        (sw (fb-scissor-w fb)) (sh (fb-scissor-h fb)))
    (and (or (null sw) (and (>= cx sx) (< cx (+ sx sw))))
         (or (null sh) (and (>= cy sy) (< cy (+ sy sh)))))))

(defun %set-cell (fb x y char &key fg bg bold italic underline link-url)
  "Set cell (X, Y) if within bounds and scissor."
  (let ((cells (fb-framebuffer fb)))
    (when (and (>= y 0) (< y (framebuffer-height cells))
               (>= x 0) (< x (framebuffer-width cells))
               (%in-scissor-p fb x y))
      (setf (aref cells y x)
            (make-cell :char char :fg fg :bg bg
                       :bold bold :italic italic :underline underline
                       :link-url link-url)))))

(defmethod draw-text ((fb framebuffer-backend) x y string fg bg
                        &key bold italic underline reverse dim blink
                             (link-url nil link-url-p)
                        &allow-other-keys)
  (declare (ignore reverse dim blink link-url-p))
  (loop for i from 0 below (length string)
        do (%set-cell fb (+ x i) y (char string i)
                      :fg fg :bg bg
                      :bold bold :italic italic :underline underline
                      :link-url link-url)))

(defmethod draw-rect ((fb framebuffer-backend) x y w h &key bg)
  (dotimes (row h)
    (dotimes (col w)
      (%set-cell fb (+ x col) (+ y row) #\space :fg nil :bg bg))))

(defmethod draw-border ((fb framebuffer-backend) x y w h &key (style :single) title title-align fg bg)
  (let* ((chars (case style
                  (:single '(#\+ #\- #\|))
                  (:double '(#\+ #\= #\|))
                  (:rounded '(#\. #\- #\|))
                  (t '(#\+ #\- #\|))))
         (tc (first chars)) (hc (second chars)) (vc (third chars)))
    ;; Top edge
    (%set-cell fb x y tc :fg fg :bg bg)
    (loop for i from 1 below (1- w) do (%set-cell fb (+ x i) y hc :fg fg :bg bg))
    (%set-cell fb (1- (+ x w)) y tc :fg fg :bg bg)
    ;; Sides
    (dotimes (row (- h 2))
      (%set-cell fb x (+ y row 1) vc :fg fg :bg bg)
      (%set-cell fb (1- (+ x w)) (+ y row 1) vc :fg fg :bg bg))
    ;; Bottom edge
    (%set-cell fb x (+ y h -1) tc :fg fg :bg bg)
    (loop for i from 1 below (1- w) do (%set-cell fb (+ x i) (+ y h -1) hc :fg fg :bg bg))
    (%set-cell fb (1- (+ x w)) (+ y h -1) tc :fg fg :bg bg)
    ;; Title
    (when title
      (loop for i from 0 below (length title)
            do (%set-cell fb (+ x 2 i) y (char title i) :fg fg :bg bg)))))

(defmethod backend-clear ((fb framebuffer-backend))
  (let ((cells (fb-framebuffer fb)))
    (dotimes (y (framebuffer-height cells))
      (dotimes (x (framebuffer-width cells))
        (setf (aref cells y x) (make-cell))))))

Diff and flush

(defmethod draw-link ((fb framebuffer-backend) x y string url &key fg bg)
  ;; OSC 8 links are not rendered in framebuffer — store as text
  (draw-text fb x y string fg bg :link-url url))

(defmethod draw-ellipsis ((fb framebuffer-backend) x y width &key fg bg)
  (dotimes (i (min 3 width))
    (%set-cell fb (+ x i) y #\. :fg fg :bg bg)))

;;; ─── Diff ────────────────────────────────────────────────────────────────────

(defun cells-equal-p (a b)
  "Return T if two cells have identical content and style."
  (and (eql (cell-char a) (cell-char b))
       (eql (cell-fg a) (cell-fg b))
       (eql (cell-bg a) (cell-bg b))
       (eql (cell-bold a) (cell-bold b))
       (eql (cell-italic a) (cell-italic b))
       (eql (cell-underline a) (cell-underline b))
       (equal (cell-link-url a) (cell-link-url b))))

(defun diff-framebuffers (prev curr)
  "Compare PREV and CURR framebuffers. Return list of (X Y CELL) for changes."
  (let ((changes nil)
        (h (min (framebuffer-height prev) (framebuffer-height curr)))
        (w (min (framebuffer-width prev) (framebuffer-width curr))))
    (dotimes (y h)
      (dotimes (x w)
        (let ((a (aref prev y x)) (b (aref curr y x)))
          (unless (cells-equal-p a b)
            (push (list x y b) changes)))))
    (nreverse changes)))

;;; ─── Flush ───────────────────────────────────────────────────────────────────

(defun flush-framebuffer (prev-fb curr-fb backend)
  "Diff PREV-FB and CURR-FB and flush changes to BACKEND.
Returns the number of changed cells."
  (let* ((changes (diff-framebuffers prev-fb curr-fb))
         (count (length changes))
         (current-row -1))
    (when (plusp count)
      (begin-sync backend)
      (dolist (change changes)
        (destructuring-bind (x y cell) change
          (unless (= y current-row)
            (cursor-move backend x y)
            (setf current-row y))
          (draw-text backend x y (string (cell-char cell))
                     (cell-fg cell) (cell-bg cell)
                     :bold (cell-bold cell)
                     :italic (cell-italic cell)
                     :underline (cell-underline cell))))
      (end-sync backend))
    count))

Frame inspection (for mouse selection / link clicking)

;;; --- Frame inspection ---------------------------------------------------

(defun fb-cell-link-url (fb x y)
  "Return the link URL at (X Y) in framebuffer FB, or nil."
  (when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
             (>= x 0) (< x (array-dimension fb 1)))
    (let ((c (aref fb y x)))
      (cell-link-url c))))

(defun extract-text (fb x1 y1 x2 y2)
  "Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)."
  (let ((x-min (max 0 (min x1 x2))) (x-max (max 0 (max x1 x2)))
        (y-min (max 0 (min y1 y2))) (y-max (max 0 (max y1 y2)))
        (h (if (arrayp fb) (array-dimension fb 0) 0))
        (w (if (arrayp fb) (array-dimension fb 1) 0)))
    (with-output-to-string (s)
      (loop for y from y-min to (min y-max (1- h))
            do (loop for x from x-min to (min x-max (1- w))
                     do (let ((c (aref fb y x)))
                          (princ (cell-char c) s)))
               (when (< y y-max) (princ #\Newline s))))))

Scissor clipping

;;; ─── Scissor clipping ────────────────────────────────────────────────────────

(defmacro with-scissor ((fb x y w h) &body body)
  "Clip all drawing on FB to rectangle (X Y W H)."
  (let ((old-x (gensym)) (old-y (gensym))
        (old-w (gensym)) (old-h (gensym)))
    `(let ((,old-x (fb-scissor-x ,fb))
           (,old-y (fb-scissor-y ,fb))
           (,old-w (fb-scissor-w ,fb))
           (,old-h (fb-scissor-h ,fb)))
       (setf (fb-scissor-x ,fb) ,x
             (fb-scissor-y ,fb) ,y
             (fb-scissor-w ,fb) ,w
             (fb-scissor-h ,fb) ,h)
       (unwind-protect (progn ,@body)
         (setf (fb-scissor-x ,fb) ,old-x
               (fb-scissor-y ,fb) ,old-y
               (fb-scissor-w ,fb) ,old-w
               (fb-scissor-h ,fb) ,old-h)))))

Tests

(defpackage :cl-tty-framebuffer-test
  (:use :cl :fiveam :cl-tty.rendering :cl-tty.backend))
(in-package :cl-tty-framebuffer-test)

(def-suite framebuffer-suite :description "Framebuffer rendering pipeline tests")
(in-suite framebuffer-suite)

(test make-framebuffer-creates-correct-size
  (let ((fb (make-framebuffer 80 24)))
    (is (= 24 (framebuffer-height fb)))
    (is (= 80 (framebuffer-width fb)))))

(test cell-defaults-are-space
  (let ((cell (aref (make-framebuffer 10 10) 0 0)))
    (is (eql #\space (cell-char cell)))
    (is (null (cell-fg cell)))
    (is (null (cell-bg cell)))))

(test draw-text-on-fb-sets-cells
  (let ((fb (make-framebuffer-backend)))
    (draw-text fb 2 3 "abc" :red nil)
    (let ((cells (fb-framebuffer fb)))
      (is (eql #\a (cell-char (aref cells 3 2))))
      (is (eql #\b (cell-char (aref cells 3 3))))
      (is (eql #\c (cell-char (aref cells 3 4))))
      (is (eql :red (cell-fg (aref cells 3 2)))))))

(test draw-text-clips-at-bounds
  (let ((fb (make-framebuffer-backend :width 10 :height 5)))
    (draw-text fb 8 2 "hello" nil nil)
    (let ((cells (fb-framebuffer fb)))
      (is (eql #\h (cell-char (aref cells 2 8))))
      (is (eql #\e (cell-char (aref cells 2 9))))
      (is (eql #\space (cell-char (aref cells 2 0))) "out of bounds text is ignored"))))

(test diff-identical-fbs-returns-empty
  (let ((fb1 (make-framebuffer 80 24))
        (fb2 (make-framebuffer 80 24)))
    (is (null (diff-framebuffers fb1 fb2)))))

(test diff-changed-fb-returns-changes
  (let* ((fb1 (make-framebuffer 10 10))
         (fb2 (make-framebuffer 10 10)))
    (setf (aref fb2 5 5) (make-cell :char #\X :fg :red))
    (let ((changes (diff-framebuffers fb1 fb2)))
      (is (= 1 (length changes)))
      (destructuring-bind (x y cell) (first changes)
        (is (= 5 x))
        (is (= 5 y))
        (is (eql #\X (cell-char cell)))))))

(test with-scissor-clips-drawing
  (let ((fb (make-framebuffer-backend :width 20 :height 10)))
    (with-scissor (fb 5 5 3 3)
      (draw-text fb 6 6 "ABC" nil nil)
      (draw-text fb 1 1 "OUTSIDE" nil nil))
    (let ((cells (fb-framebuffer fb)))
      (is (eql #\A (cell-char (aref cells 6 6))) "inside scissor draws")
      (is (eql #\space (cell-char (aref cells 1 1))) "outside scissor is clipped"))))

(test flush-different-sized-fbs-handles-edge-cells
  (let* ((small-fb (make-framebuffer 5 5))
         (large-fb (make-framebuffer 10 10))
         (be (make-simple-backend :output-stream (make-string-output-stream))))
    (setf (aref small-fb 0 0) (make-cell :char #\X :fg :red))
    (let ((changes (diff-framebuffers small-fb large-fb)))
      (is (= 1 (length changes)) "one cell changed in overlap region"))
    (let ((changed (flush-framebuffer small-fb large-fb be)))
      (is (= 1 changed) "flush reports 1 changed cell"))
    (setf (aref large-fb 9 9) (make-cell :char #\Y :fg :blue))
    (let ((changes2 (diff-framebuffers large-fb small-fb)))
      (is (= 1 (length changes2)) "only overlapping region diffed"))
    (let ((changed2 (flush-framebuffer large-fb small-fb be)))
      (is (= 1 changed2) "flush with shrunk fb reports 1 changed cell"))))

(test flush-fb-copies-to-backend
  (let* ((real-be (make-simple-backend :output-stream (make-string-output-stream)))
         (fb (make-framebuffer-backend)))
    (draw-text fb 0 0 "X" :red nil)
    (let ((changed (flush-framebuffer (make-framebuffer 80 24) (fb-framebuffer fb) real-be)))
      (is (>= changed 1)))))

(test fb-cell-link-url-returns-nil-for-blank-cell
  (let ((fb (make-framebuffer 10 10)))
    (is (null (fb-cell-link-url fb 5 5)))))

(test fb-cell-link-url-finds-link-url
  (let ((fb (make-framebuffer-backend)))
    (draw-text fb 0 0 "click" nil nil :link-url "https://example.com")
    (is (equal "https://example.com" (fb-cell-link-url (fb-framebuffer fb) 0 0)))
    (is (null (fb-cell-link-url (fb-framebuffer fb) 5 5)))))

(test fb-cell-link-url-out-of-bounds-returns-nil
  (let ((fb (make-framebuffer 5 5)))
    (is (null (fb-cell-link-url fb 10 10)))))

(test extract-text-single-row
  (let ((fb (make-framebuffer-backend)))
    (draw-text fb 0 0 "hello" nil nil)
    (let ((cells (fb-framebuffer fb)))
      (is (equal "hello" (extract-text cells 0 0 4 0))))))

(test extract-text-multi-row
  (let ((fb (make-framebuffer-backend)))
    (draw-text fb 0 0 "abc" nil nil)
    (draw-text fb 0 1 "def" nil nil)
    (let* ((cells (fb-framebuffer fb))
           (text (extract-text cells 0 0 2 1)))
      (is (equal "abc
def" text)))))