done implementing pointer quad tree (next: benchmark the two)

fcore/pointer-quad-tree-fold.sml

@@ -0,0 +1,92 @@
+signature POINTER_QUAD_FOLDER =
+sig
+  type env
+  type state
+
+  val fold: int * env * state -> state
+end
+
+signature MAKE_POINTER_QUAD_TREE_FOLD =
+sig
+  structure Fn: POINTER_QUAD_FOLDER
+
+  val foldRegion: int * int * int * int * 
+                  Fn.env * Fn.state * {tree: PointerQuadTreeType.t, width: int, height: int}
+                  -> Fn.state
+end
+
+functor MakePointerQuadTreeFold(Fn: POINTER_QUAD_FOLDER): MAKE_POINTER_QUAD_TREE_FOLD =
+struct
+  structure Fn = Fn
+
+  open PointerQuadTreeType
+
+  fun foldRegionList (rx, ry, rw, rh, env, state, lst) =
+    case lst of
+      item :: tl =>
+        let
+          val state =
+            if isCollidingItem (rx, ry, rw, rh, ~1, item) then
+              Fn.fold (#itemID item, env, state)
+            else
+              state
+        in
+          foldRegionList (rx, ry, rw, rh, env, state, tl)
+        end
+    | [] => state
+
+  fun helpFoldRegion (rx, ry, rw, rh, env, state, qx, qy, qw, qh, tree) =
+    case tree of
+      NODE {tl, tr, bl, br} =>
+        let
+          val vtl = visitTopLeft (rx, ry, rw, rh, qx, qy, qw, qh)
+          val vtr = visitTopRight (rx, ry, rw, rh, qx, qy, qw, qh)
+          val vbl = visitBottomLeft (rx, ry, rw, rh, qx, qy, qw, qh)
+          val vbr = visitBottomRight (rx, ry, rw, rh, qx, qy, qw, qh)
+
+          val hw = qw div 2
+          val hh = qh div 2
+
+          val state =
+            if vtl then
+              helpFoldRegion 
+                (rx, ry, rw, rh, env, state, qx, qy, hw, hh, tl)
+            else
+              state
+
+          val state = 
+            if vtr then
+              helpFoldRegion 
+                (rx, ry, rw, rh, env, state, qx + hw, qy, hw, hh, tr)
+            else 
+              state
+
+          val state = 
+            if vbl then
+              helpFoldRegion
+                (rx, ry, rw, rh, env, state, qx, qy + hh, hw, hh, bl)
+            else
+              state
+        in
+          if vbr then
+            helpFoldRegion 
+              (rx, ry, rw, rh, env, state, qw + hw, qy + hh, hw, hh, br)
+          else
+            state
+        end
+    | LEAF item =>
+        if isCollidingItem (rx, ry, rw, rh, ~1, item) then
+          Fn.fold (#itemID item, env, state)
+        else
+          state
+    | EMPTY => state
+    | SHARE_LEAF items => foldRegionList (rx, ry, rw, rh, env, state, items)
+
+  fun foldRegion (rx, ry, rw, rh, env, state, tree) =
+    let
+      val {width, height, tree} = tree
+    in
+      helpFoldRegion (rx, ry, rw, rh, env, state, 0, 0, width, height, tree)
+    end
+end
+

fcore/pointer-quad-tree.sml

@@ -1,4 +1,19 @@
-structure PointerQuadTree =
+signature POINTER_QUAD_TREE =
+sig
+  type t
+
+  val insert: int * int * int * int * int * t -> t
+
+  val getCollisions: int * int * int * int * int * t -> int list
+
+  val hasCollisionAt: int * int * int * int * int * t -> bool
+
+  val getItemID: int * int * int * int * t -> int
+
+  val create: int * int -> t
+end
+
+structure PointerQuadTree: POINTER_QUAD_TREE =
 struct
   open PointerQuadTreeType
 
@@ -195,4 +210,40 @@ struct
         let val newItem = mkItem (itemID, ix, iy, iw, ih)
         in splitShareLeaf (qx, qy, qw, qh, oldItems, newItem)
         end
+
+  fun insert (iX, iY, iW, iH, itemID, tree: t) =
+    let
+      val {width, height, tree} = tree
+      val tree =
+        helpInsert (iX, iY, iW, iH, itemID, 0, 0, width, height, tree)
+    in
+      {width = width, height = height, tree = tree}
+    end
+
+  structure GetCollisions = MakePointerQuadTreeFold (struct
+    type env = unit
+    type state = int list
+    fun fold (itemID, (), lst) = itemID :: lst
+  end)
+
+  fun getCollisions (itemX, itemY, itemWidth, itemHeight, _, tree) =
+    GetCollisions.foldRegion (itemX, itemY, itemWidth, itemHeight, (), [], tree)
+
+  structure HasCollisionAt = MakePointerQuadTreeFold (struct
+    type env = unit
+    type state = bool
+    fun fold _ = true
+  end)
+
+  fun hasCollisionAt (ix, iy, iw, ih, _, tree) =
+    HasCollisionAt.foldRegion (ix, iy, iw, ih, (), false, tree)
+
+  structure GetItemID = MakePointerQuadTreeFold (struct
+    type env = unit
+    type state = int
+    fun fold (itemID, (), curID) = Int.max (itemID, curID)
+  end)
+
+  fun getItemID (ix, iy, iw, ih, tree) =
+    GetItemID.foldRegion (ix, iy, iw, ih, (), ~1, tree)
 end