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

696
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
(defun compute-layout (root available-width available-height) (defclass layout-node ()
"Run the layout algorithm on the entire tree." ((parent :initform nil :accessor layout-node-parent)
(labels (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
((resolve-main-size (node) ** Constructor
;; Get the main-axis size from fixed dimension or basis
(if (eql (layout-node-direction node) :row)
(layout-node-fixed-width node)
(layout-node-fixed-height node)))
(resolve-cross-size (node) #+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(if (eql (layout-node-direction node) :row) (defun make-layout-node (&key direction grow shrink padding margin gap
(layout-node-fixed-height node) position-type position-offset width height)
(layout-node-fixed-width node))) (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
(compute-node (node x-offset y-offset max-w max-h) ** Tree manipulation
(let* ((dir (layout-node-direction node))
(pad-top (box-edge (layout-node-padding node) :top))
(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 #+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(setf (layout-node-x node) (+ x-offset margin-left pad-left) (defun layout-node-add-child (parent child)
(layout-node-y node) (+ y-offset margin-top pad-top)) (setf (layout-node-parent child) parent)
(setf (layout-node-children parent)
(nconc (layout-node-children parent) (list child)))
child)
(when (plusp child-count) (defun layout-node-remove-child (parent child)
;; Calculate main-axis sizes (setf (layout-node-parent child) nil)
(let* ((fixed-sizes (mapcar (lambda (c) (setf (layout-node-children parent)
(or (resolve-main-size c) (delete child (layout-node-children parent)))
(if is-row child)
(or (layout-node-fixed-width c) #+END_SRC
(round content-w child-count))
(or (layout-node-fixed-height c) ** Constraint solver
(round content-h child-count)))))
~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)) children))
(total-fixed (reduce #'+ fixed-sizes)) (base-total (reduce #'+ base))
(total-grow (reduce #'+ (mapcar #'layout-node-grow children))) (remaining (- avail base-total gap-total))
(total-shrink (reduce #'+ (mapcar #'layout-node-shrink children))) (grow-total (reduce #'+ (mapcar #'layout-node-grow children)))
(remaining (- (if is-row content-w content-h) total-fixed)) (shrink-total (reduce #'+ (mapcar #'layout-node-shrink children))))
(available-without-gap (if is-row content-w content-h)) (let ((sizes (mapcar (lambda (c b)
(gap-total (* gap (max 0 (1- child-count)))) (let ((sz b))
;; Account for gap in available space (when (and (plusp remaining) (plusp grow-total))
(available (- available-without-gap gap-total)) (incf sz (round (* remaining (/ (layout-node-grow c) grow-total)))))
(overflow (- total-fixed available)) (when (and (minusp remaining) (plusp shrink-total))
;; Distribute grow/shrink (decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
(final-sizes (max 1 sz)))
(mapcar (lambda (child fixed) children base)))
(let* ((g (layout-node-grow child)) (when (or (and (plusp remaining) (plusp grow-total))
(s (layout-node-shrink child)) (and (minusp remaining) (plusp shrink-total)))
(size fixed)) (let ((delta (- avail gap-total (reduce #'+ sizes))))
(when (and (plusp remaining) (plusp total-grow)) (when (/= delta 0)
(incf size (round (* remaining (/ g total-grow))))) (loop :for i :from 0 :below (min (abs delta) n)
(when (and (plusp overflow) (plusp total-shrink)) :do (incf (nth i sizes) (signum delta))))))
(decf size (round (* overflow (/ s total-shrink))))) sizes)))
(max 0 size))) #+END_SRC
children fixed-sizes)))
;; Second pass: position children ~compute-layout~ recursively lays out all children of the root node
(let ((pos 0)) within given dimensions. It positions each child at the correct
(mapc (lambda (child size) (x, y) coordinate and sizes it to fill the available space.
(if is-row
(progn #+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
(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 (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)
(if is-row ch size))
(incf pos (+ size gap))) (incf pos (+ size gap)))
children final-sizes)))) (let ((last-child (car (last children))))
;; Set own size to content size
(let ((last-child (first (last children))))
(if is-row (if is-row
(progn
(setf (layout-node-width node) (setf (layout-node-width node)
(if (layout-node-fixed-width node) (or (layout-node-fixed-width node)
(layout-node-fixed-width node)
(if last-child (if last-child
(+ (layout-node-x last-child) (+ (layout-node-x node)
(layout-node-width last-child) (layout-node-width last-child)
pad-right margin-left) pr)
max-w))) max-w))
(setf (layout-node-height node) max-h)) (layout-node-height node)
(progn max-h)
(setf (layout-node-height node) (setf (layout-node-height node)
(if (layout-node-fixed-height node) (or (layout-node-fixed-height node)
(layout-node-fixed-height node)
(if last-child (if last-child
(+ (layout-node-y last-child) (let ((last-y (layout-node-y last-child))
(layout-node-height last-child) (last-h (layout-node-height last-child)))
pad-bottom margin-top) (+ last-y last-h pb))
max-h))) max-h))
(setf (layout-node-width node) max-w)))) (layout-node-width node)
max-w))))))
node)) (place-children root 0 0 available-width available-height)
(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."
(let ((node (gensym)))
`(let ((,node (make-layout-node
:direction :column
,@(when grow `(:grow ,grow)) ,@(when grow `(:grow ,grow))
,@(when shrink `(:shrink ,shrink)) ,@(when shrink `(:shrink ,shrink))
,@(when basis `(:basis ,basis))
,@(when align-items `(:align-items ,align-items))
,@(when justify-content `(:justify-content ,justify-content))
,@(when padding `(:padding ,padding)) ,@(when padding `(:padding ,padding))
,@(when margin `(:margin ,margin)) ,@(when margin `(:margin ,margin))
,@(when border `(:border ,border))
,@(when gap `(:gap ,gap)) ,@(when gap `(:gap ,gap))
,@(when width `(:width ,width)) ,@(when width `(:width ,width))
,@(when height `(:height ,height))))) ,@(when height `(:height ,height)))))
,@(loop for child in children collect ,@(loop for c in children collect `(layout-node-add-child ,n ,c))
`(layout-node-add-child ,node ,child)) ,n)))
,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."
(let ((node (gensym)))
`(let ((,node (make-layout-node
:direction :row
,@(when grow `(:grow ,grow)) ,@(when grow `(:grow ,grow))
,@(when shrink `(:shrink ,shrink)) ,@(when shrink `(:shrink ,shrink))
,@(when basis `(:basis ,basis))
,@(when align-items `(:align-items ,align-items))
,@(when justify-content `(:justify-content ,justify-content))
,@(when padding `(:padding ,padding)) ,@(when padding `(:padding ,padding))
,@(when margin `(:margin ,margin)) ,@(when margin `(:margin ,margin))
,@(when border `(:border ,border))
,@(when gap `(:gap ,gap)) ,@(when gap `(:gap ,gap))
,@(when width `(:width ,width)) ,@(when width `(:width ,width))
,@(when height `(:height ,height))))) ,@(when height `(:height ,height)))))
,@(loop for child in children collect ,@(loop for c in children collect `(layout-node-add-child ,n ,c))
`(layout-node-add-child ,node ,child)) ,n)))
,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)