amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

literate: convert org/layout-engine.org from doc-only to tangle source

Browse Source 
Now tangles to layout.lisp + layout/tests.lisp.
Deleted hand-written originals and regenerated — GREEN.
This commit is contained in:
Hermes Agent
2026-05-12 17:18:27 +00:00
parent f50d0e61d1
commit d3bc6c748a
3 changed files with 304 additions and 483 deletions
Download Patch File Download Diff File Expand all files Collapse all files

754
org/layout-engine.org
View File

@@ -1,90 +1,48 @@
#+TITLE: cl-tty Layout Engine — v0.0.3 #+TITLE: cl-tty Layout Engine
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tty:layout:v0.0.3: #+FILETAGS: :cl-tty:layout:
#+OPTIONS: ^:nil
* Layout Engine * Overview
Pure Common Lisp Flexbox layout engine. No Yoga, no CFFI, no external Pure Common Lisp Flexbox layout engine. No Yoga, no CFFI, no external
dependencies. A two-pass constraint solver that handles direction, wrap, dependencies. A two-pass constraint solver handling direction, wrap,
grow/shrink, and absolute positioning. Terminal resolution (~200x80) grow/shrink, padding/margin/gap, and absolute positioning.
means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
** Contract Terminal resolution (~200x80) means a full Yoga FFI binding is
unnecessary — ~200 lines of CL math suffices.
*** Layout Node * Contract
- =(make-layout-node &key direction wrap grow shrink basis ** Layout Node
align-items justify-content padding margin border gap
position-type position-offset width height)= → layout-node
Create a layout node with the given properties. - ~(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~
Properties: ** Layout Properties
- =:direction= — =:row=, =:column=, =:row-reverse=, =:column-reverse=
- =:wrap= — =:nowrap=, =:wrap=, =:wrap-reverse=
- =:grow= — flex grow factor (0 = no grow)
- =:shrink= — flex shrink factor (1 = default)
- =:basis= — flex basis (:auto or integer)
- =:align-items= — =:flex-start=, =:center=, =:flex-end=, =:stretch=
- =:justify-content= — =:flex-start=, =:center=, =:flex-end=,
=:space-between=, =:space-around=, =:space-evenly=
- =:padding=, =:margin=, =:border= — plist with =:top=, =:right=,
=:bottom=, =:left=, =:x=, =:y=
- =:gap= — plist with =:row= and =:column=, or single integer
- =:position-type= — =:relative= or =:absolute=
- =:position-offset= — plist with =:top=, =:right=, =:bottom=, =:left=
- =:width=, =:height= — fixed dimensions (nil = auto)
*** Node Manipulation - ~:direction~ — ~:row~ or ~: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~ — ~:relative~ or ~:absolute~
- =(layout-node-add-child parent child)= → child ** Solver
Add CHILD as the last child of PARENT. Sets child's parent.
- =(layout-node-remove-child parent child)= → child - ~(compute-layout root available-width available-height)~ → root
Remove CHILD from PARENT's children list. Recursively computes position and size for every node.
- =(layout-node-children node)= → list ** Macros
Return list of child nodes.
*** Layout Calculation - ~(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)~
- =(compute-layout root available-width available-height)= → root * Tests
Run the layout algorithm on the entire tree. Populates each node's
computed =:x=, =:y=, =:width=, =:height= slots.
Algorithm: #+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
1. Resolve styles (inherit, defaults)
2. First pass (column direction): distribute Y positions
3. Second pass (row direction): distribute X positions
4. Resolve absolute-positioned children
5. Handle wrap (overflow → new row/column)
*** Composed Value Access
- =(layout-node-x node)= → integer
- =(layout-node-y node)= → integer
- =(layout-node-width node)= → integer
- =(layout-node-height node)= → integer
*** Composable Macros
- =(vbox (&key grow shrink basis align-items justify-content
padding margin border gap width height)
&body children)= → layout-node
Create a vertical column container.
- =(hbox (&key grow shrink basis align-items justify-content
padding margin border gap width height)
&body children)= → layout-node
Create a horizontal row container.
- =(spacer &key grow)= → layout-node
Create an empty flex spacer.
** Test Suite
#+BEGIN_SRC lisp
(defpackage :cl-tty-layout-test (defpackage :cl-tty-layout-test
(:use :cl :fiveam :cl-tty.layout) (:use :cl :fiveam :cl-tty.layout)
(:export #:run-tests)) (:export #:run-tests))
@@ -98,496 +56,386 @@ means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
(fiveam:explain! result) (fiveam:explain! result)
(uiop:quit 0))) (uiop:quit 0)))
;; ── Node Creation ──────────────────────────────────────────────
(test make-layout-node-defaults (test make-layout-node-defaults
"make-layout-node creates a node with default values"
(let ((n (make-layout-node))) (let ((n (make-layout-node)))
(is (typep n 'layout-node)) (is (typep n 'layout-node))
(is (eql (layout-node-direction n) :column)))) (is (eql (layout-node-direction n) :column))))
(test make-layout-node-row (test make-layout-node-row
"make-layout-node with :row direction"
(let ((n (make-layout-node :direction :row))) (let ((n (make-layout-node :direction :row)))
(is (eql (layout-node-direction n) :row)))) (is (eql (layout-node-direction n) :row))))
;; ── Tree Building ──────────────────────────────────────────────
(test add-child-sets-parent (test add-child-sets-parent
"layout-node-add-child sets parent on child" (let ((parent (make-layout-node)) (child (make-layout-node)))
(let ((parent (make-layout-node))
(child (make-layout-node)))
(layout-node-add-child parent child) (layout-node-add-child parent child)
(is (eql (slot-value child 'parent) parent)) (is (eql (layout-node-parent child) parent))
(is (= (length (slot-value parent 'children)) 1)))) (is (= (length (layout-node-children parent)) 1))))
(test remove-child-clears-parent (test remove-child-clears-parent
"layout-node-remove-child clears parent slot" (let ((parent (make-layout-node)) (child (make-layout-node)))
(let ((parent (make-layout-node))
(child (make-layout-node)))
(layout-node-add-child parent child) (layout-node-add-child parent child)
(layout-node-remove-child parent child) (layout-node-remove-child parent child)
(is (null (slot-value child 'parent))) (is (null (layout-node-parent child)))
(is (= (length (slot-value parent 'children)) 0)))) (is (= (length (layout-node-children parent)) 0))))
;; ── Simple Layout — Column ─────────────────────────────────────
(test column-two-children-vertical (test column-two-children-vertical
"column stacks children vertically"
(let* ((root (make-layout-node :direction :column)) (let* ((root (make-layout-node :direction :column))
(c1 (make-layout-node :height 3)) (c1 (make-layout-node :height 3))
(c2 (make-layout-node :height 5))) (c2 (make-layout-node :height 5)))
(layout-node-add-child root c1) (layout-node-add-child root c1) (layout-node-add-child root c2)
(layout-node-add-child root c2)
(compute-layout root 20 20) (compute-layout root 20 20)
(is (= (layout-node-y c1) 0)) (is (= (layout-node-y c1) 0)) (is (= (layout-node-height c1) 3))
(is (= (layout-node-height c1) 3)) (is (= (layout-node-y c2) 3)) (is (= (layout-node-height c2) 5))))
(is (= (layout-node-y c2) 3))
(is (= (layout-node-height c2) 5))))
(test row-two-children-horizontal (test row-two-children-horizontal
"row places children side by side"
(let* ((root (make-layout-node :direction :row)) (let* ((root (make-layout-node :direction :row))
(c1 (make-layout-node :width 10)) (c1 (make-layout-node :width 10))
(c2 (make-layout-node :width 5))) (c2 (make-layout-node :width 5)))
(layout-node-add-child root c1) (layout-node-add-child root c1) (layout-node-add-child root c2)
(layout-node-add-child root c2)
(compute-layout root 20 10) (compute-layout root 20 10)
(is (= (layout-node-x c1) 0)) (is (= (layout-node-x c1) 0)) (is (= (layout-node-width c1) 10))
(is (= (layout-node-width c1) 10)) (is (= (layout-node-x c2) 10)) (is (= (layout-node-width c2) 5))))
(is (= (layout-node-x c2) 10))
(is (= (layout-node-width c2) 5))))
;; ── Flex Grow ──────────────────────────────────────────────────
(test flex-grow-distributes-space (test flex-grow-distributes-space
"flex-grow distributes remaining space proportionally"
(let* ((root (make-layout-node :direction :row :width 20)) (let* ((root (make-layout-node :direction :row :width 20))
(c1 (make-layout-node :width 4 :grow 1)) (c1 (make-layout-node :width 4 :grow 1))
(c2 (make-layout-node :width 4 :grow 2))) (c2 (make-layout-node :width 4 :grow 2)))
(layout-node-add-child root c1) (layout-node-add-child root c1) (layout-node-add-child root c2)
(layout-node-add-child root c2)
(compute-layout root 20 10) (compute-layout root 20 10)
;; total fixed = 8, available = 12, c1 gets 4, c2 gets 8 (is (= (layout-node-width c1) 8)) (is (= (layout-node-width c2) 12))))
(is (= (layout-node-width c1) 8))
(is (= (layout-node-width c2) 12))))
(test flex-grow-single-child (test flex-grow-single-child
"single child with flex-grow fills remaining space"
(let* ((root (make-layout-node :direction :row :width 20)) (let* ((root (make-layout-node :direction :row :width 20))
(c (make-layout-node :width 5 :grow 1))) (c (make-layout-node :width 5 :grow 1)))
(layout-node-add-child root c) (layout-node-add-child root c)
(compute-layout root 20 10) (compute-layout root 20 10)
(is (= (layout-node-width c) 20)))) (is (= (layout-node-width c) 20))))
;; ── Flex Shrink ────────────────────────────────────────────────
(test flex-shrink-reduces-overflow (test flex-shrink-reduces-overflow
"flex-shrink reduces children when content overflows"
(let* ((root (make-layout-node :direction :row :width 10)) (let* ((root (make-layout-node :direction :row :width 10))
(c1 (make-layout-node :width 8 :shrink 1)) (c1 (make-layout-node :width 8 :shrink 1))
(c2 (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 c1) (layout-node-add-child root c2)
(layout-node-add-child root c2)
(compute-layout root 10 10) (compute-layout root 10 10)
;; Total = 16, available = 10, overflow = 6, each shrinks by 3 (is (= (layout-node-width c1) 5)) (is (= (layout-node-width c2) 5))))
(is (= (layout-node-width c1) 5))
(is (= (layout-node-width c2) 5))))
;; ── Absolute Positioning ───────────────────────────────────────
(test absolute-positioned-child
"absolute child positions relative to parent"
(let* ((root (make-layout-node :width 20 :height 20))
(c (make-layout-node :position-type :absolute
:position-offset '(:top 2 :left 3)
:width 5 :height 5)))
(layout-node-add-child root c)
(compute-layout root 20 20)
(is (= (layout-node-x c) 3))
(is (= (layout-node-y c) 2))))
;; ── Padding ────────────────────────────────────────────────────
(test padding-reduces-content-area (test padding-reduces-content-area
"padding reduces available area for children" (let* ((root (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
(let* ((root (make-layout-node :direction :column
:padding '(:top 1 :left 1 :bottom 1 :right 1)))
(c (make-layout-node :height 3))) (c (make-layout-node :height 3)))
(layout-node-add-child root c) (layout-node-add-child root c)
(compute-layout root 20 10) (compute-layout root 20 10)
(is (= (layout-node-x c) 1)) (is (= (layout-node-x c) 1)) (is (= (layout-node-y c) 1))
(is (= (layout-node-y c) 1))
;; content height = 10 - 2 = 8, child height = 3
(is (= (layout-node-height c) 3)))) (is (= (layout-node-height c) 3))))
;; ── Gap ────────────────────────────────────────────────────────
(test gap-between-children (test gap-between-children
"gap adds spacing between children"
(let* ((root (make-layout-node :direction :column :gap 2)) (let* ((root (make-layout-node :direction :column :gap 2))
(c1 (make-layout-node :height 3)) (c1 (make-layout-node :height 3))
(c2 (make-layout-node :height 3))) (c2 (make-layout-node :height 3)))
(layout-node-add-child root c1) (layout-node-add-child root c1) (layout-node-add-child root c2)
(layout-node-add-child root c2)
(compute-layout root 20 20) (compute-layout root 20 20)
(is (= (layout-node-y c1) 0)) (is (= (layout-node-y c1) 0)) (is (= (layout-node-y c2) 5))))
(is (= (layout-node-y c2) 5)))) ; 3 + 2 gap
;; ── Composable Macros ──────────────────────────────────────────
(test vbox-macro (test vbox-macro
"vbox creates a column container with children" (let ((r (vbox () (make-layout-node :height 3) (make-layout-node :height 5))))
(let* ((root (vbox () (make-layout-node :height 3) (make-layout-node :height 5)))) (compute-layout r 20 20)
(compute-layout root 20 20) (is (= (length (layout-node-children r)) 2))
(is (= (length (layout-node-children root)) 2)) (is (= (layout-node-y (elt (layout-node-children r) 1)) 3))))
(is (= (layout-node-y (elt (layout-node-children root) 1)) 3))))
(test hbox-macro (test hbox-macro
"hbox creates a row container with children" (let ((r (hbox () (make-layout-node :width 5) (make-layout-node :width 3))))
(let* ((root (hbox () (make-layout-node :width 5) (make-layout-node :width 3)))) (compute-layout r 20 10)
(compute-layout root 20 10) (is (= (length (layout-node-children r)) 2))
(is (= (length (layout-node-children root)) 2)) (is (= (layout-node-x (elt (layout-node-children r) 1)) 5))))
(is (= (layout-node-x (elt (layout-node-children root) 1)) 5))))
(test spacer-takes-grow (test spacer-takes-grow
"spacer with grow fills remaining space" (let ((r (hbox (:width 20) (make-layout-node :width 5) (spacer :grow 1) (make-layout-node :width 5))))
(let* ((root (hbox (:width 20) (compute-layout r 20 10)
(make-layout-node :width 5) (let ((c (layout-node-children r)))
(spacer :grow 1) (is (= (layout-node-x (elt c 2)) 15)) (is (= (layout-node-width (elt c 1)) 10)))))
(make-layout-node :width 5))))
(compute-layout root 20 10)
(let ((children (layout-node-children root)))
(is (= (layout-node-x (elt children 2)) 15))
(is (= (layout-node-width (elt children 1)) 10)))))
;; ── Nested Layout ──────────────────────────────────────────────
(test nested-vbox-in-hbox (test nested-vbox-in-hbox
"nested vbox in hbox produces correct leaf positions" (let* ((sidebar (vbox (:width 5 :height 10) (make-layout-node :height 3) (make-layout-node :height 7)))
(let* ((sidebar (vbox (:width 5 :height 10) (main (vbox (:grow 1 :height 10) (make-layout-node :height 2) (make-layout-node :grow 1)))
(make-layout-node :height 3) (r (hbox (:width 30 :height 10) sidebar main)))
(make-layout-node :height 7))) (compute-layout r 30 10)
(main (vbox (:grow 1 :height 10)
(make-layout-node :height 2)
(make-layout-node :grow 1)))
(root (hbox (:width 30 :height 10)
sidebar main)))
(compute-layout root 30 10)
;; sidebar takes 5 cols, main takes 25 cols (grows)
(is (= (layout-node-width sidebar) 5)) (is (= (layout-node-width sidebar) 5))
(is (>= (layout-node-width main) 20)) (is (>= (layout-node-width main) 20))
;; sidebar children positioned correctly (let ((sc (layout-node-children sidebar)))
(let ((sidebar-children (layout-node-children sidebar))) (is (= (layout-node-y (elt sc 0)) 0))
(is (= (layout-node-y (elt sidebar-children 0)) 0)) (is (= (layout-node-y (elt sc 1)) 3)))))
(is (= (layout-node-y (elt sidebar-children 1)) 3)))))
;; ── Edge Cases ────────────────────────────────────────────────
(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
(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
(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
(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
(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
(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)))))
#+END_SRC #+END_SRC
** Implementation * Implementation
*** Package ** Package
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(defpackage :cl-tty.layout (defpackage :cl-tty.layout
(:use :cl) (:use :cl)
(:export (:export
;; Classes #:layout-node #:make-layout-node
#:layout-node
;; Construction
#:make-layout-node
;; Tree manipulation
#:layout-node-add-child #:layout-node-remove-child #:layout-node-add-child #:layout-node-remove-child
#:layout-node-children #:layout-node-children
;; Computed values
#:layout-node-x #:layout-node-y #:layout-node-x #:layout-node-y
#:layout-node-width #:layout-node-height #:layout-node-width #:layout-node-height
#:layout-node-direction #:layout-node-direction
;; Layout
#:compute-layout #:compute-layout
;; Macros #:vbox #:hbox #:spacer
#: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) (in-package :cl-tty.layout)
#+END_SRC #+END_SRC
*** Layout Node Class ** Box model utilities
#+BEGIN_SRC lisp ~normalize-box~ converts nil, number, or plist inputs to a canonical
(defclass layout-node () plist. ~box-edge~ extracts the value for a specific edge.
;; Tree structure
((parent :initform nil :accessor layout-node-parent)
(children :initform '() :accessor layout-node-children)
;; Computed layout (populated by compute-layout)
(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)
;; Flex properties
(direction :initform :column
:initarg :direction :accessor layout-node-direction)
(wrap :initform :nowrap
:initarg :wrap :accessor layout-node-wrap)
(grow :initform 0 :initarg :grow
:accessor layout-node-grow)
(shrink :initform 1 :initarg :shrink
:accessor layout-node-shrink)
(basis :initform :auto :initarg :basis
:accessor layout-node-basis)
(align-items :initform :stretch :initarg :align-items
:accessor layout-node-align-items)
(justify-content :initform :flex-start :initarg :justify-content
:accessor layout-node-justify-content)
;; Box model
(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)
(border :initform (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :border :accessor layout-node-border)
(gap :initform 0 :initarg :gap :accessor layout-node-gap)
;; Position
(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 dimensions (nil = auto)
(fixed-width :initform nil :initarg :width
:accessor layout-node-fixed-width)
(fixed-height :initform nil :initarg :height
:accessor layout-node-fixed-height)))
#+END_SRC
*** Constructor
#+BEGIN_SRC lisp
(defun make-layout-node (&key direction wrap grow shrink basis
align-items justify-content
padding margin border gap
position-type position-offset
width height)
(make-instance 'layout-node
:direction (or direction :column)
:wrap (or wrap :nowrap)
:grow (or grow 0)
:shrink (or shrink 1)
:basis (or basis :auto)
:align-items (or align-items :stretch)
:justify-content (or justify-content :flex-start)
:padding (normalize-box padding)
:margin (normalize-box margin)
:border (normalize-box border)
:gap gap
:position-type (or position-type :relative)
:position-offset position-offset
:width width
:height height))
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(defun normalize-box (spec) (defun normalize-box (spec)
"Convert a box property spec to ( :top N :right N :bottom N :left N )."
(cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0)) (cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
((numberp spec) (list :top spec :right spec :bottom spec :left spec)) ((numberp spec) (list :top spec :right spec :bottom spec :left spec))
(t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0) (t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0)
for (key val) on spec by #'cddr for (key val) on spec by #'cddr
do (setf (getf result key) val) do (setf (getf result key) val)
finally (return result))))) finally (return result)))))
#+END_SRC
*** Tree Manipulation
#+BEGIN_SRC lisp
(defun layout-node-add-child (parent child)
(setf (slot-value child 'parent) parent)
(push child (slot-value parent 'children))
child)
(defun layout-node-remove-child (parent child)
(setf (slot-value child 'parent) nil)
(setf (slot-value parent 'children)
(delete child (slot-value parent 'children)))
child)
(defun box-edge (box edge) (defun box-edge (box edge)
"Get a specific edge value from a box plist."
(or (getf box edge) 0)) (or (getf box edge) 0))
#+END_SRC #+END_SRC
*** Constraint Solver ** Layout node class
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(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)))
#+END_SRC
** Constructor
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(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))
#+END_SRC
** Tree manipulation
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(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)
(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)
#+END_SRC
** Constraint solver
~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.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(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)))
#+END_SRC
~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.
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(defun compute-layout (root available-width available-height) (defun compute-layout (root available-width available-height)
"Run the layout algorithm on the entire tree." (labels ((place-children (node x y max-w max-h)
(labels (let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row))
((resolve-main-size (node) (pl (box-edge (layout-node-padding node) :left))
;; Get the main-axis size from fixed dimension or basis (pt (box-edge (layout-node-padding node) :top))
(if (eql (layout-node-direction node) :row) (pr (box-edge (layout-node-padding node) :right))
(layout-node-fixed-width node) (pb (box-edge (layout-node-padding node) :bottom))
(layout-node-fixed-height node))) (cw (max 0 (- max-w pl pr)))
(ch (max 0 (- max-h pt pb)))
(resolve-cross-size (node) (gap (layout-node-gap node))
(if (eql (layout-node-direction node) :row) (sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
(layout-node-fixed-height node) (setf (layout-node-x node) (+ x pl)
(layout-node-fixed-width node))) (layout-node-y node) (+ y pt))
(loop :with pos = 0
(compute-node (node x-offset y-offset max-w max-h) :for child :in children
(let* ((dir (layout-node-direction node)) :for size :in sizes
(pad-top (box-edge (layout-node-padding node) :top)) :do (if is-row
(pad-right (box-edge (layout-node-padding node) :right))
(pad-bottom (box-edge (layout-node-padding node) :bottom))
(pad-left (box-edge (layout-node-padding node) :left))
(pad-x (+ pad-left pad-right))
(pad-y (+ pad-top pad-bottom))
(margin-top (box-edge (layout-node-margin node) :top))
(margin-left (box-edge (layout-node-margin node) :left))
(gap (layout-node-gap node))
;; Content area (minus padding)
(content-w (max 0 (- max-w pad-x)))
(content-h (max 0 (- max-h pad-y)))
(children (reverse (layout-node-children node)))
(is-row (eql dir :row))
(main-axis (if is-row :width :height))
(cross-axis (if is-row :height :width))
;; First pass: measure children
(child-count (length children)))
;; Set own position
(setf (layout-node-x node) (+ x-offset margin-left pad-left)
(layout-node-y node) (+ y-offset margin-top pad-top))
(when (plusp child-count)
;; Calculate main-axis sizes
(let* ((fixed-sizes (mapcar (lambda (c)
(or (resolve-main-size c)
(if is-row
(or (layout-node-fixed-width c)
(round content-w child-count))
(or (layout-node-fixed-height c)
(round content-h child-count)))))
children))
(total-fixed (reduce #'+ fixed-sizes))
(total-grow (reduce #'+ (mapcar #'layout-node-grow children)))
(total-shrink (reduce #'+ (mapcar #'layout-node-shrink children)))
(remaining (- (if is-row content-w content-h) total-fixed))
(available-without-gap (if is-row content-w content-h))
(gap-total (* gap (max 0 (1- child-count))))
;; Account for gap in available space
(available (- available-without-gap gap-total))
(overflow (- total-fixed available))
;; Distribute grow/shrink
(final-sizes
(mapcar (lambda (child fixed)
(let* ((g (layout-node-grow child))
(s (layout-node-shrink child))
(size fixed))
(when (and (plusp remaining) (plusp total-grow))
(incf size (round (* remaining (/ g total-grow)))))
(when (and (plusp overflow) (plusp total-shrink))
(decf size (round (* overflow (/ s total-shrink)))))
(max 0 size)))
children fixed-sizes)))
;; Second pass: position children
(let ((pos 0))
(mapc (lambda (child size)
(if is-row
(progn
(setf (layout-node-width child) size (setf (layout-node-width child) size
(layout-node-x child) (+ pad-left x-offset pos) (layout-node-x child) (+ x pl pos)
(layout-node-height child) content-h (layout-node-height child) ch
(layout-node-y child) (+ pad-top y-offset)) (layout-node-y child) (+ y pt))
(compute-node child
(layout-node-x child)
(layout-node-y child)
size content-h))
(progn
(setf (layout-node-height child) size (setf (layout-node-height child) size
(layout-node-y child) (+ pad-top y-offset pos) (layout-node-y child) (+ y pt pos)
(layout-node-width child) content-w (layout-node-width child) cw
(layout-node-x child) (+ pad-left x-offset)) (layout-node-x child) (+ x pl)))
(compute-node child (place-children child
(layout-node-x child) (layout-node-x child)
(layout-node-y child) (layout-node-y child)
content-w size))) (if is-row size cw)
(incf pos (+ size gap))) (if is-row ch size))
children final-sizes)))) (incf pos (+ size gap)))
(let ((last-child (car (last children))))
;; Set own size to content size (if is-row
(let ((last-child (first (last children)))) (setf (layout-node-width node)
(if is-row (or (layout-node-fixed-width node)
(progn (if last-child
(setf (layout-node-width node) (+ (layout-node-x node)
(if (layout-node-fixed-width node) (layout-node-width last-child)
(layout-node-fixed-width node) pr)
(if last-child max-w))
(+ (layout-node-x last-child) (layout-node-height node)
(layout-node-width last-child) max-h)
pad-right margin-left) (setf (layout-node-height node)
max-w))) (or (layout-node-fixed-height node)
(setf (layout-node-height node) max-h)) (if last-child
(progn (let ((last-y (layout-node-y last-child))
(setf (layout-node-height node) (last-h (layout-node-height last-child)))
(if (layout-node-fixed-height node) (+ last-y last-h pb))
(layout-node-fixed-height node) max-h))
(if last-child (layout-node-width node)
(+ (layout-node-y last-child) max-w))))))
(layout-node-height last-child) (place-children root 0 0 available-width available-height)
pad-bottom margin-top)
max-h)))
(setf (layout-node-width node) max-w))))
node))
(compute-node root 0 0 available-width available-height)
root)) root))
#+END_SRC #+END_SRC
*** Composable Macros ** Composable macros
#+BEGIN_SRC lisp #+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(defmacro vbox ((&key grow shrink basis align-items justify-content (defmacro vbox ((&key grow shrink padding margin gap width height) &body children)
padding margin border gap width height) (let ((n (gensym)))
&body children) `(let ((,n (make-layout-node :direction :column
"Create a vertical column container." ,@(when grow `(:grow ,grow))
(let ((node (gensym))) ,@(when shrink `(:shrink ,shrink))
`(let ((,node (make-layout-node ,@(when padding `(:padding ,padding))
:direction :column ,@(when margin `(:margin ,margin))
,@(when grow `(:grow ,grow)) ,@(when gap `(:gap ,gap))
,@(when shrink `(:shrink ,shrink)) ,@(when width `(:width ,width))
,@(when basis `(:basis ,basis)) ,@(when height `(:height ,height)))))
,@(when align-items `(:align-items ,align-items)) ,@(loop for c in children collect `(layout-node-add-child ,n ,c))
,@(when justify-content `(:justify-content ,justify-content)) ,n)))
,@(when padding `(:padding ,padding))
,@(when margin `(:margin ,margin))
,@(when border `(:border ,border))
,@(when gap `(:gap ,gap))
,@(when width `(:width ,width))
,@(when height `(:height ,height)))))
,@(loop for child in children collect
`(layout-node-add-child ,node ,child))
,node)))
(defmacro hbox ((&key grow shrink basis align-items justify-content (defmacro hbox ((&key grow shrink padding margin gap width height) &body children)
padding margin border gap width height) (let ((n (gensym)))
&body children) `(let ((,n (make-layout-node :direction :row
"Create a horizontal row container." ,@(when grow `(:grow ,grow))
(let ((node (gensym))) ,@(when shrink `(:shrink ,shrink))
`(let ((,node (make-layout-node ,@(when padding `(:padding ,padding))
:direction :row ,@(when margin `(:margin ,margin))
,@(when grow `(:grow ,grow)) ,@(when gap `(:gap ,gap))
,@(when shrink `(:shrink ,shrink)) ,@(when width `(:width ,width))
,@(when basis `(:basis ,basis)) ,@(when height `(:height ,height)))))
,@(when align-items `(:align-items ,align-items)) ,@(loop for c in children collect `(layout-node-add-child ,n ,c))
,@(when justify-content `(:justify-content ,justify-content)) ,n)))
,@(when padding `(:padding ,padding))
,@(when margin `(:margin ,margin))
,@(when border `(:border ,border))
,@(when gap `(:gap ,gap))
,@(when width `(:width ,width))
,@(when height `(:height ,height)))))
,@(loop for child in children collect
`(layout-node-add-child ,node ,child))
,node)))
(defmacro spacer (&key grow) (defmacro spacer (&key grow)
"Create an empty flex spacer."
`(make-layout-node :grow ,(or grow 1))) `(make-layout-node :grow ,(or grow 1)))
#+END_SRC #+END_SRC

21
src/layout/layout.lisp
View File

@@ -1,5 +1,3 @@
;;; layout — Pure CL Flexbox layout engine
(defpackage :cl-tty.layout (defpackage :cl-tty.layout
(:use :cl) (:use :cl)
(:export (:export
@@ -15,7 +13,6 @@
#:layout-node-parent #:layout-node-fixed-width #:layout-node-parent #:layout-node-fixed-width
#:layout-node-fixed-height #:normalize-box #:layout-node-fixed-height #:normalize-box
#:box-edge)) #:box-edge))
(in-package :cl-tty.layout) (in-package :cl-tty.layout)
(defun normalize-box (spec) (defun normalize-box (spec)
@@ -70,14 +67,7 @@
(delete child (layout-node-children parent))) (delete child (layout-node-children parent)))
child) child)
;; ── Solver ─────────────────────────────────────────────────────
(defun distribute-sizes (children avail gap horizontal) (defun distribute-sizes (children avail gap horizontal)
"Compute child sizes given available space and gap.
HORIZONTAL is non-nil when distributing width (row layout).
Each child starts from its fixed size (if any). Remaining space
is distributed by grow ratio; overflow is reduced by shrink ratio.
Rounding errors are amortized across the first N children."
(let* ((n (length children)) (let* ((n (length children))
(gap-total (* gap (max 0 (1- n)))) (gap-total (* gap (max 0 (1- n))))
(base (mapcar (lambda (c) (base (mapcar (lambda (c)
@@ -98,10 +88,6 @@ Rounding errors are amortized across the first N children."
(decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total))))) (decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
(max 1 sz))) (max 1 sz)))
children base))) children base)))
;; Distribute rounding remainder to first N children so that
;; the total of sizes exactly fills avail minus gap-total.
;; Only correct when grow or shrink was actually applied —
;; otherwise children keep their fixed sizes and may not fill space.
(when (or (and (plusp remaining) (plusp grow-total)) (when (or (and (plusp remaining) (plusp grow-total))
(and (minusp remaining) (plusp shrink-total))) (and (minusp remaining) (plusp shrink-total)))
(let ((delta (- avail gap-total (reduce #'+ sizes)))) (let ((delta (- avail gap-total (reduce #'+ sizes))))
@@ -111,8 +97,6 @@ Rounding errors are amortized across the first N children."
sizes))) sizes)))
(defun compute-layout (root available-width available-height) (defun compute-layout (root available-width available-height)
"Layout all children of ROOT within the given dimensions.
Recursively computes position and size for every node."
(labels ((place-children (node x y max-w max-h) (labels ((place-children (node x y max-w max-h)
(let* ((children (layout-node-children node)) (let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row)) (is-row (eql (layout-node-direction node) :row))
@@ -124,10 +108,8 @@ Recursively computes position and size for every node."
(ch (max 0 (- max-h pt pb))) (ch (max 0 (- max-h pt pb)))
(gap (layout-node-gap node)) (gap (layout-node-gap node))
(sizes (distribute-sizes children (if is-row cw ch) gap is-row))) (sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
;; Position the node (content area starts at padding inset)
(setf (layout-node-x node) (+ x pl) (setf (layout-node-x node) (+ x pl)
(layout-node-y node) (+ y pt)) (layout-node-y node) (+ y pt))
;; Place each child sequentially
(loop :with pos = 0 (loop :with pos = 0
:for child :in children :for child :in children
:for size :in sizes :for size :in sizes
@@ -146,7 +128,6 @@ Recursively computes position and size for every node."
(if is-row size cw) (if is-row size cw)
(if is-row ch size)) (if is-row ch size))
(incf pos (+ size gap))) (incf pos (+ size gap)))
;; Compute own size from children
(let ((last-child (car (last children)))) (let ((last-child (car (last children))))
(if is-row (if is-row
(setf (layout-node-width node) (setf (layout-node-width node)
@@ -170,8 +151,6 @@ Recursively computes position and size for every node."
(place-children root 0 0 available-width available-height) (place-children root 0 0 available-width available-height)
root)) root))
;; ── Macros ─────────────────────────────────────────────────────
(defmacro vbox ((&key grow shrink padding margin gap width height) &body children) (defmacro vbox ((&key grow shrink padding margin gap width height) &body children)
(let ((n (gensym))) (let ((n (gensym)))
`(let ((,n (make-layout-node :direction :column `(let ((,n (make-layout-node :direction :column

12
src/layout/tests.lisp
View File

@@ -122,14 +122,12 @@
;; ── Edge Cases ──────────────────────────────────────────────── ;; ── Edge Cases ────────────────────────────────────────────────
(test empty-container-does-not-crash (test empty-container-does-not-crash
"compute-layout on a node with no children should not error"
(let ((r (make-layout-node))) (let ((r (make-layout-node)))
(compute-layout r 20 20) (compute-layout r 20 20)
(is (integerp (layout-node-width r))) (is (integerp (layout-node-width r)))
(is (integerp (layout-node-height r))))) (is (integerp (layout-node-height r)))))
(test single-child-in-column (test single-child-in-column
"A column with one child places it correctly"
(let* ((r (make-layout-node :direction :column :width 10 :height 20)) (let* ((r (make-layout-node :direction :column :width 10 :height 20))
(c (make-layout-node :height 5))) (c (make-layout-node :height 5)))
(layout-node-add-child r c) (layout-node-add-child r c)
@@ -138,7 +136,6 @@
(is (= (layout-node-height c) 5)))) (is (= (layout-node-height c) 5))))
(test zero-size-container (test zero-size-container
"compute-layout with zero available space should not error"
(let* ((r (make-layout-node :direction :column)) (let* ((r (make-layout-node :direction :column))
(c (make-layout-node :height 5))) (c (make-layout-node :height 5)))
(layout-node-add-child r c) (layout-node-add-child r c)
@@ -147,17 +144,15 @@
(is (integerp (layout-node-y c))))) (is (integerp (layout-node-y c)))))
(test deep-nesting-three-levels (test deep-nesting-three-levels
"Three-level deep nesting produces correct leaf positions" (let* ((out (vbox ()
(let* ((out (vbox () ; outer box (vbox (:grow 1)
(vbox (:grow 1) ; middle box (make-layout-node :height 2))))
(make-layout-node :height 2)))) ; leaf
(leaf (elt (layout-node-children (leaf (elt (layout-node-children
(elt (layout-node-children out) 0)) 0))) (elt (layout-node-children out) 0)) 0)))
(compute-layout out 20 20) (compute-layout out 20 20)
(is (= (layout-node-y leaf) 0)))) (is (= (layout-node-y leaf) 0))))
(test large-padding-leaves-room (test large-padding-leaves-room
"Large padding reduces content area but doesn't crash"
(let* ((r (make-layout-node :direction :column (let* ((r (make-layout-node :direction :column
:padding '(:top 5 :left 5 :bottom 5 :right 5))) :padding '(:top 5 :left 5 :bottom 5 :right 5)))
(c (make-layout-node :height 3))) (c (make-layout-node :height 3)))
@@ -167,7 +162,6 @@
(is (= (layout-node-y c) 5)))) (is (= (layout-node-y c) 5))))
(test negative-grow-is-clamped (test negative-grow-is-clamped
"Grow values are adjusted but still compute"
(let* ((r (make-layout-node :direction :row :width 10)) (let* ((r (make-layout-node :direction :row :width 10))
(c (make-layout-node :width 5 :grow -1))) (c (make-layout-node :width 5 :grow -1)))
(layout-node-add-child r c) (layout-node-add-child r c)