node-2d: Smoothly handle canvas node resizing.

1 files changed, 33 insertions, 13 deletions

diff --git a/catbird/node-2d.scm b/catbird/node-2d.scm
index b845ad0..df0ca3b 100644
--- a/catbird/node-2d.scm
+++ b/catbird/node-2d.scm
@@ -39,7 +39,7 @@
   #:use-module (chickadee graphics engine)
   #:use-module (chickadee graphics framebuffer)
   #:use-module (chickadee graphics particles)
-  #:use-module (chickadee graphics path)
+  #:use-module ((chickadee graphics path) #:prefix path:)
   #:use-module (chickadee graphics sprite)
   #:use-module (chickadee graphics text)
   #:use-module (chickadee graphics texture)
@@ -938,33 +938,53 @@ A."
 (define-class <canvas> (<node-2d>)
   (painter #:accessor painter #:init-keyword #:painter #:init-value #f
            #:observe? #t)
-  (canvas #:accessor canvas #:init-thunk make-empty-canvas))
+  (canvas #:accessor canvas #:init-thunk path:make-empty-canvas))
+
+;; Width and height of canvas nodes default to the size of their
+;; initial painter, or 0 if there isn't one.
+(define-method (default-width (c <canvas>))
+  (let ((p (painter c)))
+    (if p (rect-width (path:painter-bounding-box p)) 0.0)))
+
+(define-method (default-height (c <canvas>))
+  (let ((p (painter c)))
+    (if p (rect-height (path:painter-bounding-box p)) 0.0)))
 
 (define-method (refresh-painter (c <canvas>))
+  (define (close? x y)
+    (<= (abs (- x y)) 0.01))
   (let* ((p (painter c)))
     (when p
-      (let ((bb (painter-bounding-box p)))
-        (set-canvas-painter! (canvas c) p)
-        ;; (set! (origin-x canvas) (- (rect-x bb)))
-        ;; (set! (origin-y canvas) (- (rect-y bb)))
-        (resize c (rect-width bb) (rect-height bb))))))
+      ;; Scale the original painter within the vector path rendering
+      ;; system so that it fills the canvas nodes bounding box.
+      (let* ((bb (path:painter-bounding-box p))
+             (pw (rect-width bb))
+             (ph (rect-height bb))
+             (w (width c))
+             (h (height c))
+             (p* (if (and (close? w pw) (close? h ph))
+                     p ; width/height the same
+                     ;; Scale by the factor that makes the painter's
+                     ;; size stretch/shrink to occupy the entire
+                     ;; bounding box.
+                     (path:scale (vec2 (/ w pw) (/ h ph)) p))))
+        (path:set-canvas-painter! (canvas c) p*)))))
 
 (define-method (on-boot (c <canvas>))
   (refresh-painter c))
 
 (define-method ((setter canvas) (c <canvas>))
   (next-method)
-  (set-canvas-painter! (canvas c) (painter c)))
+  (path:set-canvas-painter! (canvas c) (painter c)))
 
 (define-method (on-change (c <canvas>) slot-name old new)
   (case slot-name
-    ((painter)
-     (refresh-painter c))
-    (else
-     (next-method))))
+    ((painter width height)
+     (refresh-painter c)))
+  (next-method))
 
 (define-method (render (c <canvas>) alpha)
-  (draw-canvas* (canvas c) (world-matrix c)))
+  (path:draw-canvas* (canvas c) (world-matrix c)))
 
 
 ;;;