cl-tty/org/layout-composable.org

Layout Composable API

• Layout Composable API
  • Contract
• Package
• Internal Helpers
• vbox — Vertical Box
• hbox — Horizontal Box
• overlay — Absolute Overlay
• spacer — Flex Spacer
• Test Suite

Layout Composable API

Convenience macros for building layout trees declaratively. Each macro creates a layout-node, applies style properties, and inserts child nodes.

Dependencies: layout-primitives.

Contract

• (vbox &key width height flex-grow flex-shrink flex-basis align justify gap padding margin children ...) → layout-node :: Creates a column-direction container. All children are layout-node instances, or plain non-node values are skipped.
• (hbox &key width height flex-grow flex-shrink flex-basis align justify gap padding margin children ...) → layout-node :: Creates a row-direction container.
• (overlay base child &key top right bottom left) → layout-node :: Creates a container with a relative base and an absolute-positioned child overlaid on top.
• (spacer &key grow) → layout-node :: Creates an empty flexible spacer that fills available space.

Package

(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)

Internal Helpers

(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)))

vbox — Vertical Box

(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)))

hbox — Horizontal Box

(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)))

overlay — Absolute Overlay

(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)))

spacer — Flex Spacer

(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))

Test Suite

(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))))))