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