summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-04-16 08:44:07 -0400
committerDavid Thompson <dthompson2@worcester.edu>2021-04-16 08:44:07 -0400
commit5ea4867257558bccec33840242dbffd21ead9296 (patch)
tree6b45befdbc8f0e6e0d6968831de666ff3ae8bced
parent1a2554e59ec394b56dad3417cf20002c84050278 (diff)
node-2d: Add predicate based filtering to pick method.
-rw-r--r--starling/node-2d.scm25
1 files changed, 13 insertions, 12 deletions
diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index 34a1786..d24a2a3 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -259,7 +259,7 @@
((camera . _) camera)
(() #f)))
-(define-method (pick (canvas <canvas>) p)
+(define-method (pick (canvas <canvas>) p pred)
(let camera-loop ((cams (cameras canvas)))
(match cams
(() #f)
@@ -270,7 +270,7 @@
(match kids
(() #f)
((child . rest)
- (or (pick child p*)
+ (or (pick child p* pred)
(loop rest))))))
(camera-loop rest))))))
@@ -523,17 +523,18 @@
(define-method (follow-bezier-path (node <node-2d>) path duration)
(follow-bezier-path node path duration #t))
-(define-method (pick (node <node-2d>) p)
+(define-method (pick (node <node-2d>) p pred)
(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))))))))
+ (and (pred 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)) pred)
+ (loop rest)))))))))
;; Events