diff options
| -rw-r--r-- | starling/node-2d.scm | 200 |
1 files changed, 174 insertions, 26 deletions
diff --git a/starling/node-2d.scm b/starling/node-2d.scm index d66615c..00d909a 100644 --- a/starling/node-2d.scm +++ b/starling/node-2d.scm @@ -50,6 +50,8 @@ position resolution viewport + point-within-camera-viewport? + window-space->camera-space <canvas> cameras @@ -73,6 +75,10 @@ skew-y local-matrix world-matrix + width + height + bounding-box + on-child-resize dirty! move-by move-to @@ -82,6 +88,7 @@ scale-by scale-to follow-bezier-path + pick <sprite> texture @@ -182,6 +189,42 @@ (projection-matrix camera)) body ...)))) +(define-method (point-within-camera-viewport? (camera <camera-2d>) p) + (let* ((vp (viewport camera)) + (x (viewport-x vp)) + (y (viewport-y vp)) + (w (viewport-width vp)) + (h (viewport-height vp)) + (px (vec2-x p)) + (py (vec2-y p))) + (and (>= px x) + (< px (+ x w)) + (>= py y) + (< py (+ y h))))) + +(define-method (window-space->camera-space (camera <camera-2d>) p) + ;; To translate a coordinate in window space to camera space, we + ;; do the following: + ;; + ;; - transform p into viewport space by subtracting the viewport + ;; position + ;; + ;; - transform the result of the previous step into camera space by + ;; multiplying by the ratio of the viewport size / camera resolution + ;; + ;; - finally, translate the result of the previous step to the + ;; correct position relative to the camera's current location by + ;; adding the camera position + (let* ((vp (viewport camera)) + (r (resolution camera)) + (pos (position camera))) + (vec2 (+ (* (- (vec2-x p) (viewport-x vp)) + (/ (vec2-x r) (viewport-width vp))) + (vec2-x pos)) + (+ (* (- (vec2-y p) (viewport-y vp)) + (/ (vec2-y r) (viewport-height vp))) + (vec2-y pos))))) + ;;; ;;; 2D Canvas @@ -209,6 +252,21 @@ ((camera . _) camera) (() #f))) +(define-method (pick (canvas <canvas>) p) + (let camera-loop ((cams (cameras canvas))) + (match cams + (() #f) + ((camera . rest) + (if (point-within-camera-viewport? camera p) + (let ((p* (window-space->camera-space camera p))) + (let loop ((kids (reverse (children canvas)))) + (match kids + (() #f) + ((child . rest) + (or (pick child p*) + (loop rest)))))) + (camera-loop rest)))))) + ;;; ;;; 2D Scene @@ -283,12 +341,16 @@ (world-matrix #:getter world-matrix #:init-form (make-identity-matrix4)) (dirty-matrix? #:accessor dirty-matrix? #:init-form #t) ;; Bounding box for render culling, mouse selection, etc. - (bounding-box #:accessor bounding-box #:init-form (make-null-rect))) + (width #:accessor width #:init-keyword #:width #:init-form 0.0 #:watch? #t) + (height #:accessor height #:init-keyword #:height #:init-form 0.0 #:watch? #t) + (bounding-box #:getter bounding-box #:init-form (make-rect 0.0 0.0 0.0 0.0)) + (dirty-bounding-box? #:accessor dirty-bounding-box? #:init-form #t)) (define-method (dirty! (node <node-2d>)) - (set! (dirty-matrix? node) #t)) + (set! (dirty-matrix? node) #t) + (set! (dirty-bounding-box? node) #t)) -(define-method (compute-matrices! (node <node-2d>)) +(define-method (refresh-matrices (node <node-2d>)) (let ((local (local-matrix node)) (world (world-matrix node))) (matrix4-2d-transform! local @@ -305,8 +367,33 @@ (matrix4-identity! world) (matrix4-mult! world world local))))) -;; Animation helpers +(define-method (on-child-resize (node <node-2d>) child) + #t) + +;; TODO: Take rotation and skew into consideration. +(define-method (refresh-bounding-box (node <node-2d>)) + (let ((bb (bounding-box node)) + (p (position node)) + (o (origin node)) + (s (scale node))) + (set-rect-x! bb (- (vec2-x p) (vec2-x o))) + (set-rect-y! bb (- (vec2-y p) (vec2-y o))) + (set-rect-width! bb (* (width node) (vec2-x s))) + (set-rect-height! bb (* (height node) (vec2-y s))) + (set! (dirty-bounding-box? node) #f))) + +(define-method (on-change (node <node-2d>) slot old new) + (case slot + ((origin position rotation scale skew) + (set! (dirty-bounding-box? node) #t) + (dirty! node)) + ((width height) + (let ((np (parent node))) + (when (is-a? np <node-2d>) + (on-child-resize (parent node) node))) + (set! (dirty-bounding-box? node) #t)))) +;; Animation helpers (define-method (move-to (node <node-2d>) x y) (set! (position-x node) x) @@ -355,7 +442,7 @@ (set-vec2! (position node) x y) (set-vec2! (last-position node) x y) (set-vec2! (render-position node) x y) - (compute-matrices! node)) + (refresh-matrices node)) (define-method (rotate-to (node <node-2d>) theta) (set! (rotation node) theta)) @@ -429,10 +516,24 @@ (define-method (follow-bezier-path (node <node-2d>) path duration) (follow-bezier-path node path duration #t)) +(define-method (pick (node <node-2d>) p) + (let ((bb (bounding-box node))) + (let loop ((kids (reverse (children node)))) + (match kids + (() + (and (rect-contains-vec2? bb p) + node)) + ((child . rest) + (let ((o (origin node))) + (or (pick child (vec2- p (position node))) + (loop rest)))))))) + ;; Events (define-method (update-tree (node <node-2d>) dt) (vec2-copy! (position node) (last-position node)) + (when (dirty-bounding-box? node) + (refresh-bounding-box node)) (next-method)) (define-method (render-tree (node <node-2d>) alpha) @@ -449,7 +550,7 @@ (set! (dirty-matrix? node) #t))) ;; Recompute dirty matrices. (when (dirty-matrix? node) - (compute-matrices! node) + (refresh-matrices node) (set! (dirty-matrix? node) #f) ;; If the parent is dirty, all the children need to be marked as ;; dirty, too. @@ -483,6 +584,26 @@ #:init-keyword #:blend-mode #:init-form 'alpha)) +(define-method (refresh-sprite-size (sprite <sprite>)) + (let ((t (texture sprite))) + (set! (width sprite) (texture-width t)) + (set! (height sprite) (texture-height t)))) + +(define-method (on-asset-reload (sprite <sprite>) slot-name asset) + (case slot-name + ((texture) + (refresh-sprite-size sprite)))) + +(define-method (on-change (sprite <sprite>) slot-name old new) + (case slot-name + ((texture) + (refresh-sprite-size sprite)) + (else + (next-method)))) + +(define-method (on-boot (sprite <sprite>)) + (refresh-sprite-size sprite)) + (define-method (render (sprite <sprite>) alpha) (let* ((tex (texture sprite)) (rect (texture-gl-rect tex)) @@ -597,35 +718,55 @@ ;;; -;;; Text +;;; Label ;;; (define-class <label> (<node-2d>) - (font #:accessor font #:init-keyword #:font #:init-thunk default-font #:asset? #t) + (font #:accessor font #:init-keyword #:font #:init-thunk default-font + #:asset? #t #:watch? #t) (text #:accessor text #:init-form "" #:init-keyword #:text #:watch? #t) - (align #:accessor align #:init-value 'left #:init-keyword #:align) + (align #:accessor align #:init-value 'left #:init-keyword #:align #:watch? #t) (vertical-align #:accessor vertical-align #:init-value 'bottom - #:init-keyword #:vertical-align)) + #:init-keyword #:vertical-align #:watch? #t)) -(define-method (initialize (label <label>) initargs) - (next-method) +(define-method (realign (label <label>)) + (set! (origin-x label) + (match (align label) + ('left 0.0) + ('right (width label)) + ('center (/ (width label) 2.0)))) + (set! (origin-y label) + (match (vertical-align label) + ('bottom 0.0) + ('top (height label)) + ('center (/ (height label) 2.0))))) + +(define-method (refresh-label-size (label <label>)) + (let ((f (font label)) + (t (text label))) + (set! (width label) (font-line-width f t)) + (set! (height label) (font-line-height f)))) + +(define-method (on-boot (label <label>)) + (refresh-label-size label) (realign label)) -(define-method (on-change (label <label>) slot-name old new) - (realign label)) +(define-method (on-asset-reload (label <label>) slot-name asset) + (case slot-name + ((font) + (refresh-label-size label)))) -(define-method (realign (label <label>)) - (let ((font (font label))) - (set-vec2! (origin label) - (match (align label) - ('left 0.0) - ('right (font-line-width font (text label))) - ('center (/ (font-line-width font (text label)) 2.0))) - (match (vertical-align label) - ('bottom 0.0) - ('top (font-line-height font)) - ('center (/ (font-line-height font) 2.0))))) - (dirty! label)) +(define-method (on-change (label <label>) slot-name old new) + (case slot-name + ;; TODO: Minor performance improvement: Realignment is not + ;; necessary when changing the text of a left-aligned label. + ((font text) + (refresh-label-size label) + (realign label)) + ((align vertical-align) + (realign label)) + (else + (next-method)))) (define-method (render (label <label>) alpha) (draw-text* (font label) (text label) (world-matrix label))) @@ -655,6 +796,13 @@ (define-class <particles> (<node-2d>) (particles #:accessor particles #:init-keyword #:particles)) +(define-method (on-boot (particles <particles>)) + ;; Default bounding box size. + (when (zero? (width particles)) + (set! (width particles) 32.0)) + (when (zero? (height particles)) + (set! (height particles) 32.0))) + (define-method (update (node <particles>) dt) (update-particles (particles node))) |