From 6babe4bf3f47444a9f01291d26172ceafdbb7aaf Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 3 Feb 2009 20:09:28 -0600
Subject: [PATCH] fill some holes in quadtree docs, rename quadtrees:prune to
 prune-quadtree to avoid colliding with sets:prune, and kill silly call to boa

---
 extra/quadtrees/quadtrees-docs.factor  | 12 +++++++++---
 extra/quadtrees/quadtrees-tests.factor |  6 +++---
 extra/quadtrees/quadtrees.factor       |  7 +++++--
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/extra/quadtrees/quadtrees-docs.factor b/extra/quadtrees/quadtrees-docs.factor
index f2de89ce3d..8240ac5db9 100644
--- a/extra/quadtrees/quadtrees-docs.factor
+++ b/extra/quadtrees/quadtrees-docs.factor
@@ -2,9 +2,11 @@ USING: arrays assocs help.markup help.syntax math.geometry.rect quadtrees quotat
 IN: quadtrees
 
 ARTICLE: "quadtrees" "Quadtrees"
-"The " { $snippet "quadtrees" } " vocabulary implements the quadtree structure in Factor. Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
-{ $subsection prune }
+"The " { $snippet "quadtrees" } " vocabulary implements the quadtree data structure in Factor."
+{ $subsection <quadtree> }
+"Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
 { $subsection in-rect }
+{ $subsection prune-quadtree }
 "The following words are provided to help write quadtree algorithms:"
 { $subsection descend }
 { $subsection each-quadrant }
@@ -12,7 +14,11 @@ ARTICLE: "quadtrees" "Quadtrees"
 
 ABOUT: "quadtrees"
 
-HELP: prune
+HELP: <quadtree>
+{ $values { "bounds" rect } { "quadtree" quadtree } }
+{ $description "Constructs an empty quadtree covering the axis-aligned rectangle indicated by " { $snippet "bounds" } ". All the keys of " { $snippet "quadtree" } " must be two-dimensional vectors lying inside " { $snippet "bounds" } "." } ;
+
+HELP: prune-quadtree
 { $values { "tree" quadtree } }
 { $description "Removes empty nodes from " { $snippet "tree" } "." } ;
 
diff --git a/extra/quadtrees/quadtrees-tests.factor b/extra/quadtrees/quadtrees-tests.factor
index b96cdd82bf..118ac60a8c 100644
--- a/extra/quadtrees/quadtrees-tests.factor
+++ b/extra/quadtrees/quadtrees-tests.factor
@@ -98,7 +98,7 @@ IN: quadtrees.tests
         "d" {  0.75  0.25 } value>>key
 
         {  0.25  0.25 } delete>>key
-        prune
+        prune-quadtree
 ] unit-test
 
 [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
@@ -116,7 +116,7 @@ IN: quadtrees.tests
 
         {  0.25  0.25 } delete>>key
         {  0.75  0.25 } delete>>key
-        prune
+        prune-quadtree
 ] unit-test
 
 [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
@@ -160,7 +160,7 @@ IN: quadtrees.tests
         "g" {  0.25  0.25 } value>>key
         "h" {  0.75  0.75 } value>>key
 
-        prune
+        prune-quadtree
 ] unit-test
 
 [ 8 ] [
diff --git a/extra/quadtrees/quadtrees.factor b/extra/quadtrees/quadtrees.factor
index 60446f4bf8..a47b55b760 100644
--- a/extra/quadtrees/quadtrees.factor
+++ b/extra/quadtrees/quadtrees.factor
@@ -6,7 +6,10 @@ IN: quadtrees
 
 TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ;
 
-: <quadtree> ( bounds -- quadtree ) f f f f f f t quadtree boa ;
+: <quadtree> ( bounds -- quadtree )
+    quadtree new
+        swap >>bounds
+        t >>leaf? ;
 
 : rect-ll ( rect -- point ) loc>> ;
 : rect-lr ( rect -- point ) [ loc>> ] [ width  ] bi v+x ;
@@ -165,7 +168,7 @@ DEFER: in-rect*
 
 PRIVATE>
 
-: prune ( tree -- tree ) [ (prune) ] keep ;
+: prune-quadtree ( tree -- tree ) [ (prune) ] keep ;
 
 : in-rect ( tree rect -- values )
     [ 16 <vector> ] 2dip in-rect* ;