From 28380957b317651b67e05f1d3c4b8d4559b69ae4 Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Sat, 1 Feb 2025 09:44:22 +0000 Subject: [PATCH] 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 | 130 ++++++++++++++++++++ fcore/pointer-quad-tree.sml | 198 +++++++++++++++++++++++++++++++ oms.mlb | 3 + 3 files changed, 331 insertions(+) create mode 100644 fcore/pointer-quad-tree-type.sml create mode 100644 fcore/pointer-quad-tree.sml diff --git a/fcore/pointer-quad-tree-type.sml b/fcore/pointer-quad-tree-type.sml new file mode 100644 index 0000000..c1c089f --- /dev/null +++ b/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 diff --git a/fcore/pointer-quad-tree.sml b/fcore/pointer-quad-tree.sml new file mode 100644 index 0000000..bc8ca5f --- /dev/null +++ b/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 diff --git a/oms.mlb b/oms.mlb index f24790d..5a81a6b 100644 --- a/oms.mlb +++ b/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