start implementing new quad tree that only uses pointers (just to test performance between vector-using implementation and only-pointer-using implementation)

fcore/pointer-quad-tree-type.sml

@@ -0,0 +1,130 @@
+signature POINTER_QUAD_TREE_TYPE =
+sig
+  type item = {itemID: int, startX: int, startY: int, width: int, height: int}
+
+  datatype t =
+    NODE of {tl: t, tr: t, bl: t, br: t}
+  | LEAF of item
+  | SHARE_LEAF of item list
+  | EMPTY
+
+  val isColliding: int * int * int * int * int * int * int * int -> bool
+
+  val isCollidingPlus: int * int * int * int * int * int * int * int -> bool
+
+  val isCollidingItem: int * int * int * int * int * item -> bool
+
+  val visitTopLeft: int * int * int * int * int * int * int * int -> bool
+
+  val visitTopRight: int * int * int * int * int * int * int * int -> bool
+
+  val visitBottomLeft: int * int * int * int * int * int * int * int -> bool
+
+  val visitBottomRight: int * int * int * int * int * int * int * int -> bool
+end
+
+structure PointerQuadTreeType :> POINTER_QUAD_TREE_TYPE =
+struct
+  type item = {itemID: int, startX: int, startY: int, width: int, height: int}
+
+  datatype t =
+    NODE of {tl: t, tr: t, bl: t, br: t}
+  | LEAF of item
+  | SHARE_LEAF of item list
+  | EMPTY
+
+  fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) =
+    ix < cfx andalso ifx > cx andalso iy < cfy andalso ify > cy
+
+  fun isCollidingPlus (ix, iy, iw, ih, cx, cy, cw, ch) =
+    let
+      val ifx = ix + iw
+      val ify = iy + ih
+      val cfx = cx + cw
+      val cfy = cy + ch
+    in
+      isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy)
+    end
+
+  fun isCollidingItem (iX, iY, iW, iH, itemID, checkWith: item) =
+    let
+      val
+        { itemID = checkID
+        , startX = cX
+        , startY = cY
+        , width = cW
+        , height = cH
+        , ...
+        } = checkWith
+    in
+      isCollidingPlus (iX, iY, iW, iH, cX, cY, cW, cH) andalso itemID <> checkID
+    end
+
+  fun visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
+    let
+      val hw = qW div 2
+      val hh = qH div 2
+
+      val ifx = iX + iW
+      val ify = iY + iH
+
+      val qmx = qX + hw
+      val qmy = qY + hh
+
+      val qfx = qX + qW
+      val qfy = qY + qH
+    in
+      isColliding (iX, iY, ifx, ify, qX, qY, qmx, qmy)
+    end
+
+  fun visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH) =
+    let
+      val hw = qW div 2
+      val hh = qH div 2
+
+      val ifx = iX + iW
+      val ify = iY + iH
+
+      val qmx = qX + hw
+      val qmy = qY + hh
+
+      val qfx = qX + qW
+      val qfy = qY + qH
+    in
+      isColliding (iX, iY, ifx, ify, qmx, qY, qfx, qmy)
+    end
+
+  fun visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
+    let
+      val hw = qW div 2
+      val hh = qH div 2
+
+      val ifx = iX + iW
+      val ify = iY + iH
+
+      val qmx = qX + hw
+      val qmy = qY + hh
+
+      val qfx = qX + qW
+      val qfy = qY + qH
+    in
+      isColliding (iX, iY, ifx, ify, qX, qmy, qmx, qfy)
+    end
+
+  fun visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH) =
+    let
+      val hw = qW div 2
+      val hh = qH div 2
+
+      val ifx = iX + iW
+      val ify = iY + iH
+
+      val qmx = qX + hw
+      val qmy = qY + hh
+
+      val qfx = qX + qW
+      val qfy = qY + qH
+    in
+      isColliding (iX, iY, ifx, ify, qmx, qmy, qfx, qfy)
+    end
+end

fcore/pointer-quad-tree.sml

@@ -0,0 +1,198 @@
+structure PointerQuadTree =
+struct
+  open PointerQuadTreeType
+
+  type item = PointerQuadTreeType.item
+
+  type t = {width: int, height: int, tree: PointerQuadTreeType.t}
+
+  fun mkItem (id, startX, startY, width, height) : item =
+    { itemID = id
+    , startX = startX
+    , startY = startY
+    , width = width
+    , height = height
+    }
+
+  fun create (width, height) = {width = width, height = height, tree = EMPTY}
+
+  fun hasSameCoordinates (prev: item, new: item) =
+    let
+      val {startX = px, startY = py, width = pw, height = ph, ...} = prev
+      val {startX = nx, startY = ny, width = nw, height = nh, ...} = new
+    in
+      px = nx andalso py = ny andalso pw = nw andalso ph = nh
+    end
+
+  fun mkLeaf (visitPrev, visitNew, prevItem, newItem) =
+    if visitPrev then LEAF prevItem
+    else if visitNew then LEAF newItem
+    else EMPTY
+
+  fun helpSplitLeaf (x, y, w, h, prevItem, newItem) =
+    let
+      val {startX = px, startY = py, width = pw, height = ph, ...} = prevItem
+      val {startX = nx, startY = ny, width = nw, height = nh, ...} = newItem
+
+      val vtlPrev = visitTopLeft (px, py, pw, ph, x, y, w, h)
+      val vtrPrev = visitTopRight (px, py, pw, ph, x, y, w, h)
+      val vblPrev = visitBottomLeft (px, py, pw, ph, x, y, w, h)
+      val vbrPrev = visitBottomRight (px, py, pw, ph, x, y, w, h)
+
+      val vtlNew = visitTopLeft (nx, ny, nw, nh, x, y, w, h)
+      val vtrNew = visitTopRight (nx, ny, nw, nh, x, y, w, h)
+      val vblNew = visitBottomLeft (nx, ny, nw, nh, x, y, w, h)
+      val vbrNew = visitBottomRight (nx, ny, nw, nh, x, y, w, h)
+
+      val hw = w div 2
+      val hh = h div 2
+      val mx = x + hw
+      val my = y + hh
+
+      val tl =
+        if vtlPrev andalso vtlNew then
+          helpSplitLeaf (x, y, hw, hh, prevItem, newItem)
+        else
+          mkLeaf (vtlPrev, vtlNew, prevItem, newItem)
+
+      val tr =
+        if vtrPrev andalso vtrNew then
+          helpSplitLeaf (mx, y, hw, hh, prevItem, newItem)
+        else
+          mkLeaf (vtrPrev, vtrNew, prevItem, newItem)
+
+      val bl =
+        if vblPrev andalso vblNew then
+          helpSplitLeaf (x, my, hw, hh, prevItem, newItem)
+        else
+          mkLeaf (vblPrev, vblNew, prevItem, newItem)
+
+      val br =
+        if vbrPrev andalso vbrNew then
+          helpSplitLeaf (mx, my, hw, hh, prevItem, newItem)
+        else
+          mkLeaf (vbrPrev, vbrNew, prevItem, newItem)
+    in
+      NODE {tl = tl, tr = tr, bl = bl, br = br}
+    end
+
+  fun splitLeaf (x, y, w, h, prevItem, newItem) =
+    if hasSameCoordinates (prevItem, newItem) then
+      SHARE_LEAF [prevItem, newItem]
+    else
+      helpSplitLeaf (x, y, w, h, prevItem, newItem)
+
+  fun mkShareLeaf (visitPrev, visitNew, oldItems, newItem) =
+    if visitPrev then SHARE_LEAF oldItems
+    else if visitNew then LEAF newItem
+    else EMPTY
+
+  fun helpSplitShareLeaf (x, y, w, h, oldItems, prevItem, newItem) =
+    let
+      val {startX = px, startY = py, width = pw, height = ph, ...} = prevItem
+      val {startX = nx, startY = ny, width = nw, height = nh, ...} = newItem
+
+      val vtlPrev = visitTopLeft (px, py, pw, ph, x, y, w, h)
+      val vtrPrev = visitTopRight (px, py, pw, ph, x, y, w, h)
+      val vblPrev = visitBottomLeft (px, py, pw, ph, x, y, w, h)
+      val vbrPrev = visitBottomRight (px, py, pw, ph, x, y, w, h)
+
+      val vtlNew = visitTopLeft (nx, ny, nw, nh, x, y, w, h)
+      val vtrNew = visitTopRight (nx, ny, nw, nh, x, y, w, h)
+      val vblNew = visitBottomLeft (nx, ny, nw, nh, x, y, w, h)
+      val vbrNew = visitBottomRight (nx, ny, nw, nh, x, y, w, h)
+
+      val hw = w div 2
+      val hh = h div 2
+      val mx = x + hw
+      val my = y + hh
+
+      val tl =
+        if vtlPrev andalso vtlNew then
+          helpSplitShareLeaf (x, y, hw, hh, oldItems, prevItem, newItem)
+        else
+          mkShareLeaf (vtlPrev, vtlNew, oldItems, newItem)
+
+      val tr =
+        if vtrPrev andalso vtrNew then
+          helpSplitShareLeaf (mx, y, hw, hh, oldItems, prevItem, newItem)
+        else
+          mkShareLeaf (vtrPrev, vtrNew, oldItems, newItem)
+
+      val bl =
+        if vblPrev andalso vblNew then
+          helpSplitShareLeaf (x, my, hw, hh, oldItems, prevItem, newItem)
+        else
+          mkShareLeaf (vblPrev, vblNew, oldItems, newItem)
+
+      val br =
+        if vbrPrev andalso vbrNew then
+          helpSplitShareLeaf (mx, my, hw, hh, oldItems, prevItem, newItem)
+        else
+          mkShareLeaf (vbrPrev, vbrNew, oldItems, newItem)
+    in
+      NODE {tl = tl, tr = tr, bl = bl, br = br}
+    end
+
+  fun splitShareLeaf (x, y, w, h, oldItems, newItem) =
+    case oldItems of
+      prevItem :: tl =>
+        if hasSameCoordinates (prevItem, newItem) then
+          let val newItems = newItem :: oldItems
+          in SHARE_LEAF newItems
+          end
+        else
+          helpSplitShareLeaf (x, y, w, h, oldItems, prevItem, newItem)
+    | [] => 
+        (* this case never occurs *) 
+        LEAF newItem
+
+  fun helpInsert (ix, iy, iw, ih, itemID, qx, qy, qw, qh, tree) =
+    case tree of
+      NODE {tl, tr, bl, br} =>
+        let
+          val vtl = visitTopLeft (ix, iy, iw, ih, qx, qy, qw, qh)
+          val vtr = visitTopRight (ix, iy, iw, ih, qx, qy, qw, qh)
+          val vbl = visitBottomLeft (ix, iy, iw, ih, qx, qy, qw, qh)
+          val vbr = visitBottomRight (ix, iy, iw, ih, qx, qy, qw, qh)
+
+          val hw = qw div 2
+          val hh = qh div 2
+
+          val tl =
+            if vtl then helpInsert (ix, iy, iw, ih, itemID, qw, qy, hw, hh, tl)
+            else tl
+
+          val tr =
+            if vtr then
+              helpInsert (ix, iy, iw, ih, itemID, qx + hw, qy, hw, hh, tr)
+            else
+              tr
+
+          val bl =
+            if vbl then
+              helpInsert (ix, iy, iw, ih, itemID, qx, qy + hh, hw, hh, bl)
+            else
+              bl
+
+          val br =
+            if vbr then
+              helpInsert (ix, iy, iw, ih, itemID, qx + hw, qy + hh, hw, hh, br)
+            else
+              br
+        in
+          NODE {tl = tl, tr = tr, bl = bl, br = br}
+        end
+    | LEAF prevItem =>
+        let val newItem = mkItem (itemID, ix, iy, iw, ih)
+        in splitLeaf (qx, qy, qw, qh, prevItem, newItem)
+        end
+    | EMPTY =>
+        let val newItem = mkItem (itemID, ix, iy, iw, ih)
+        in LEAF newItem
+        end
+    | SHARE_LEAF oldItems =>
+        let val newItem = mkItem (itemID, ix, iy, iw, ih)
+        in splitShareLeaf (qx, qy, qw, qh, oldItems, newItem)
+        end
+end

oms.mlb

@@ -39,6 +39,9 @@ fcore/projectile.sml
 fcore/player-enemy.sml
 fcore/game-update.sml
 
+fcore/pointer-quad-tree-type.sml
+fcore/pointer-quad-tree.sml
+
 (* shell *)
 $(SML_LIB)/basis/mlton.mlb