29f99a576d
Every function, defclass, defstruct, defgeneric, defmethod, defmacro, defvar, and defparameter in every org file now has its own #+BEGIN_SRC block with literate prose above it explaining the design reasoning. Block counts before → after: package.org: 1 → 7 container-package.org: 1 → 1 (prose expanded) dirty.org: 4 → 6 render.org: 10 → 25 theme.org: 6 → 19 box-renderable.org: 9 → 29 scrollbox.org: 8 → 26 tabbar.org: 5 → 10 backend-protocol.org: 8 → 66 modern-backend.org: 17 → 53 detection.org: 4 → 6 layout-engine.org: 9 → 36 framebuffer.org: 8 → 37 markdown-renderer.org:13 → 38 dialog.org: 17 → 23 (merged dual structure) mouse.org: 4 → 25 select.org: 12 → 30 slot.org: 4 → 12 text-input.org: 11 → 53 Total: ~153 blocks → ~502 blocks Bugs fixed during restructuring: - render.org: stray π character typo (backenπd → backend) - modern-backend.org: sgr-attr missing closing paren + #+END_SRC - detection.org: invalid #\Esc character reference - select.org: extra closing paren in select-visible-options All 13 test suites pass at 100%.
675 lines
25 KiB
Org Mode
675 lines
25 KiB
Org Mode
#+TITLE: cl-tty Layout Engine
|
|
#+STARTUP: content
|
|
#+FILETAGS: :cl-tty:layout:
|
|
|
|
* Overview
|
|
|
|
Pure Common Lisp Flexbox layout engine. No Yoga, no CFFI, no external
|
|
dependencies. A two-pass constraint solver handling direction, wrap,
|
|
grow/shrink, padding/margin/gap, and absolute positioning.
|
|
|
|
Terminal resolution (~200x80) means a full Yoga FFI binding is
|
|
unnecessary — ~200 lines of CL math suffices.
|
|
|
|
* Contract
|
|
|
|
** Layout Node
|
|
|
|
- ~(make-layout-node &key direction grow shrink padding margin gap
|
|
position-type position-offset width height)~ → layout-node
|
|
- Parent/child tree manipulation: ~layout-node-add-child~, ~layout-node-remove-child~
|
|
- Position/size accessors: ~layout-node-x/y/width/height~
|
|
|
|
** Layout Properties
|
|
|
|
- ~:direction~ — ~:row~ or ~:column~ (default: ~:column~)
|
|
- ~:grow~ — proportional distribution of remaining space (default: 0)
|
|
- ~:shrink~ — proportional reduction when content overflows (default: 1)
|
|
- ~:gap~ — spacing between children
|
|
- ~:padding~ — box padding plist (~:top~, ~:right~, ~:bottom~, ~:left~)
|
|
- ~:position-type~ — ~:relative~ or ~:absolute~
|
|
|
|
** Solver
|
|
|
|
- ~(compute-layout root available-width available-height)~ → root
|
|
Recursively computes position and size for every node.
|
|
|
|
** Macros
|
|
|
|
- ~(vbox (&key grow shrink padding margin gap width height) &body children)~
|
|
- ~(hbox (&key grow shrink padding margin gap width height) &body children)~
|
|
- ~(spacer &key grow)~
|
|
|
|
* Tests
|
|
|
|
** Test package definition
|
|
|
|
The test package uses ~:fiveam~ for the test framework and imports
|
|
all exported symbols from ~cl-tty.layout~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(defpackage :cl-tty-layout-test
|
|
(:use :cl :fiveam :cl-tty.layout)
|
|
(:export #:run-tests))
|
|
(in-package :cl-tty-layout-test)
|
|
#+END_SRC
|
|
|
|
** Test suite
|
|
|
|
~fiveam~ suites collect related tests under a descriptive name for
|
|
batch execution.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(def-suite layout-suite :description "Layout engine tests")
|
|
(in-suite layout-suite)
|
|
#+END_SRC
|
|
|
|
** Test runner
|
|
|
|
~run-tests~ provides a convenient entry point that prints results and
|
|
exits cleanly for CI or batch runs.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(defun run-tests ()
|
|
(let ((result (run 'layout-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
#+END_SRC
|
|
|
|
** Test: make-layout-node defaults
|
|
|
|
Verify that a node created with no arguments has the correct default
|
|
direction ~:column~ and is of type ~layout-node~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test make-layout-node-defaults
|
|
(let ((n (make-layout-node)))
|
|
(is (typep n 'layout-node))
|
|
(is (eql (layout-node-direction n) :column))))
|
|
#+END_SRC
|
|
|
|
** Test: make-layout-node with ~:row~
|
|
|
|
Verify that passing ~:direction :row~ produces a node whose direction
|
|
slot reflects that choice.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test make-layout-node-row
|
|
(let ((n (make-layout-node :direction :row)))
|
|
(is (eql (layout-node-direction n) :row))))
|
|
#+END_SRC
|
|
|
|
** Test: add-child sets parent
|
|
|
|
Children must have their ~parent~ back-pointer set when added, and
|
|
the parent's ~children~ list must contain the child.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: remove-child clears parent
|
|
|
|
Removing a child should clear its parent reference and remove it
|
|
from the parent's ~children~ list.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: column lays out two children vertically
|
|
|
|
In a column layout, children stack top-to-bottom. The first child
|
|
starts at y=0; the second starts below the first.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: row lays out two children horizontally
|
|
|
|
In a row layout, children stack left-to-right. The first child starts
|
|
at x=0; the second starts to the right of the first.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: flex-grow distributes remaining space proportionally
|
|
|
|
When children have different ~grow~ values, remaining space is
|
|
divided in proportion to those values. A child with grow=2 gets
|
|
twice as much extra space as a child with grow=1.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: flex-grow single child fills container
|
|
|
|
A single flexible child with ~grow~ set should expand to fill all
|
|
available space in the container.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: flex-shrink reduces overflow proportionally
|
|
|
|
When children exceed the container size, each child shrinks in
|
|
proportion to its ~shrink~ value.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: padding reduces content area
|
|
|
|
Padding insets the child rendering area. Children are offset by the
|
|
padding values and sized to the remaining space.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: gap between children
|
|
|
|
The ~gap~ property inserts spacing between consecutive children
|
|
without adding space before the first or after the last.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: vbox macro
|
|
|
|
The ~vbox~ macro creates a column-direction container and adds
|
|
children in one expression. The second child's y-offset should be
|
|
the sum of the first child's height plus gap.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: hbox macro
|
|
|
|
The ~hbox~ macro creates a row-direction container. The second
|
|
child's x-offset should equal the first child's width.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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))))
|
|
#+END_SRC
|
|
|
|
** Test: spacer takes grow
|
|
|
|
The ~spacer~ macro creates a flexible node that pushes siblings
|
|
apart. With two fixed-width children and a spacer between them, the
|
|
spacer absorbs all remaining width.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** Test: nested vbox in hbox
|
|
|
|
Nesting a column layout inside a row layout exercises the recursive
|
|
solver. Sidebar gets fixed width; main content stretches.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(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)))))
|
|
#+END_SRC
|
|
|
|
** Test: empty container does not crash
|
|
|
|
Layout must gracefully handle containers with no children, returning
|
|
valid integer dimensions.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test empty-container-does-not-crash
|
|
(let ((r (make-layout-node)))
|
|
(compute-layout r 20 20)
|
|
(is (integerp (layout-node-width r)))
|
|
(is (integerp (layout-node-height r)))))
|
|
#+END_SRC
|
|
|
|
** Test: single child in column
|
|
|
|
A column with one child positions it at the origin and sizes it to
|
|
its requested height. Width is inherited from the container.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test single-child-in-column
|
|
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
|
|
(c (make-layout-node :height 5)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 10 20)
|
|
(is (= (layout-node-y c) 0))
|
|
(is (= (layout-node-height c) 5))))
|
|
#+END_SRC
|
|
|
|
** Test: zero-size container
|
|
|
|
When available space is zero, the solver must still produce valid
|
|
integer coordinates without crashing or producing NaN/infinite values.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test zero-size-container
|
|
(let* ((r (make-layout-node :direction :column))
|
|
(c (make-layout-node :height 5)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 0 0)
|
|
(is (integerp (layout-node-x c)))
|
|
(is (integerp (layout-node-y c)))))
|
|
#+END_SRC
|
|
|
|
** Test: deep nesting three levels
|
|
|
|
Three levels of nested vboxes ensure that layout is computed
|
|
correctly for deeply nested subtrees.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test deep-nesting-three-levels
|
|
(let* ((out (vbox ()
|
|
(vbox (:grow 1)
|
|
(make-layout-node :height 2))))
|
|
(leaf (elt (layout-node-children
|
|
(elt (layout-node-children out) 0)) 0)))
|
|
(compute-layout out 20 20)
|
|
(is (= (layout-node-y leaf) 0))))
|
|
#+END_SRC
|
|
|
|
** Test: large padding leaves room
|
|
|
|
Substantial padding on all sides should offset children inward by the
|
|
full padding amount.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test large-padding-leaves-room
|
|
(let* ((r (make-layout-node :direction :column
|
|
:padding '(:top 5 :left 5 :bottom 5 :right 5)))
|
|
(c (make-layout-node :height 3)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 20 20)
|
|
(is (= (layout-node-x c) 5))
|
|
(is (= (layout-node-y c) 5))))
|
|
#+END_SRC
|
|
|
|
** Test: negative grow is clamped
|
|
|
|
A negative ~grow~ value should not cause layout errors. The solver
|
|
treats it as zero for distribution purposes and produces valid output.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/tests.lisp
|
|
(test negative-grow-is-clamped
|
|
(let* ((r (make-layout-node :direction :row :width 10))
|
|
(c (make-layout-node :width 5 :grow -1)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 10 10)
|
|
(is (integerp (layout-node-width c)))))
|
|
#+END_SRC
|
|
|
|
* Implementation
|
|
|
|
** Package
|
|
|
|
The ~cl-tty.layout~ package exports all public symbols for creating
|
|
and manipulating layout trees. Internal accessors like
|
|
~layout-node-parent~ and helpers like ~normalize-box~ are also
|
|
exported for testing.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defpackage :cl-tty.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-tty.layout)
|
|
#+END_SRC
|
|
|
|
** Box model utilities
|
|
|
|
*** normalize-box
|
|
|
|
~normalize-box~ converts nil, number, or plist inputs to a canonical
|
|
plist. This normalisation layer means users can pass ~:padding 2~ or
|
|
~:padding '(:top 1 :left 2)~ interchangeably throughout the API.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun normalize-box (spec)
|
|
(cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
|
|
((numberp spec) (list :top spec :right spec :bottom spec :left spec))
|
|
(t (loop with result = (list :top 0 :right 0 :bottom 0 :left 0)
|
|
for (key val) on spec by #'cddr
|
|
do (setf (getf result key) val)
|
|
finally (return result)))))
|
|
#+END_SRC
|
|
|
|
*** box-edge
|
|
|
|
~box-edge~ extracts the value for a specific edge keyword from a
|
|
canonical box plist, defaulting to zero if the key is not present.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun box-edge (box edge)
|
|
(or (getf box edge) 0))
|
|
#+END_SRC
|
|
|
|
** Layout node class
|
|
|
|
The ~layout-node~ class holds all properties needed by the flexbox
|
|
layout algorithm. Slots are split between tree structure (~parent~,
|
|
~children~), computed layout results (~x~, ~y~, ~width~, ~height~),
|
|
and input constraints (~direction~, ~grow~, ~shrink~, ~padding~,
|
|
~margin~, ~gap~, ~position-type~, ~position-offset~, ~fixed-width~,
|
|
~fixed-height~).
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defclass layout-node ()
|
|
((parent :initform nil :accessor layout-node-parent)
|
|
(children :initform nil :accessor layout-node-children)
|
|
(x :initform 0 :accessor layout-node-x)
|
|
(y :initform 0 :accessor layout-node-y)
|
|
(width :initform 0 :accessor layout-node-width)
|
|
(height :initform 0 :accessor layout-node-height)
|
|
(direction :initform :column :initarg :direction :accessor layout-node-direction)
|
|
(grow :initform 0 :initarg :grow :accessor layout-node-grow)
|
|
(shrink :initform 1 :initarg :shrink :accessor layout-node-shrink)
|
|
(padding :initform (list :top 0 :right 0 :bottom 0 :left 0) :initarg :padding :accessor layout-node-padding)
|
|
(margin :initform (list :top 0 :right 0 :bottom 0 :left 0) :initarg :margin :accessor layout-node-margin)
|
|
(gap :initform 0 :initarg :gap :accessor layout-node-gap)
|
|
(position-type :initform :relative :initarg :position-type :accessor layout-node-position-type)
|
|
(position-offset :initform nil :initarg :position-offset :accessor layout-node-position-offset)
|
|
(fixed-width :initform nil :initarg :width :accessor layout-node-fixed-width)
|
|
(fixed-height :initform nil :initarg :height :accessor layout-node-fixed-height)))
|
|
#+END_SRC
|
|
|
|
** Constructor
|
|
|
|
~make-layout-node~ is the primary constructor. It normalises all
|
|
keyword arguments through ~normalize-box~ for padding/margin, fills
|
|
defaults for missing values, and delegates to ~make-instance~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun make-layout-node (&key direction grow shrink padding margin gap
|
|
position-type position-offset width height)
|
|
(make-instance 'layout-node
|
|
:direction (or direction :column)
|
|
:grow (or grow 0) :shrink (or shrink 1)
|
|
:padding (normalize-box padding) :margin (normalize-box margin)
|
|
:gap (or gap 0)
|
|
:position-type (or position-type :relative)
|
|
:position-offset position-offset
|
|
:width width :height height))
|
|
#+END_SRC
|
|
|
|
** Tree manipulation
|
|
|
|
*** layout-node-add-child
|
|
|
|
~layout-node-add-child~ attaches a child to a parent by setting the
|
|
child's parent back-pointer and appending to the parent's children
|
|
list. Returns the child for convenience in chaining or ~let~ forms.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun layout-node-add-child (parent child)
|
|
(setf (layout-node-parent child) parent)
|
|
(setf (layout-node-children parent)
|
|
(nconc (layout-node-children parent) (list child)))
|
|
child)
|
|
#+END_SRC
|
|
|
|
*** layout-node-remove-child
|
|
|
|
~layout-node-remove-child~ detaches a child by clearing its parent
|
|
back-pointer and removing it from the parent's children list.
|
|
Returns the child.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun layout-node-remove-child (parent child)
|
|
(setf (layout-node-parent child) nil)
|
|
(setf (layout-node-children parent)
|
|
(delete child (layout-node-children parent)))
|
|
child)
|
|
#+END_SRC
|
|
|
|
** Constraint solver
|
|
|
|
*** distribute-sizes
|
|
|
|
~distribute-sizes~ computes child sizes given available space and
|
|
gap. Each child starts from its fixed size. Remaining space is
|
|
distributed by grow ratio; overflow is reduced by shrink ratio.
|
|
Rounding errors are amortized across the first N children.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun distribute-sizes (children avail gap horizontal)
|
|
(let* ((n (length children))
|
|
(gap-total (* gap (max 0 (1- n))))
|
|
(base (mapcar (lambda (c)
|
|
(or (if horizontal
|
|
(layout-node-fixed-width c)
|
|
(layout-node-fixed-height c))
|
|
0))
|
|
children))
|
|
(base-total (reduce #'+ base))
|
|
(remaining (- avail base-total gap-total))
|
|
(grow-total (reduce #'+ (mapcar #'layout-node-grow children)))
|
|
(shrink-total (reduce #'+ (mapcar #'layout-node-shrink children))))
|
|
(let ((sizes (mapcar (lambda (c b)
|
|
(let ((sz b))
|
|
(when (and (plusp remaining) (plusp grow-total))
|
|
(incf sz (round (* remaining (/ (layout-node-grow c) grow-total)))))
|
|
(when (and (minusp remaining) (plusp shrink-total))
|
|
(decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
|
|
(max 1 sz)))
|
|
children base)))
|
|
(when (or (and (plusp remaining) (plusp grow-total))
|
|
(and (minusp remaining) (plusp shrink-total)))
|
|
(let ((delta (- avail gap-total (reduce #'+ sizes))))
|
|
(when (/= delta 0)
|
|
(loop :for i :from 0 :below (min (abs delta) n)
|
|
:do (incf (nth i sizes) (signum delta))))))
|
|
sizes)))
|
|
#+END_SRC
|
|
|
|
*** compute-layout
|
|
|
|
~compute-layout~ recursively lays out all children of the root node
|
|
within given dimensions. It positions each child at the correct
|
|
(x, y) coordinate and sizes it to fill the available space. The
|
|
inner ~labels~ form ~place-children~ handles the recursive descent,
|
|
adjusting for padding and direction at each level.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defun compute-layout (root available-width available-height)
|
|
(labels ((place-children (node x y max-w max-h)
|
|
(let* ((children (layout-node-children node))
|
|
(is-row (eql (layout-node-direction node) :row))
|
|
(pl (box-edge (layout-node-padding node) :left))
|
|
(pt (box-edge (layout-node-padding node) :top))
|
|
(pr (box-edge (layout-node-padding node) :right))
|
|
(pb (box-edge (layout-node-padding node) :bottom))
|
|
(cw (max 0 (- max-w pl pr)))
|
|
(ch (max 0 (- max-h pt pb)))
|
|
(gap (layout-node-gap node))
|
|
(sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
|
|
(setf (layout-node-x node) (+ x pl)
|
|
(layout-node-y node) (+ y pt))
|
|
(loop :with pos = 0
|
|
:for child :in children
|
|
:for size :in sizes
|
|
:do (if is-row
|
|
(setf (layout-node-width child) size
|
|
(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-child (car (last children))))
|
|
(if is-row
|
|
(setf (layout-node-width node)
|
|
(or (layout-node-fixed-width node)
|
|
(if last-child
|
|
(+ (layout-node-x node)
|
|
(layout-node-width last-child)
|
|
pr)
|
|
max-w))
|
|
(layout-node-height node)
|
|
max-h)
|
|
(setf (layout-node-height node)
|
|
(or (layout-node-fixed-height node)
|
|
(if last-child
|
|
(let ((last-y (layout-node-y last-child))
|
|
(last-h (layout-node-height last-child)))
|
|
(+ last-y last-h pb))
|
|
max-h))
|
|
(layout-node-width node)
|
|
max-w))))))
|
|
(place-children root 0 0 available-width available-height)
|
|
root))
|
|
#+END_SRC
|
|
|
|
** Composable macros
|
|
|
|
*** vbox
|
|
|
|
~vbox~ creates a column-direction container with optional layout
|
|
properties and adds all children via ~layout-node-add-child~. The
|
|
~gensym~ ensures no variable capture in the expansion.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
*** hbox
|
|
|
|
~hbox~ creates a row-direction container, structurally identical to
|
|
~vbox~ except the ~:direction~ is ~:row~.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
*** spacer
|
|
|
|
~spacer~ creates a minimal flex-grow node that fills remaining space,
|
|
defaulting to ~grow 1~ when no keyword is given.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/layout/layout.lisp
|
|
(defmacro spacer (&key grow)
|
|
`(make-layout-node :grow ,(or grow 1)))
|
|
#+END_SRC
|