amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

v0.0.3: layout engine — pure CL Flexbox solver, 35/35 tests GREEN

Browse Source 
Fixes during debugging:
- Variable scope: loop's closing parens closed the let* prematurely,
  making children/is-row/pr/pb undefined in own-size calculation
- gap NIL bug: make-layout-node passed :gap nil (from &key default)
  to make-instance, overriding :initform 0 → (* nil ...) crash
- Child order: push (LIFO) in add-child reversed children order;
  changed to nconc (FIFO), removed the compensating reverse
- Fixed distribute-sizes to base all children from their fixed size
  then apply grow/shrink on top, instead of treating fixed-size
  children as non-participating
This commit is contained in:
Hermes
2026-05-11 13:39:26 +00:00
parent 5e17e3d509
commit 2231fb6647
1 changed files with 71 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

123
layout/layout.lisp
View File

@@ -18,6 +18,15 @@
(in-package :cl-tui.layout) (in-package :cl-tui.layout)
(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))
(defclass layout-node () (defclass layout-node ()
((parent :initform nil :accessor layout-node-parent) ((parent :initform nil :accessor layout-node-parent)
(children :initform nil :accessor layout-node-children) (children :initform nil :accessor layout-node-children)
@@ -42,23 +51,15 @@
:direction (or direction :column) :direction (or direction :column)
:grow (or grow 0) :shrink (or shrink 1) :grow (or grow 0) :shrink (or shrink 1)
:padding (normalize-box padding) :margin (normalize-box margin) :padding (normalize-box padding) :margin (normalize-box margin)
:gap gap :gap (or gap 0)
:position-type (or position-type :relative) :position-type (or position-type :relative)
:position-offset position-offset :position-offset position-offset
:width width :height height)) :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) (defun layout-node-add-child (parent child)
(setf (layout-node-parent child) parent) (setf (layout-node-parent child) parent)
(push child (layout-node-children parent)) (setf (layout-node-children parent)
(nconc (layout-node-children parent) (list child)))
child) child)
(defun layout-node-remove-child (parent child) (defun layout-node-remove-child (parent child)
@@ -69,35 +70,37 @@
;; ── Solver ───────────────────────────────────────────────────── ;; ── Solver ─────────────────────────────────────────────────────
(defun distribute-sizes (children avail gap) (defun distribute-sizes (children avail gap horizontal)
"Compute child sizes given available space and gap." "Compute child sizes given available space and gap.
HORIZONTAL is non-nil when distributing width (row layout).
Each child starts from its fixed size (if any). Remaining space
is distributed by grow ratio; overflow is reduced by shrink ratio."
(let* ((n (length children)) (let* ((n (length children))
(default-size (if (zerop n) 0 (round avail n)))
(gap-total (* gap (max 0 (1- n)))) (gap-total (* gap (max 0 (1- n))))
(sizes (mapcar (lambda (c) (base (mapcar (lambda (c)
(or (if (eql (layout-node-direction c) :row) (or (if horizontal
(layout-node-fixed-width c) (layout-node-fixed-width c)
(layout-node-fixed-height c)) (layout-node-fixed-height c))
default-size)) 0))
children)) children))
(total (reduce #'+ sizes)) (base-total (reduce #'+ base))
(remaining (- total (- avail gap-total))) (remaining (- avail base-total gap-total))
(grow-total (reduce #'+ (mapcar #'layout-node-grow children))) (grow-total (reduce #'+ (mapcar #'layout-node-grow children)))
(shrink-total (reduce #'+ (mapcar #'layout-node-shrink children)))) (shrink-total (reduce #'+ (mapcar #'layout-node-shrink children))))
(mapcar (lambda (c sz) (mapcar (lambda (c b)
(let ((g (layout-node-grow c)) (let ((sz b))
(s (layout-node-shrink c))
(size sz))
(when (and (plusp remaining) (plusp grow-total)) (when (and (plusp remaining) (plusp grow-total))
(incf size (round (* remaining (/ g grow-total))))) (incf sz (round (* remaining (/ (layout-node-grow c) grow-total)))))
(when (and (minusp remaining) (plusp shrink-total)) (when (and (minusp remaining) (plusp shrink-total))
(decf size (round (* (abs remaining) (/ s shrink-total))))) (decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
(max 1 size))) (max 1 sz)))
children sizes))) children base)))
(defun compute-layout (root available-width available-height) (defun compute-layout (root available-width available-height)
"Layout all children of ROOT within the given dimensions.
Recursively computes position and size for every node."
(labels ((place-children (node x y max-w max-h) (labels ((place-children (node x y max-w max-h)
(let* ((children (reverse (layout-node-children node))) (let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row)) (is-row (eql (layout-node-direction node) :row))
(pl (box-edge (layout-node-padding node) :left)) (pl (box-edge (layout-node-padding node) :left))
(pt (box-edge (layout-node-padding node) :top)) (pt (box-edge (layout-node-padding node) :top))
@@ -106,34 +109,50 @@
(cw (max 0 (- max-w pl pr))) (cw (max 0 (- max-w pl pr)))
(ch (max 0 (- max-h pt pb))) (ch (max 0 (- max-h pt pb)))
(gap (layout-node-gap node)) (gap (layout-node-gap node))
(sizes (distribute-sizes children (if is-row cw ch) gap))) (sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
;; Position the node (content area starts at padding inset)
(setf (layout-node-x node) (+ x pl) (setf (layout-node-x node) (+ x pl)
(layout-node-y node) (+ y pt)) (layout-node-y node) (+ y pt))
(loop with pos = 0 ;; Place each child sequentially
for child in children (loop :with pos = 0
for size in sizes :for child :in children
do (if is-row :for size :in sizes
(setf (layout-node-width child) size :do (if is-row
(layout-node-x child) (+ x pl pos) (setf (layout-node-width child) size
(layout-node-height child) ch (layout-node-x child) (+ x pl pos)
(layout-node-y child) (+ y pt)) (layout-node-height child) ch
(setf (layout-node-height child) size (layout-node-y child) (+ y pt))
(layout-node-y child) (+ y pt pos) (setf (layout-node-height child) size
(layout-node-width child) cw (layout-node-y child) (+ y pt pos)
(layout-node-x child) (+ x pl))) (layout-node-width child) cw
(place-children child (layout-node-x child) (layout-node-y child) (layout-node-x child) (+ x pl)))
(if is-row size cw) (if is-row ch size)) (place-children child
(incf pos (+ size gap)))) (layout-node-x child)
(let ((last (car (last children)))) (layout-node-y child)
(if is-row size cw)
(if is-row ch size))
(incf pos (+ size gap)))
;; Compute own size from children
(let ((last-child (car (last children))))
(if is-row (if is-row
(setf (layout-node-width node) (setf (layout-node-width node)
(or (layout-node-fixed-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)) (if last-child
(layout-node-height node) max-h) (+ (layout-node-x node)
(layout-node-width last-child)
pr)
max-w))
(layout-node-height node)
max-h)
(setf (layout-node-height node) (setf (layout-node-height node)
(or (layout-node-fixed-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)) (if last-child
(layout-node-width node) max-w))))) (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) (place-children root 0 0 available-width available-height)
root)) root))