170 lines
8.0 KiB
Common Lisp
170 lines
8.0 KiB
Common Lisp
;;; layout — Pure CL Flexbox layout engine
|
|
|
|
(defpackage :cl-tui.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-tui.layout)
|
|
|
|
(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 '(:top 0 :right 0 :bottom 0 :left 0) :initarg :padding :accessor layout-node-padding)
|
|
(margin :initform '(: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 gap
|
|
: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))
|
|
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)
|
|
"Compute child sizes given available space and gap."
|
|
(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)))
|
|
(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))
|
|
(when (and (plusp remaining) (plusp grow-total))
|
|
(incf size (round (* remaining (/ g grow-total)))))
|
|
(when (and (minusp remaining) (plusp shrink-total))
|
|
(decf size (round (* (abs remaining) (/ s shrink-total)))))
|
|
(max 1 size)))
|
|
children sizes)))
|
|
|
|
(defun compute-layout (root available-width available-height)
|
|
(labels ((place-children (node x y max-w max-h)
|
|
(let* ((children (reverse (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)))
|
|
(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))))
|
|
(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)
|
|
(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)))))
|
|
(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)))
|