;;; layout — Pure CL Flexbox layout engine (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) (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))))) (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) (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))) (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)) (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) (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 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. Rounding errors are amortized across the first N children." (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))) ;; Distribute rounding remainder to first N children so that ;; the total of sizes exactly fills avail minus gap-total. ;; Only correct when grow or shrink was actually applied — ;; otherwise children keep their fixed sizes and may not fill space. (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))) (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 (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))) ;; Position the node (content area starts at padding inset) (setf (layout-node-x node) (+ x pl) (layout-node-y node) (+ y pt)) ;; 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-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)) ;; ── 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)))