29f99a576d
Every function, defclass, defstruct, defgeneric, defmethod, defmacro, defvar, and defparameter in every org file now has its own #+BEGIN_SRC block with literate prose above it explaining the design reasoning. Block counts before → after: package.org: 1 → 7 container-package.org: 1 → 1 (prose expanded) dirty.org: 4 → 6 render.org: 10 → 25 theme.org: 6 → 19 box-renderable.org: 9 → 29 scrollbox.org: 8 → 26 tabbar.org: 5 → 10 backend-protocol.org: 8 → 66 modern-backend.org: 17 → 53 detection.org: 4 → 6 layout-engine.org: 9 → 36 framebuffer.org: 8 → 37 markdown-renderer.org:13 → 38 dialog.org: 17 → 23 (merged dual structure) mouse.org: 4 → 25 select.org: 12 → 30 slot.org: 4 → 12 text-input.org: 11 → 53 Total: ~153 blocks → ~502 blocks Bugs fixed during restructuring: - render.org: stray π character typo (backenπd → backend) - modern-backend.org: sgr-attr missing closing paren + #+END_SRC - detection.org: invalid #\Esc character reference - select.org: extra closing paren in select-visible-options All 13 test suites pass at 100%.
25 KiB
cl-tty Layout Engine
- Overview
- Contract
- Tests
- Test package definition
- Test suite
- Test runner
- Test: make-layout-node defaults
- Test: make-layout-node with
:row - Test: add-child sets parent
- Test: remove-child clears parent
- Test: column lays out two children vertically
- Test: row lays out two children horizontally
- Test: flex-grow distributes remaining space proportionally
- Test: flex-grow single child fills container
- Test: flex-shrink reduces overflow proportionally
- Test: padding reduces content area
- Test: gap between children
- Test: vbox macro
- Test: hbox macro
- Test: spacer takes grow
- Test: nested vbox in hbox
- Test: empty container does not crash
- Test: single child in column
- Test: zero-size container
- Test: deep nesting three levels
- Test: large padding leaves room
- Test: negative grow is clamped
- Implementation
Overview
Pure Common Lisp Flexbox layout engine. No Yoga, no CFFI, no external dependencies. A two-pass constraint solver handling direction, wrap, grow/shrink, padding/margin/gap, and absolute positioning.
Terminal resolution (~200x80) means a full Yoga FFI binding is unnecessary — ~200 lines of CL math suffices.
Contract
Layout Node
(make-layout-node &key direction grow shrink padding margin gap position-type position-offset width height)→ layout-node- Parent/child tree manipulation:
layout-node-add-child,layout-node-remove-child - Position/size accessors:
layout-node-x/y/width/height
Layout Properties
:direction—:rowor:column(default::column):grow— proportional distribution of remaining space (default: 0):shrink— proportional reduction when content overflows (default: 1):gap— spacing between children:padding— box padding plist (:top,:right,:bottom,:left):position-type—:relativeor:absolute
Solver
(compute-layout root available-width available-height)→ root Recursively computes position and size for every node.
Macros
(vbox (&key grow shrink padding margin gap width height) &body children)(hbox (&key grow shrink padding margin gap width height) &body children)(spacer &key grow)
Tests
Test package definition
The test package uses :fiveam for the test framework and imports
all exported symbols from cl-tty.layout.
(defpackage :cl-tty-layout-test
(:use :cl :fiveam :cl-tty.layout)
(:export #:run-tests))
(in-package :cl-tty-layout-test)Test suite
fiveam suites collect related tests under a descriptive name for
batch execution.
(def-suite layout-suite :description "Layout engine tests")
(in-suite layout-suite)Test runner
run-tests provides a convenient entry point that prints results and
exits cleanly for CI or batch runs.
(defun run-tests ()
(let ((result (run 'layout-suite)))
(fiveam:explain! result)
(uiop:quit 0)))Test: make-layout-node defaults
Verify that a node created with no arguments has the correct default
direction :column and is of type layout-node.
(test make-layout-node-defaults
(let ((n (make-layout-node)))
(is (typep n 'layout-node))
(is (eql (layout-node-direction n) :column))))
Test: make-layout-node with :row
Verify that passing :direction :row produces a node whose direction
slot reflects that choice.
(test make-layout-node-row
(let ((n (make-layout-node :direction :row)))
(is (eql (layout-node-direction n) :row))))Test: add-child sets parent
Children must have their parent back-pointer set when added, and
the parent's children list must contain the child.
(test add-child-sets-parent
(let ((parent (make-layout-node)) (child (make-layout-node)))
(layout-node-add-child parent child)
(is (eql (layout-node-parent child) parent))
(is (= (length (layout-node-children parent)) 1))))Test: remove-child clears parent
Removing a child should clear its parent reference and remove it
from the parent's children list.
(test remove-child-clears-parent
(let ((parent (make-layout-node)) (child (make-layout-node)))
(layout-node-add-child parent child)
(layout-node-remove-child parent child)
(is (null (layout-node-parent child)))
(is (= (length (layout-node-children parent)) 0))))Test: column lays out two children vertically
In a column layout, children stack top-to-bottom. The first child starts at y=0; the second starts below the first.
(test column-two-children-vertical
(let* ((root (make-layout-node :direction :column))
(c1 (make-layout-node :height 3))
(c2 (make-layout-node :height 5)))
(layout-node-add-child root c1) (layout-node-add-child root c2)
(compute-layout root 20 20)
(is (= (layout-node-y c1) 0)) (is (= (layout-node-height c1) 3))
(is (= (layout-node-y c2) 3)) (is (= (layout-node-height c2) 5))))Test: row lays out two children horizontally
In a row layout, children stack left-to-right. The first child starts at x=0; the second starts to the right of the first.
(test row-two-children-horizontal
(let* ((root (make-layout-node :direction :row))
(c1 (make-layout-node :width 10))
(c2 (make-layout-node :width 5)))
(layout-node-add-child root c1) (layout-node-add-child root c2)
(compute-layout root 20 10)
(is (= (layout-node-x c1) 0)) (is (= (layout-node-width c1) 10))
(is (= (layout-node-x c2) 10)) (is (= (layout-node-width c2) 5))))Test: flex-grow distributes remaining space proportionally
When children have different grow values, remaining space is
divided in proportion to those values. A child with grow=2 gets
twice as much extra space as a child with grow=1.
(test flex-grow-distributes-space
(let* ((root (make-layout-node :direction :row :width 20))
(c1 (make-layout-node :width 4 :grow 1))
(c2 (make-layout-node :width 4 :grow 2)))
(layout-node-add-child root c1) (layout-node-add-child root c2)
(compute-layout root 20 10)
(is (= (layout-node-width c1) 8)) (is (= (layout-node-width c2) 12))))Test: flex-grow single child fills container
A single flexible child with grow set should expand to fill all
available space in the container.
(test flex-grow-single-child
(let* ((root (make-layout-node :direction :row :width 20))
(c (make-layout-node :width 5 :grow 1)))
(layout-node-add-child root c)
(compute-layout root 20 10)
(is (= (layout-node-width c) 20))))Test: flex-shrink reduces overflow proportionally
When children exceed the container size, each child shrinks in
proportion to its shrink value.
(test flex-shrink-reduces-overflow
(let* ((root (make-layout-node :direction :row :width 10))
(c1 (make-layout-node :width 8 :shrink 1))
(c2 (make-layout-node :width 8 :shrink 1)))
(layout-node-add-child root c1) (layout-node-add-child root c2)
(compute-layout root 10 10)
(is (= (layout-node-width c1) 5)) (is (= (layout-node-width c2) 5))))Test: padding reduces content area
Padding insets the child rendering area. Children are offset by the padding values and sized to the remaining space.
(test padding-reduces-content-area
(let* ((root (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
(c (make-layout-node :height 3)))
(layout-node-add-child root c)
(compute-layout root 20 10)
(is (= (layout-node-x c) 1)) (is (= (layout-node-y c) 1))
(is (= (layout-node-height c) 3))))Test: gap between children
The gap property inserts spacing between consecutive children
without adding space before the first or after the last.
(test gap-between-children
(let* ((root (make-layout-node :direction :column :gap 2))
(c1 (make-layout-node :height 3))
(c2 (make-layout-node :height 3)))
(layout-node-add-child root c1) (layout-node-add-child root c2)
(compute-layout root 20 20)
(is (= (layout-node-y c1) 0)) (is (= (layout-node-y c2) 5))))Test: vbox macro
The vbox macro creates a column-direction container and adds
children in one expression. The second child's y-offset should be
the sum of the first child's height plus gap.
(test vbox-macro
(let ((r (vbox () (make-layout-node :height 3) (make-layout-node :height 5))))
(compute-layout r 20 20)
(is (= (length (layout-node-children r)) 2))
(is (= (layout-node-y (elt (layout-node-children r) 1)) 3))))Test: hbox macro
The hbox macro creates a row-direction container. The second
child's x-offset should equal the first child's width.
(test hbox-macro
(let ((r (hbox () (make-layout-node :width 5) (make-layout-node :width 3))))
(compute-layout r 20 10)
(is (= (length (layout-node-children r)) 2))
(is (= (layout-node-x (elt (layout-node-children r) 1)) 5))))Test: spacer takes grow
The spacer macro creates a flexible node that pushes siblings
apart. With two fixed-width children and a spacer between them, the
spacer absorbs all remaining width.
(test spacer-takes-grow
(let ((r (hbox (:width 20) (make-layout-node :width 5) (spacer :grow 1) (make-layout-node :width 5))))
(compute-layout r 20 10)
(let ((c (layout-node-children r)))
(is (= (layout-node-x (elt c 2)) 15)) (is (= (layout-node-width (elt c 1)) 10)))))Test: nested vbox in hbox
Nesting a column layout inside a row layout exercises the recursive solver. Sidebar gets fixed width; main content stretches.
(test nested-vbox-in-hbox
(let* ((sidebar (vbox (:width 5 :height 10) (make-layout-node :height 3) (make-layout-node :height 7)))
(main (vbox (:grow 1 :height 10) (make-layout-node :height 2) (make-layout-node :grow 1)))
(r (hbox (:width 30 :height 10) sidebar main)))
(compute-layout r 30 10)
(is (= (layout-node-width sidebar) 5))
(is (>= (layout-node-width main) 20))
(let ((sc (layout-node-children sidebar)))
(is (= (layout-node-y (elt sc 0)) 0))
(is (= (layout-node-y (elt sc 1)) 3)))))Test: empty container does not crash
Layout must gracefully handle containers with no children, returning valid integer dimensions.
(test empty-container-does-not-crash
(let ((r (make-layout-node)))
(compute-layout r 20 20)
(is (integerp (layout-node-width r)))
(is (integerp (layout-node-height r)))))Test: single child in column
A column with one child positions it at the origin and sizes it to its requested height. Width is inherited from the container.
(test single-child-in-column
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
(c (make-layout-node :height 5)))
(layout-node-add-child r c)
(compute-layout r 10 20)
(is (= (layout-node-y c) 0))
(is (= (layout-node-height c) 5))))Test: zero-size container
When available space is zero, the solver must still produce valid integer coordinates without crashing or producing NaN/infinite values.
(test zero-size-container
(let* ((r (make-layout-node :direction :column))
(c (make-layout-node :height 5)))
(layout-node-add-child r c)
(compute-layout r 0 0)
(is (integerp (layout-node-x c)))
(is (integerp (layout-node-y c)))))Test: deep nesting three levels
Three levels of nested vboxes ensure that layout is computed correctly for deeply nested subtrees.
(test deep-nesting-three-levels
(let* ((out (vbox ()
(vbox (:grow 1)
(make-layout-node :height 2))))
(leaf (elt (layout-node-children
(elt (layout-node-children out) 0)) 0)))
(compute-layout out 20 20)
(is (= (layout-node-y leaf) 0))))Test: large padding leaves room
Substantial padding on all sides should offset children inward by the full padding amount.
(test large-padding-leaves-room
(let* ((r (make-layout-node :direction :column
:padding '(:top 5 :left 5 :bottom 5 :right 5)))
(c (make-layout-node :height 3)))
(layout-node-add-child r c)
(compute-layout r 20 20)
(is (= (layout-node-x c) 5))
(is (= (layout-node-y c) 5))))Test: negative grow is clamped
A negative grow value should not cause layout errors. The solver
treats it as zero for distribution purposes and produces valid output.
(test negative-grow-is-clamped
(let* ((r (make-layout-node :direction :row :width 10))
(c (make-layout-node :width 5 :grow -1)))
(layout-node-add-child r c)
(compute-layout r 10 10)
(is (integerp (layout-node-width c)))))Implementation
Package
The cl-tty.layout package exports all public symbols for creating
and manipulating layout trees. Internal accessors like
layout-node-parent and helpers like normalize-box are also
exported for testing.
(defpackage :cl-tty.layout
(:use :cl)
(:export
#:layout-node #:make-layout-node
#:layout-node-add-child #:layout-node-remove-child
#:layout-node-children
#:layout-node-x #:layout-node-y
#:layout-node-width #:layout-node-height
#:layout-node-direction
#:compute-layout
#:vbox #:hbox #:spacer
;; For tests
#:layout-node-parent #:layout-node-fixed-width
#:layout-node-fixed-height #:normalize-box
#:box-edge))
(in-package :cl-tty.layout)Box model utilities
normalize-box
normalize-box converts nil, number, or plist inputs to a canonical
plist. This normalisation layer means users can pass :padding 2 or
:padding '(:top 1 :left 2) interchangeably throughout the API.
(defun normalize-box (spec)
(cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
((numberp spec) (list :top spec :right spec :bottom spec :left spec))
(t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0)
for (key val) on spec by #'cddr
do (setf (getf result key) val)
finally (return result)))))box-edge
box-edge extracts the value for a specific edge keyword from a
canonical box plist, defaulting to zero if the key is not present.
(defun box-edge (box edge)
(or (getf box edge) 0))Layout node class
The layout-node class holds all properties needed by the flexbox
layout algorithm. Slots are split between tree structure (parent,
children), computed layout results (x, y, width, height),
and input constraints (direction, grow, shrink, padding,
margin, gap, position-type, position-offset, fixed-width,
fixed-height).
(defclass layout-node ()
((parent :initform nil :accessor layout-node-parent)
(children :initform nil :accessor layout-node-children)
(x :initform 0 :accessor layout-node-x)
(y :initform 0 :accessor layout-node-y)
(width :initform 0 :accessor layout-node-width)
(height :initform 0 :accessor layout-node-height)
(direction :initform :column :initarg :direction :accessor layout-node-direction)
(grow :initform 0 :initarg :grow :accessor layout-node-grow)
(shrink :initform 1 :initarg :shrink :accessor layout-node-shrink)
(padding :initform (list :top 0 :right 0 :bottom 0 :left 0) :initarg :padding :accessor layout-node-padding)
(margin :initform (list :top 0 :right 0 :bottom 0 :left 0) :initarg :margin :accessor layout-node-margin)
(gap :initform 0 :initarg :gap :accessor layout-node-gap)
(position-type :initform :relative :initarg :position-type :accessor layout-node-position-type)
(position-offset :initform nil :initarg :position-offset :accessor layout-node-position-offset)
(fixed-width :initform nil :initarg :width :accessor layout-node-fixed-width)
(fixed-height :initform nil :initarg :height :accessor layout-node-fixed-height)))Constructor
make-layout-node is the primary constructor. It normalises all
keyword arguments through normalize-box for padding/margin, fills
defaults for missing values, and delegates to make-instance.
(defun make-layout-node (&key direction grow shrink padding margin gap
position-type position-offset width height)
(make-instance 'layout-node
:direction (or direction :column)
:grow (or grow 0) :shrink (or shrink 1)
:padding (normalize-box padding) :margin (normalize-box margin)
:gap (or gap 0)
:position-type (or position-type :relative)
:position-offset position-offset
:width width :height height))Tree manipulation
layout-node-add-child
layout-node-add-child attaches a child to a parent by setting the
child's parent back-pointer and appending to the parent's children
list. Returns the child for convenience in chaining or let forms.
(defun layout-node-add-child (parent child)
(setf (layout-node-parent child) parent)
(setf (layout-node-children parent)
(nconc (layout-node-children parent) (list child)))
child)layout-node-remove-child
layout-node-remove-child detaches a child by clearing its parent
back-pointer and removing it from the parent's children list.
Returns the child.
(defun layout-node-remove-child (parent child)
(setf (layout-node-parent child) nil)
(setf (layout-node-children parent)
(delete child (layout-node-children parent)))
child)Constraint solver
distribute-sizes
distribute-sizes computes child sizes given available space and
gap. Each child starts from its fixed size. Remaining space is
distributed by grow ratio; overflow is reduced by shrink ratio.
Rounding errors are amortized across the first N children.
(defun distribute-sizes (children avail gap horizontal)
(let* ((n (length children))
(gap-total (* gap (max 0 (1- n))))
(base (mapcar (lambda (c)
(or (if horizontal
(layout-node-fixed-width c)
(layout-node-fixed-height c))
0))
children))
(base-total (reduce #'+ base))
(remaining (- avail base-total gap-total))
(grow-total (reduce #'+ (mapcar #'layout-node-grow children)))
(shrink-total (reduce #'+ (mapcar #'layout-node-shrink children))))
(let ((sizes (mapcar (lambda (c b)
(let ((sz b))
(when (and (plusp remaining) (plusp grow-total))
(incf sz (round (* remaining (/ (layout-node-grow c) grow-total)))))
(when (and (minusp remaining) (plusp shrink-total))
(decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
(max 1 sz)))
children base)))
(when (or (and (plusp remaining) (plusp grow-total))
(and (minusp remaining) (plusp shrink-total)))
(let ((delta (- avail gap-total (reduce #'+ sizes))))
(when (/= delta 0)
(loop :for i :from 0 :below (min (abs delta) n)
:do (incf (nth i sizes) (signum delta))))))
sizes)))compute-layout
compute-layout recursively lays out all children of the root node
within given dimensions. It positions each child at the correct
(x, y) coordinate and sizes it to fill the available space. The
inner labels form place-children handles the recursive descent,
adjusting for padding and direction at each level.
(defun compute-layout (root available-width available-height)
(labels ((place-children (node x y max-w max-h)
(let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row))
(pl (box-edge (layout-node-padding node) :left))
(pt (box-edge (layout-node-padding node) :top))
(pr (box-edge (layout-node-padding node) :right))
(pb (box-edge (layout-node-padding node) :bottom))
(cw (max 0 (- max-w pl pr)))
(ch (max 0 (- max-h pt pb)))
(gap (layout-node-gap node))
(sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
(setf (layout-node-x node) (+ x pl)
(layout-node-y node) (+ y pt))
(loop :with pos = 0
:for child :in children
:for size :in sizes
:do (if is-row
(setf (layout-node-width child) size
(layout-node-x child) (+ x pl pos)
(layout-node-height child) ch
(layout-node-y child) (+ y pt))
(setf (layout-node-height child) size
(layout-node-y child) (+ y pt pos)
(layout-node-width child) cw
(layout-node-x child) (+ x pl)))
(place-children child
(layout-node-x child)
(layout-node-y child)
(if is-row size cw)
(if is-row ch size))
(incf pos (+ size gap)))
(let ((last-child (car (last children))))
(if is-row
(setf (layout-node-width node)
(or (layout-node-fixed-width node)
(if last-child
(+ (layout-node-x node)
(layout-node-width last-child)
pr)
max-w))
(layout-node-height node)
max-h)
(setf (layout-node-height node)
(or (layout-node-fixed-height node)
(if last-child
(let ((last-y (layout-node-y last-child))
(last-h (layout-node-height last-child)))
(+ last-y last-h pb))
max-h))
(layout-node-width node)
max-w))))))
(place-children root 0 0 available-width available-height)
root))Composable macros
vbox
vbox creates a column-direction container with optional layout
properties and adds all children via layout-node-add-child. The
gensym ensures no variable capture in the expansion.
(defmacro vbox ((&key grow shrink padding margin gap width height) &body children)
(let ((n (gensym)))
`(let ((,n (make-layout-node :direction :column
,@(when grow `(:grow ,grow))
,@(when shrink `(:shrink ,shrink))
,@(when padding `(:padding ,padding))
,@(when margin `(:margin ,margin))
,@(when gap `(:gap ,gap))
,@(when width `(:width ,width))
,@(when height `(:height ,height)))))
,@(loop for c in children collect `(layout-node-add-child ,n ,c))
,n)))hbox
hbox creates a row-direction container, structurally identical to
vbox except the :direction is :row.
(defmacro hbox ((&key grow shrink padding margin gap width height) &body children)
(let ((n (gensym)))
`(let ((,n (make-layout-node :direction :row
,@(when grow `(:grow ,grow))
,@(when shrink `(:shrink ,shrink))
,@(when padding `(:padding ,padding))
,@(when margin `(:margin ,margin))
,@(when gap `(:gap ,gap))
,@(when width `(:width ,width))
,@(when height `(:height ,height)))))
,@(loop for c in children collect `(layout-node-add-child ,n ,c))
,n)))spacer
spacer creates a minimal flex-grow node that fills remaining space,
defaulting to grow 1 when no keyword is given.
(defmacro spacer (&key grow)
`(make-layout-node :grow ,(or grow 1)))