delete pointer quad tree because it is twice as slow to construct as the vector-based implementation
This commit is contained in:
@@ -1,92 +0,0 @@
|
||||
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
|
||||
|
||||
@@ -1,130 +0,0 @@
|
||||
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
|
||||
@@ -1,249 +0,0 @@
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user