v0.0.1: Backend Protocol — abstraction layer + simple backend #2
169
layout/layout.lisp
Normal file
169
layout/layout.lisp
Normal 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
120
layout/tests.lisp
Normal 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
591
org/layout-engine.org
Normal 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
|
||||||
Reference in New Issue
Block a user