v0.0.3: layout engine — pure CL Flexbox constraint solver and push

This commit is contained in:
Hermes
2026-05-11 13:12:35 +00:00
parent 0397d1de2c
commit 5e17e3d509
3 changed files with 880 additions and 0 deletions

169
layout/layout.lisp Normal file
View File

@@ -0,0 +1,169 @@
;;; layout — Pure CL Flexbox layout engine
(defpackage :cl-tui.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-tui.layout)
(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 '(:top 0 :right 0 :bottom 0 :left 0) :initarg :padding :accessor layout-node-padding)
(margin :initform '(: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)))
(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 gap
:position-type (or position-type :relative)
:position-offset position-offset
:width width :height height))
(defun normalize-box (spec)
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec))
((getf spec :top) spec)
(t '(:top 0 :right 0 :bottom 0 :left 0))))
(defun box-edge (box edge)
(or (getf box edge) 0))
(defun layout-node-add-child (parent child)
(setf (layout-node-parent child) parent)
(push child (layout-node-children parent))
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)
;; ── Solver ─────────────────────────────────────────────────────
(defun distribute-sizes (children avail gap)
"Compute child sizes given available space and gap."
(let* ((n (length children))
(default-size (if (zerop n) 0 (round avail n)))
(gap-total (* gap (max 0 (1- n))))
(sizes (mapcar (lambda (c)
(or (if (eql (layout-node-direction c) :row)
(layout-node-fixed-width c)
(layout-node-fixed-height c))
default-size))
children))
(total (reduce #'+ sizes))
(remaining (- total (- avail gap-total)))
(grow-total (reduce #'+ (mapcar #'layout-node-grow children)))
(shrink-total (reduce #'+ (mapcar #'layout-node-shrink children))))
(mapcar (lambda (c sz)
(let ((g (layout-node-grow c))
(s (layout-node-shrink c))
(size sz))
(when (and (plusp remaining) (plusp grow-total))
(incf size (round (* remaining (/ g grow-total)))))
(when (and (minusp remaining) (plusp shrink-total))
(decf size (round (* (abs remaining) (/ s shrink-total)))))
(max 1 size)))
children sizes)))
(defun compute-layout (root available-width available-height)
(labels ((place-children (node x y max-w max-h)
(let* ((children (reverse (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)))
(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 (car (last children))))
(if is-row
(setf (layout-node-width node)
(or (layout-node-fixed-width node)
(if last (+ (layout-node-x node) (layout-node-width last) (box-edge (layout-node-padding node) :right)) max-w))
(layout-node-height node) max-h)
(setf (layout-node-height node)
(or (layout-node-fixed-height node)
(if last (+ (layout-node-y node) (layout-node-height last) (box-edge (layout-node-padding node) :bottom)) max-h))
(layout-node-width node) max-w)))))
(place-children root 0 0 available-width available-height)
root))
;; ── Macros ─────────────────────────────────────────────────────
(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)))
(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)))
(defmacro spacer (&key grow)
`(make-layout-node :grow ,(or grow 1)))

120
layout/tests.lisp Normal file
View File

@@ -0,0 +1,120 @@
(defpackage :cl-tui-layout-test
(:use :cl :fiveam :cl-tui.layout)
(:export #:run-tests))
(in-package :cl-tui-layout-test)
(def-suite layout-suite :description "Layout engine tests")
(in-suite layout-suite)
(defun run-tests ()
(let ((result (run 'layout-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
(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-row
(let ((n (make-layout-node :direction :row)))
(is (eql (layout-node-direction n) :row))))
(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
(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-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-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-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
(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
(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
(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
(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
(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
(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
(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
(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)))))

591
org/layout-engine.org Normal file
View File

@@ -0,0 +1,591 @@
#+TITLE: cl-tui Layout Engine — v0.0.3
#+STARTUP: content
#+FILETAGS: :cl-tui:layout:v0.0.3:
#+OPTIONS: ^:nil
* Layout Engine
Pure Common Lisp Flexbox layout engine. No Yoga, no CFFI, no external
dependencies. A two-pass constraint solver that handles direction, wrap,
grow/shrink, and absolute positioning. Terminal resolution (~200x80)
means a full Yoga FFI binding is unnecessary — ~200 lines of CL math.
** Contract
*** Layout Node
- =(make-layout-node &key direction wrap grow shrink basis
align-items justify-content padding margin border gap
position-type position-offset width height)= → layout-node
Create a layout node with the given properties.
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
- =(layout-node-add-child parent child)= → child
Add CHILD as the last child of PARENT. Sets child's parent.
- =(layout-node-remove-child parent child)= → child
Remove CHILD from PARENT's children list.
- =(layout-node-children node)= → list
Return list of child nodes.
*** Layout Calculation
- =(compute-layout root available-width available-height)= → root
Run the layout algorithm on the entire tree. Populates each node's
computed =:x=, =:y=, =:width=, =:height= slots.
Algorithm:
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-tui-layout-test
(:use :cl :fiveam :cl-tui.layout)
(:export #:run-tests))
(in-package :cl-tui-layout-test)
(def-suite layout-suite :description "Layout engine tests")
(in-suite layout-suite)
(defun run-tests ()
(let ((result (run 'layout-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
;; ── Node Creation ──────────────────────────────────────────────
(test make-layout-node-defaults
"make-layout-node creates a node with default values"
(let ((n (make-layout-node)))
(is (typep n 'layout-node))
(is (eql (layout-node-direction n) :column))))
(test make-layout-node-row
"make-layout-node with :row direction"
(let ((n (make-layout-node :direction :row)))
(is (eql (layout-node-direction n) :row))))
;; ── Tree Building ──────────────────────────────────────────────
(test add-child-sets-parent
"layout-node-add-child sets parent on child"
(let ((parent (make-layout-node))
(child (make-layout-node)))
(layout-node-add-child parent child)
(is (eql (slot-value child 'parent) parent))
(is (= (length (slot-value parent 'children)) 1))))
(test remove-child-clears-parent
"layout-node-remove-child clears parent slot"
(let ((parent (make-layout-node))
(child (make-layout-node)))
(layout-node-add-child parent child)
(layout-node-remove-child parent child)
(is (null (slot-value child 'parent)))
(is (= (length (slot-value parent 'children)) 0))))
;; ── Simple Layout — Column ─────────────────────────────────────
(test column-two-children-vertical
"column stacks children vertically"
(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-two-children-horizontal
"row places children side by side"
(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))))
;; ── Flex Grow ──────────────────────────────────────────────────
(test flex-grow-distributes-space
"flex-grow distributes remaining space proportionally"
(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)
;; total fixed = 8, available = 12, c1 gets 4, c2 gets 8
(is (= (layout-node-width c1) 8))
(is (= (layout-node-width c2) 12))))
(test flex-grow-single-child
"single child with flex-grow fills remaining space"
(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))))
;; ── Flex Shrink ────────────────────────────────────────────────
(test flex-shrink-reduces-overflow
"flex-shrink reduces children when content overflows"
(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)
;; Total = 16, available = 10, overflow = 6, each shrinks by 3
(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
"padding reduces available area for children"
(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))
;; content height = 10 - 2 = 8, child height = 3
(is (= (layout-node-height c) 3))))
;; ── Gap ────────────────────────────────────────────────────────
(test gap-between-children
"gap adds spacing 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)))) ; 3 + 2 gap
;; ── Composable Macros ──────────────────────────────────────────
(test vbox-macro
"vbox creates a column container with children"
(let* ((root (vbox () (make-layout-node :height 3) (make-layout-node :height 5))))
(compute-layout root 20 20)
(is (= (length (layout-node-children root)) 2))
(is (= (layout-node-y (elt (layout-node-children root) 1)) 3))))
(test hbox-macro
"hbox creates a row container with children"
(let* ((root (hbox () (make-layout-node :width 5) (make-layout-node :width 3))))
(compute-layout root 20 10)
(is (= (length (layout-node-children root)) 2))
(is (= (layout-node-x (elt (layout-node-children root) 1)) 5))))
(test spacer-takes-grow
"spacer with grow fills remaining space"
(let* ((root (hbox (:width 20)
(make-layout-node :width 5)
(spacer :grow 1)
(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
"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)))
(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 main) 20))
;; sidebar children positioned correctly
(let ((sidebar-children (layout-node-children sidebar)))
(is (= (layout-node-y (elt sidebar-children 0)) 0))
(is (= (layout-node-y (elt sidebar-children 1)) 3)))))
#+END_SRC
** Implementation
*** Package
#+BEGIN_SRC lisp
(defpackage :cl-tui.layout
(:use :cl)
(:export
;; Classes
#:layout-node
;; Construction
#:make-layout-node
;; Tree manipulation
#:layout-node-add-child #:layout-node-remove-child
#:layout-node-children
;; Computed values
#:layout-node-x #:layout-node-y
#:layout-node-width #:layout-node-height
#:layout-node-direction
;; Layout
#:compute-layout
;; Macros
#:vbox #:hbox #:spacer))
(in-package :cl-tui.layout)
#+END_SRC
*** Layout Node Class
#+BEGIN_SRC lisp
(defclass layout-node ()
;; 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 '(:top 0 :right 0 :bottom 0 :left 0)
:initarg :padding :accessor layout-node-padding)
(margin :initform '(:top 0 :right 0 :bottom 0 :left 0)
:initarg :margin :accessor layout-node-margin)
(border :initform '(: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))
(defun normalize-box (spec)
"Convert a box property spec to ( :top N :right N :bottom N :left N )."
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec))
((getf spec :top) spec)
(t `(:top 0 :right 0 :bottom 0 :left 0))))
#+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)
"Get a specific edge value from a box plist."
(or (getf box edge) 0))
#+END_SRC
*** Constraint Solver
#+BEGIN_SRC lisp
(defun compute-layout (root available-width available-height)
"Run the layout algorithm on the entire tree."
(labels
((resolve-main-size (node)
;; 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)
(if (eql (layout-node-direction node) :row)
(layout-node-fixed-height node)
(layout-node-fixed-width node)))
(compute-node (node x-offset y-offset max-w max-h)
(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
(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
(layout-node-x child) (+ pad-left x-offset pos)
(layout-node-height child) content-h
(layout-node-y child) (+ pad-top y-offset))
(compute-node child
(layout-node-x child)
(layout-node-y child)
size content-h))
(progn
(setf (layout-node-height child) size
(layout-node-y child) (+ pad-top y-offset pos)
(layout-node-width child) content-w
(layout-node-x child) (+ pad-left x-offset))
(compute-node child
(layout-node-x child)
(layout-node-y child)
content-w size)))
(incf pos (+ size gap)))
children final-sizes))))
;; Set own size to content size
(let ((last-child (first (last children))))
(if is-row
(progn
(setf (layout-node-width node)
(if (layout-node-fixed-width node)
(layout-node-fixed-width node)
(if last-child
(+ (layout-node-x last-child)
(layout-node-width last-child)
pad-right margin-left)
max-w)))
(setf (layout-node-height node) max-h))
(progn
(setf (layout-node-height node)
(if (layout-node-fixed-height node)
(layout-node-fixed-height node)
(if last-child
(+ (layout-node-y last-child)
(layout-node-height last-child)
pad-bottom margin-top)
max-h)))
(setf (layout-node-width node) max-w))))
node))
(compute-node root 0 0 available-width available-height)
root))
#+END_SRC
*** Composable Macros
#+BEGIN_SRC lisp
(defmacro vbox ((&key grow shrink basis align-items justify-content
padding margin border gap width height)
&body children)
"Create a vertical column container."
(let ((node (gensym)))
`(let ((,node (make-layout-node
:direction :column
,@(when grow `(:grow ,grow))
,@(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 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
padding margin border gap width height)
&body children)
"Create a horizontal row container."
(let ((node (gensym)))
`(let ((,node (make-layout-node
:direction :row
,@(when grow `(:grow ,grow))
,@(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 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)
"Create an empty flex spacer."
`(make-layout-node :grow ,(or grow 1)))
#+END_SRC