amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
6e73c3bb1959ab59887e8abcbdf516b3f768859b
cl-tty/org/layout-engine.org
Hermes b7df68c436 v0.12.0: Terminal capability detection, GPL 3.0 license, roadmap rewrite 
LICENSE:
- Added GNU General Public License v3.0
- Updated README.org to reflect GPL 3.0

ROADMAP:
- Complete rewrite to reflect actual project state
- Removed croatoan/ncurses/Yoga FFI references
- Marked all 11 existing versions DONE
- Added v0.12.0-0.14.0 for new features (detection, pipeline, mouse)

DETECTION (v0.12.0):
- detect-backend: auto-detect modern vs simple backend
- detect-backend-by-env: check COLORTERM env var
- detect-backend-by-tty: check interactive-stream-p
- detect-backend-by-da1: query terminal via ESC[c (best-effort)
- *detected-backend* cache for zero-cost subsequent calls
- Added detection.lisp to ASDF and package exports
- Added 2 new tests (360 total, all passing)
- demo.lisp updated to use detect-backend

ORG BACKPORT (pre-existing fixes synced):
- dialog.org: render-dialog/render-toast fixes, class initforms
- scrollbox-tabbar.org: background-element -> bright-black, remove duplicate render
- select.org: remove duplicate render export
- text-input.org: remove duplicate %split-string, undo overflow fix
- layout-engine.org: quoted-literal -> list constructors, normalize-box rewrite
- mouse.org: add missing exports, fix test
2026-05-11 22:25:42 +00:00

594 lines
24 KiB
Org Mode
Raw Blame History

#+TITLE: cl-tty Layout Engine — v0.0.3
#+STARTUP: content
#+FILETAGS: :cl-tty: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-tty-layout-test
(:use :cl :fiveam :cl-tty.layout)
(:export #:run-tests))
(in-package :cl-tty-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-tty.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-tty.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 (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :padding :accessor layout-node-padding)
(margin :initform (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :margin :accessor layout-node-margin)
(border :initform (list :top 0 :right 0 :bottom 0 :left 0)
:initarg :border :accessor layout-node-border)
(gap :initform 0 :initarg :gap :accessor layout-node-gap)
;; Position
(position-type :initform :relative :initarg :position-type
:accessor layout-node-position-type)
(position-offset :initform nil :initarg :position-offset
:accessor layout-node-position-offset)
;; Fixed dimensions (nil = auto)
(fixed-width :initform nil :initarg :width
:accessor layout-node-fixed-width)
(fixed-height :initform nil :initarg :height
:accessor layout-node-fixed-height)))
#+END_SRC
*** Constructor
#+BEGIN_SRC lisp
(defun make-layout-node (&key direction wrap grow shrink basis
align-items justify-content
padding margin border gap
position-type position-offset
width height)
(make-instance 'layout-node
:direction (or direction :column)
:wrap (or wrap :nowrap)
:grow (or grow 0)
:shrink (or shrink 1)
:basis (or basis :auto)
:align-items (or align-items :stretch)
:justify-content (or justify-content :flex-start)
:padding (normalize-box padding)
:margin (normalize-box margin)
:border (normalize-box border)
:gap gap
:position-type (or position-type :relative)
:position-offset position-offset
:width width
:height height))
(defun normalize-box (spec)
"Convert a box property spec to ( :top N :right N :bottom N :left N )."
(cond ((null spec) (list :top 0 :right 0 :bottom 0 :left 0))
((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
*** 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 View Git Blame Copy Permalink