From 5ea4867257558bccec33840242dbffd21ead9296 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 16 Apr 2021 08:44:07 -0400
Subject: node-2d: Add predicate based filtering to pick method.

---
 starling/node-2d.scm | 25 +++++++++++++------------
 1 file 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
 
-- 
cgit v1.2.3