diff options
| -rw-r--r-- | catbird/node-2d.scm | 38 | ||||
| -rw-r--r-- | catbird/node.scm | 6 | ||||
| -rw-r--r-- | catbird/scene.scm | 9 |
3 files changed, 33 insertions, 20 deletions
diff --git a/catbird/node-2d.scm b/catbird/node-2d.scm index 34a7417..a81e2a6 100644 --- a/catbird/node-2d.scm +++ b/catbird/node-2d.scm @@ -80,7 +80,6 @@ origin origin-x origin-y - pick place-above place-at place-at-x @@ -603,25 +602,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 pred) - (and (pred node) - (let loop ((kids (reverse (children node)))) - (match kids - (() - (let* ((m (inverse-world-matrix node)) - (x (vec2-x p)) - (y (vec2-y p)) - (tx (matrix4-transform-x m x y)) - (ty (matrix4-transform-y m x y))) - (and (>= tx 0.0) - (< tx (width node)) - (>= ty 0.0) - (< ty (height node)) - node))) - ((child . rest) - (let ((o (origin node))) - (or (pick child p pred) - (loop rest)))))))) +(define-method (pick (node <node-2d>) p) + (let loop ((kids (reverse (children node)))) + (match kids + (() + (let* ((m (inverse-world-matrix node)) + (x (vec2-x p)) + (y (vec2-y p)) + (tx (matrix4-transform-x m x y)) + (ty (matrix4-transform-y m x y))) + (and (>= tx 0.0) + (< tx (width node)) + (>= ty 0.0) + (< ty (height node)) + node))) + ((child . rest) + (let ((o (origin node))) + (or (pick child p) + (loop rest))))))) ;;; diff --git a/catbird/node.scm b/catbird/node.scm index c923f94..40b8673 100644 --- a/catbird/node.scm +++ b/catbird/node.scm @@ -35,6 +35,7 @@ children for-each-child on-boot + pick reboot child-ref & attach-to @@ -189,6 +190,11 @@ (let ((p (parent node))) (and p (apply send p message args))))) +;; The base node class has no spatial awareness, so all attempts to +;; pick such a node will fail. +(define-method (pick (node <node>) p) + #f) + (define-method (blink (node <node>) times interval) (let loop ((i 0)) (when (< i times) diff --git a/catbird/scene.scm b/catbird/scene.scm index 046a8dd..46d343e 100644 --- a/catbird/scene.scm +++ b/catbird/scene.scm @@ -29,6 +29,7 @@ #:use-module (chickadee scripting) #:use-module (ice-9 exceptions) #:use-module (ice-9 format) + #:use-module (ice-9 match) #:use-module (oop goops) #:use-module (srfi srfi-1) #:export (<scene> @@ -215,3 +216,11 @@ (define-method (height (scene <scene>)) (fold (lambda (r h) (max h (height r))) 0.0 (regions scene))) + +(define-method (pick (scene <scene>) p) + (let loop ((kids (children scene))) + (match kids + (() #f) + ((node . rest) + (or (pick node p) + (loop rest)))))) |