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