From 761a0f71e62da694d05895873c91abff70d8ec23 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 27 Dec 2022 09:54:11 -0500
Subject: node-2d: Add fit-to-children procedure.

---
 catbird/node-2d.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/catbird/node-2d.scm b/catbird/node-2d.scm
index 1acb324..6e7eb41 100644
--- a/catbird/node-2d.scm
+++ b/catbird/node-2d.scm
@@ -64,6 +64,7 @@
             default-height
             default-width
             expire-local-matrix
+            fit-to-children
             follow-bezier-path
             local-bounding-box
             local-height
@@ -769,6 +770,32 @@ A."
   (center-horizontal-in-parent node)
   (center-vertical-in-parent node))
 
+
+;;;
+;;; Sizing
+;;;
+
+(define* (fit-to-children node #:optional (padding 0.0))
+  "Resize NODE to fit the current size of its visible children, with
+PADDING on all sides."
+  (let ((bb (make-null-rect)))
+    ;; Compute bounding box of all children.
+    (for-each-child (lambda (child)
+                      (when (visible? child)
+                        (rect-union! bb (local-bounding-box child))))
+                    node)
+    ;; Adjust all children so that there is the desired padding.
+    (let ((dx (- padding (rect-x bb)))
+          (dy (- padding (rect-y bb))))
+      (for-each-child (lambda (child)
+                        (when (visible? child)
+                          (move-by child dx dy)))
+                      node))
+    ;; Finally, resize ourselves.
+    (let ((w (+ (rect-width bb) (* padding 2.0)))
+          (h (+ (rect-height bb) (* padding 2.0))))
+      (resize node w h))))
+
 
 ;;;
 ;;; Sprite
-- 
cgit v1.2.3