summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--catbird/node-2d.scm46
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)))
;;;