From 5e17e3d5091b3bead2b3995292b25c0cce1c1c45 Mon Sep 17 00:00:00 2001 From: Hermes Date: Mon, 11 May 2026 13:12:35 +0000 Subject: [PATCH] =?UTF-8?q?v0.0.3:=20layout=20engine=20=E2=80=94=20pure=20?= =?UTF-8?q?CL=20Flexbox=20constraint=20solver=20and=20push?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- layout/layout.lisp | 169 ++++++++++++ layout/tests.lisp | 120 +++++++++ org/layout-engine.org | 591 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 880 insertions(+) create mode 100644 layout/layout.lisp create mode 100644 layout/tests.lisp create mode 100644 org/layout-engine.org diff --git a/layout/layout.lisp b/layout/layout.lisp new file mode 100644 index 0000000..7499eba --- /dev/null +++ b/layout/layout.lisp @@ -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))) diff --git a/layout/tests.lisp b/layout/tests.lisp new file mode 100644 index 0000000..80b1065 --- /dev/null +++ b/layout/tests.lisp @@ -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))))) diff --git a/org/layout-engine.org b/org/layout-engine.org new file mode 100644 index 0000000..d68b814 --- /dev/null +++ b/org/layout-engine.org @@ -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