data: quadtree: Hide child nodes if parent is currently marked as a leaf.

1 files changed, 49 insertions, 29 deletions

diff --git a/chickadee/data/quadtree.scm b/chickadee/data/quadtree.scm
index 731faf2..763294f 100644
--- a/chickadee/data/quadtree.scm
+++ b/chickadee/data/quadtree.scm
@@ -60,10 +60,10 @@
   (size quadtree-size set-quadtree-size!)
   (objects quadtree-objects set-quadtree-objects!)
   (leaf? quadtree-leaf? set-quadtree-leaf!)
-  (q1 quadtree-q1 set-quadtree-q1!)
-  (q2 quadtree-q2 set-quadtree-q2!)
-  (q3 quadtree-q3 set-quadtree-q3!)
-  (q4 quadtree-q4 set-quadtree-q4!))
+  (q1 %quadtree-q1 set-quadtree-q1!)
+  (q2 %quadtree-q2 set-quadtree-q2!)
+  (q3 %quadtree-q3 set-quadtree-q3!)
+  (q4 %quadtree-q4 set-quadtree-q4!))
 
 (define (display-quadtree quadtree port)
   (format port "#<quadtree bounds: ~s depth: ~d size: ~d>"
@@ -95,16 +95,36 @@ restricted to MAX-DEPTH."
   "Return #t if QUADTREE is at the maximum allowed depth."
   (= (quadtree-depth quadtree) (quadtree-max-depth quadtree)))
 
+(define (quadtree-q1 quadtree)
+  (if (quadtree-leaf? quadtree)
+      #f
+      (%quadtree-q1 quadtree)))
+
+(define (quadtree-q2 quadtree)
+  (if (quadtree-leaf? quadtree)
+      #f
+      (%quadtree-q2 quadtree)))
+
+(define (quadtree-q3 quadtree)
+  (if (quadtree-leaf? quadtree)
+      #f
+      (%quadtree-q3 quadtree)))
+
+(define (quadtree-q4 quadtree)
+  (if (quadtree-leaf? quadtree)
+      #f
+      (%quadtree-q4 quadtree)))
+
 (define (quadtree-clear! quadtree)
   "Clear QUADTREE."
   (vector-fill! (quadtree-objects quadtree) #f)
   (set-quadtree-size! quadtree 0)
   (unless (quadtree-leaf? quadtree)
     (set-quadtree-leaf! quadtree #t)
-    (quadtree-clear! (quadtree-q1 quadtree))
-    (quadtree-clear! (quadtree-q2 quadtree))
-    (quadtree-clear! (quadtree-q3 quadtree))
-    (quadtree-clear! (quadtree-q4 quadtree))))
+    (quadtree-clear! (%quadtree-q1 quadtree))
+    (quadtree-clear! (%quadtree-q2 quadtree))
+    (quadtree-clear! (%quadtree-q3 quadtree))
+    (quadtree-clear! (%quadtree-q4 quadtree))))
 
 (define (quadtree-split! quadtree)
   "Split QUADTREE region into 4 smaller child nodes."
@@ -121,7 +141,7 @@ restricted to MAX-DEPTH."
       (%make-quadtree (make-rect x y hw hh) max-depth max-size depth 0
                       (make-vector length #f) #t))
     (set-quadtree-leaf! quadtree #f)
-    (unless (quadtree-q1 quadtree)
+    (unless (%quadtree-q1 quadtree)
       (set-quadtree-q1! quadtree (make-node (+ x hw) (+ y hh)))
       (set-quadtree-q2! quadtree (make-node x (+ y hh)))
       (set-quadtree-q3! quadtree (make-node x y))
@@ -155,10 +175,10 @@ QUADTREE if RECT overlaps multiple child nodes."
       (cond
        ;; Rect is within Q3.
        ((and (< y mid-y) (< (+ y h) mid-y))
-        (quadtree-q3 quadtree))
+        (%quadtree-q3 quadtree))
        ;; Rect is within Q2.
        ((> y mid-y)
-        (quadtree-q2 quadtree))
+        (%quadtree-q2 quadtree))
        ;; Rect spans both Q2 and Q3.
        (else quadtree)))
      ;; Rect is within the right two quadrants: Q1 and Q4.
@@ -166,10 +186,10 @@ QUADTREE if RECT overlaps multiple child nodes."
       (cond
        ;; Rect is within Q4.
        ((and (< y mid-y) (< (+ y h) mid-y))
-        (quadtree-q4 quadtree))
+        (%quadtree-q4 quadtree))
        ;; Rect is within Q1.
        ((> y mid-y)
-        (quadtree-q1 quadtree))
+        (%quadtree-q1 quadtree))
        ;; Rect spans both Q1 and Q4.
        (else quadtree)))
      (else quadtree))))
@@ -191,10 +211,10 @@ QUADTREE if RECT overlaps multiple child nodes."
 
 (define (quadtree-merge-maybe! quadtree)
   "Remove child nodes if they are all empty leaf nodes."
-  (when (and (quadtree-empty-leaf? (quadtree-q1 quadtree))
-             (quadtree-empty-leaf? (quadtree-q2 quadtree))
-             (quadtree-empty-leaf? (quadtree-q3 quadtree))
-             (quadtree-empty-leaf? (quadtree-q4 quadtree)))
+  (when (and (quadtree-empty-leaf? (%quadtree-q1 quadtree))
+             (quadtree-empty-leaf? (%quadtree-q2 quadtree))
+             (quadtree-empty-leaf? (%quadtree-q3 quadtree))
+             (quadtree-empty-leaf? (%quadtree-q4 quadtree)))
     ;; We don't actually get rid of the child nodes.  This means that
     ;; the quadtree can take more memory than it has to, but it also
     ;; means that the quadtree doesn't allocate needlessly when
@@ -281,10 +301,10 @@ satisfies PRED."
                     (loop (+ i 1))))
               (cond
                ((and (eq? next-node quadtree) (not (quadtree-leaf? quadtree)))
-                (or (quadtree-find (quadtree-q1 quadtree) rect pred)
-                    (quadtree-find (quadtree-q2 quadtree) rect pred)
-                    (quadtree-find (quadtree-q3 quadtree) rect pred)
-                    (quadtree-find (quadtree-q4 quadtree) rect pred)))
+                (or (quadtree-find (%quadtree-q1 quadtree) rect pred)
+                    (quadtree-find (%quadtree-q2 quadtree) rect pred)
+                    (quadtree-find (%quadtree-q3 quadtree) rect pred)
+                    (quadtree-find (%quadtree-q4 quadtree) rect pred)))
                ((eq? next-node quadtree)
                 #f)
                (else
@@ -306,10 +326,10 @@ returned."
               (loop (+ i 1) (proc (cdr (vector-ref objects i)) memo))
               (cond
                ((and (eq? next-node quadtree) (not (quadtree-leaf? quadtree)))
-                (let* ((q1 (quadtree-fold (quadtree-q1 quadtree) rect memo proc))
-                       (q2 (quadtree-fold (quadtree-q2 quadtree) rect q1 proc))
-                       (q3 (quadtree-fold (quadtree-q3 quadtree) rect q2 proc)))
-                  (quadtree-fold (quadtree-q4 quadtree) rect q3 proc)))
+                (let* ((q1 (quadtree-fold (%quadtree-q1 quadtree) rect memo proc))
+                       (q2 (quadtree-fold (%quadtree-q2 quadtree) rect q1 proc))
+                       (q3 (quadtree-fold (%quadtree-q3 quadtree) rect q2 proc)))
+                  (quadtree-fold (%quadtree-q4 quadtree) rect q3 proc)))
                ((eq? next-node quadtree)
                 memo)
                (else
@@ -328,10 +348,10 @@ returned."
           (loop (+ i 1))))
       (cond
        ((and (eq? next-node quadtree) (not (quadtree-leaf? quadtree)))
-        (quadtree-for-each (quadtree-q1 quadtree) rect proc)
-        (quadtree-for-each (quadtree-q2 quadtree) rect proc)
-        (quadtree-for-each (quadtree-q3 quadtree) rect proc)
-        (quadtree-for-each (quadtree-q4 quadtree) rect proc))
+        (quadtree-for-each (%quadtree-q1 quadtree) rect proc)
+        (quadtree-for-each (%quadtree-q2 quadtree) rect proc)
+        (quadtree-for-each (%quadtree-q3 quadtree) rect proc)
+        (quadtree-for-each (%quadtree-q4 quadtree) rect proc))
        ((eq? next-node quadtree)
         *unspecified*)
        (else