diff options
| -rw-r--r-- | chickadee/data/quadtree.scm | 78 |
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 |