node-2d: Add fit-to-children procedure.

1 files changed, 27 insertions, 0 deletions

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
@@ -771,6 +772,32 @@ A."
 
 
 ;;;
+;;; 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
 ;;;