diff --git a/extra/quadtrees/quadtrees.factor b/extra/quadtrees/quadtrees.factor index 95befc24fe..b29af13f12 100644 --- a/extra/quadtrees/quadtrees.factor +++ b/extra/quadtrees/quadtrees.factor @@ -59,7 +59,7 @@ DEFER: in-rect* : ur-bounds ( rect -- rect' ) [ [ loc>> ] [ dim>> { 0.5 0.5 } v* ] bi v+ ] [ child-dim ] bi ; -: {quadrants} ( node -- quadrants ) +: node>quadrants ( node -- quadrants ) { [ ll>> ] [ lr>> ] [ ul>> ] [ ur>> ] } cleave 4array ; : add-subnodes ( node -- node ) @@ -120,17 +120,17 @@ DEFER: in-rect* : erase ( point tree -- ) dup leaf?>> [ leaf-erase ] [ node-erase ] if ; -: (?leaf) ( quadrant -- {point,value}/f ) +: (?leaf) ( quadrant -- pair/f ) dup point>> [ swap value>> 2array ] [ drop f ] if* ; -: ?leaf ( quadrants -- {point,value}/f ) +: ?leaf ( quadrants -- pair/f ) [ (?leaf) ] map sift dup length { { 1 [ first ] } { 0 [ drop { f f } ] } [ 2drop f ] } case ; -: collapseable? ( node -- {point,value}/f ) - {quadrants} { [ [ leaf?>> ] all? ] [ ?leaf ] } 1&& ; +: collapseable? ( node -- pair/f ) + node>quadrants { [ [ leaf?>> ] all? ] [ ?leaf ] } 1&& ; : remove-subnodes ( node -- leaf ) f >>ll f >>lr f >>ul f >>ur t >>leaf? ; @@ -162,7 +162,7 @@ DEFER: in-rect* : leaf= ( a b -- ? ) [ [ point>> ] [ value>> ] bi 2array ] same? ; -: node= ( a b -- ? ) [ {quadrants} ] same? ; +: node= ( a b -- ? ) [ node>quadrants ] same? ; : (tree=) ( a b -- ? ) dup leaf?>> [ leaf= ] [ node= ] if ;