summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-10-02 07:57:29 -0400
committerDavid Thompson <dthompson2@worcester.edu>2021-10-02 07:57:29 -0400
commitf2a6caa2aed13516e4cd3a015e26b30ab3accdc6 (patch)
tree5990eb7b1dc3d7ad81f8bf9fafd96dae501d8bcd
parent35e38f323138d6a9e7a9b118d18cd26373cac269 (diff)
data: quadtree: Hide child nodes if parent is currently marked as a leaf.
-rw-r--r--chickadee/data/quadtree.scm78
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