v0.0.3: layout engine — pure CL Flexbox solver, 35/35 tests GREEN
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
@@ -18,6 +18,15 @@
|
||||
|
||||
(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 ()
|
||||
((parent :initform nil :accessor layout-node-parent)
|
||||
(children :initform nil :accessor layout-node-children)
|
||||
@@ -42,23 +51,15 @@
|
||||
:direction (or direction :column)
|
||||
:grow (or grow 0) :shrink (or shrink 1)
|
||||
:padding (normalize-box padding) :margin (normalize-box margin)
|
||||
:gap gap
|
||||
:gap (or gap 0)
|
||||
: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))
|
||||
(setf (layout-node-children parent)
|
||||
(nconc (layout-node-children parent) (list child)))
|
||||
child)
|
||||
|
||||
(defun layout-node-remove-child (parent child)
|
||||
@@ -69,35 +70,37 @@
|
||||
|
||||
;; ── Solver ─────────────────────────────────────────────────────
|
||||
|
||||
(defun distribute-sizes (children avail gap)
|
||||
"Compute child sizes given available space and gap."
|
||||
(defun distribute-sizes (children avail gap horizontal)
|
||||
"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))
|
||||
(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)))
|
||||
(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))))
|
||||
(mapcar (lambda (c sz)
|
||||
(let ((g (layout-node-grow c))
|
||||
(s (layout-node-shrink c))
|
||||
(size sz))
|
||||
(mapcar (lambda (c b)
|
||||
(let ((sz b))
|
||||
(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))
|
||||
(decf size (round (* (abs remaining) (/ s shrink-total)))))
|
||||
(max 1 size)))
|
||||
children sizes)))
|
||||
(decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
|
||||
(max 1 sz)))
|
||||
children base)))
|
||||
|
||||
(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)
|
||||
(let* ((children (reverse (layout-node-children node)))
|
||||
(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))
|
||||
@@ -106,34 +109,50 @@
|
||||
(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)))
|
||||
(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)
|
||||
(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))))
|
||||
;; Place each child sequentially
|
||||
(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)))
|
||||
;; Compute own size from children
|
||||
(let ((last-child (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)
|
||||
(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 (+ (layout-node-y node) (layout-node-height last) (box-edge (layout-node-padding node) :bottom)) max-h))
|
||||
(layout-node-width node) max-w)))))
|
||||
(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))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user