diff options
| -rw-r--r-- | catbird/node-2d.scm | 27 |
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 ;;; |