Amr Gharbeia
56682d0cc2
Layout primitives (org/layout-primitives.org, ~290 lines): - CLOS layout-node class wrapping YGNodeRef with tg:finalize for GC cleanup - 12 setter functions with keyword→integer enum translation - layout-calculate: runs Yoga layout, returns root - 14 tests: dimension, direction, flex-grow, align, justify, padding, margin, absolute position, wrap, gap, nested layout Composable API (org/layout-composable.org, ~200 lines): - vbox/hbox macros: declarative container creation with style props - overlay macro: absolute-positioned child over relative base - spacer function: flex-grow filler - make-props-list helper: extracts plist minus :children - 6 tests: vbox stacking, hbox layout, spacer flex, overlay position, align/justify via vbox, padding offset GREEN: 29/29 pass (59 assertions) - yoga-ffi: 9 tests (22 assertions) - layout-primitives: 14 tests (24 assertions) - layout-composable: 6 tests (13 assertions)
195 lines
7.2 KiB
Common Lisp
195 lines
7.2 KiB
Common Lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :cffi :silent t)
|
|
(ql:quickload :trivial-garbage :silent t))
|
|
|
|
(defpackage :cl-tui.layout-composable
|
|
(:use :cl :cl-tui.layout-primitives)
|
|
(:export
|
|
#:vbox
|
|
#:hbox
|
|
#:overlay
|
|
#:spacer))
|
|
|
|
(in-package :cl-tui.layout-composable)
|
|
|
|
(defun apply-common-props (node &key width height flex-grow flex-shrink flex-basis
|
|
align justify gap padding margin
|
|
&allow-other-keys)
|
|
"Apply the shared style properties to a layout-node."
|
|
(when (or width height)
|
|
(layout-node-set-dimension node (or width 0) (or height 0)))
|
|
(when (or flex-grow flex-shrink flex-basis)
|
|
(layout-node-set-flex node :grow flex-grow :shrink flex-shrink :basis flex-basis))
|
|
(when align
|
|
(apply #'layout-node-set-align node align))
|
|
(when justify
|
|
(layout-node-set-justify node justify))
|
|
(when gap
|
|
(apply #'layout-node-set-gap node gap))
|
|
(when padding
|
|
(apply #'layout-node-set-padding node padding))
|
|
(when margin
|
|
(apply #'layout-node-set-margin node margin)))
|
|
|
|
(defun add-children (parent children)
|
|
"Add each child in CHILDREN to PARENT. Non-node values are skipped."
|
|
(dolist (child children)
|
|
(when (typep child 'layout-node)
|
|
(layout-node-add-child parent child))))
|
|
|
|
(defun make-props-list (args)
|
|
"Extract all properties except :children from ARGS plist."
|
|
(loop for (k v) on args by #'cddr
|
|
unless (eq k :children)
|
|
append (list k v)))
|
|
|
|
(defmacro vbox (&rest args &key children &allow-other-keys)
|
|
"Create a column-direction container with CHILDREN stacked vertically."
|
|
(declare (ignore children))
|
|
(let* ((node (gensym "VBOX"))
|
|
(props (make-props-list args)))
|
|
`(let ((,node (make-layout-node)))
|
|
(layout-node-set-direction ,node :column)
|
|
(apply #'cl-tui.layout-composable::apply-common-props ,node ',props)
|
|
(cl-tui.layout-composable::add-children ,node (list ,@children))
|
|
,node)))
|
|
|
|
(defmacro hbox (&rest args &key children &allow-other-keys)
|
|
"Create a row-direction container with CHILDREN laid out horizontally."
|
|
(declare (ignore children))
|
|
(let* ((node (gensym "HBOX"))
|
|
(props (make-props-list args)))
|
|
`(let ((,node (make-layout-node)))
|
|
(layout-node-set-direction ,node :row)
|
|
(apply #'cl-tui.layout-composable::apply-common-props ,node ',props)
|
|
(cl-tui.layout-composable::add-children ,node (list ,@children))
|
|
,node)))
|
|
|
|
(defmacro overlay (base child &key top right bottom left)
|
|
"Create a container with BASE as the relative foundation and CHILD
|
|
positioned absolutely on top."
|
|
(let ((node (gensym "OVERLAY")))
|
|
`(let ((,node (make-layout-node)))
|
|
(layout-node-set-position ,node :relative)
|
|
(layout-node-add-child ,node ,base)
|
|
(layout-node-set-position ,child :absolute
|
|
,@(when top `(:top ,top))
|
|
,@(when right `(:right ,right))
|
|
,@(when bottom `(:bottom ,bottom))
|
|
,@(when left `(:left ,left)))
|
|
(layout-node-add-child ,node ,child)
|
|
,node)))
|
|
|
|
(defun spacer (&key (grow 0))
|
|
"Create an empty spacer node that fills available space via flex-grow."
|
|
(let ((node (make-layout-node)))
|
|
(when (> grow 0)
|
|
(layout-node-set-flex node :grow grow))
|
|
node))
|
|
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :cl-tui.layout-composable-tests
|
|
(:use :cl :fiveam)
|
|
(:import-from :cl-tui.layout-composable
|
|
#:vbox #:hbox #:overlay #:spacer)
|
|
(:import-from :cl-tui.layout-primitives
|
|
#:layout-node #:layout-node-ptr #:layout-calculate
|
|
#:make-layout-node #:layout-node-set-dimension)
|
|
(:import-from :cl-tui.yoga-ffi
|
|
#:yg-node-layout-get-left
|
|
#:yg-node-layout-get-top
|
|
#:yg-node-layout-get-width
|
|
#:yg-node-layout-get-height
|
|
#:yg-node-get-child))
|
|
|
|
(in-package :cl-tui.layout-composable-tests)
|
|
|
|
(defun node-x (n) (yg-node-layout-get-left (layout-node-ptr n)))
|
|
(defun node-y (n) (yg-node-layout-get-top (layout-node-ptr n)))
|
|
(defun node-w (n) (yg-node-layout-get-width (layout-node-ptr n)))
|
|
(defun node-h (n) (yg-node-layout-get-height (layout-node-ptr n)))
|
|
(defun child-x (p) (yg-node-layout-get-left p))
|
|
(defun child-y (p) (yg-node-layout-get-top p))
|
|
(defun child-w (p) (yg-node-layout-get-width p))
|
|
(defun child-h (p) (yg-node-layout-get-height p))
|
|
|
|
(defun nth-child (node n)
|
|
(yg-node-get-child (layout-node-ptr node) n))
|
|
|
|
(defun layout-dummy (w h)
|
|
(let ((n (make-layout-node)))
|
|
(layout-node-set-dimension n w h)
|
|
n))
|
|
|
|
(fiveam:def-suite layout-composable-suite
|
|
:description "Composable API macro verification")
|
|
(fiveam:in-suite layout-composable-suite)
|
|
|
|
(fiveam:test test-vbox-stacks-children
|
|
"Contract: vbox stacks children vertically."
|
|
(let* ((root (vbox :width 100 :height 200
|
|
:children ((layout-dummy 100 50)
|
|
(layout-dummy 100 50)))))
|
|
(layout-calculate root 100 200)
|
|
(let ((c1 (nth-child root 0))
|
|
(c2 (nth-child root 1)))
|
|
(fiveam:is (= 0.0 (child-y c1)))
|
|
(fiveam:is (= 50.0 (child-y c2))))))
|
|
|
|
(fiveam:test test-hbox-lays-out-horizontally
|
|
"Contract: hbox places children horizontally."
|
|
(let* ((root (hbox :width 200 :height 100
|
|
:children ((layout-dummy 80 50)
|
|
(layout-dummy 80 50)))))
|
|
(layout-calculate root 200 100)
|
|
(let ((c1 (nth-child root 0))
|
|
(c2 (nth-child root 1)))
|
|
(fiveam:is (= 0.0 (child-x c1)))
|
|
(fiveam:is (= 80.0 (child-x c2))))))
|
|
|
|
(fiveam:test test-spacer-flex-grow
|
|
"Contract: spacer with flex-grow expands to fill space."
|
|
(let* ((root (hbox :width 200 :height 100
|
|
:children ((layout-dummy 50 50)
|
|
(spacer :grow 1)
|
|
(layout-dummy 50 50)))))
|
|
(layout-calculate root 200 100)
|
|
(let ((c1 (nth-child root 0))
|
|
(c2 (nth-child root 1))
|
|
(c3 (nth-child root 2)))
|
|
(fiveam:is (= 0.0 (child-x c1)))
|
|
(fiveam:is (= 50.0 (child-w c1)))
|
|
(fiveam:is (= 100.0 (child-w c2))))))
|
|
|
|
(fiveam:test test-overlay-absolute-position
|
|
"Contract: overlay positions an absolute child over a relative base."
|
|
(let* ((base (layout-dummy 100 100))
|
|
(child (layout-dummy 30 30))
|
|
(root (overlay base child :top 10 :left 20)))
|
|
(layout-calculate root 200 200)
|
|
(fiveam:is (= 20.0 (node-x child)))
|
|
(fiveam:is (= 10.0 (node-y child)))))
|
|
|
|
(fiveam:test test-vbox-align-justify
|
|
"Contract: vbox accepts align and justify keywords."
|
|
(let* ((root (vbox :width 200 :height 100
|
|
:align (:items :center)
|
|
:justify :center
|
|
:children ((layout-dummy 50 50)))))
|
|
(layout-calculate root 200 100)
|
|
(let ((c (nth-child root 0)))
|
|
(fiveam:is (= 25.0 (child-y c)))
|
|
(fiveam:is (= 75.0 (child-x c))))))
|
|
|
|
(fiveam:test test-vbox-padding
|
|
"Contract: vbox padding offsets children."
|
|
(let* ((root (vbox :width 200 :height 100
|
|
:padding (:all 10)
|
|
:children ((layout-dummy 180 80)))))
|
|
(layout-calculate root 200 100)
|
|
(let ((c (nth-child root 0)))
|
|
(fiveam:is (= 10.0 (child-x c)))
|
|
(fiveam:is (= 10.0 (child-y c))))))
|