diff options
author | David Thompson <dthompson2@worcester.edu> | 2021-04-16 08:44:07 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2021-04-16 08:44:07 -0400 |
commit | 5ea4867257558bccec33840242dbffd21ead9296 (patch) | |
tree | 6b45befdbc8f0e6e0d6968831de666ff3ae8bced | |
parent | 1a2554e59ec394b56dad3417cf20002c84050278 (diff) |
node-2d: Add predicate based filtering to pick method.
-rw-r--r-- | starling/node-2d.scm | 25 |
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 |