fix quad tree queries (queries should not choose only one quadrant because they may validly visit two or more quadrants if query covers two leaf nodes), resulting in regressions. Fix one regression: reimplement wall patches (this time also optimised because there is no intgermediary list)
This commit is contained in:
@@ -526,14 +526,14 @@ struct
|
|||||||
#platID enemy
|
#platID enemy
|
||||||
else eID
|
else eID
|
||||||
in
|
in
|
||||||
if eID = #nextPlatID enemy then
|
if eID = ~1 orelse pID = ~1 then
|
||||||
getLandingPatches (eID, platforms, enemy, acc)
|
|
||||||
else if eID = ~1 orelse pID = ~1 then
|
|
||||||
(* without checking that neither of these are ~1
|
(* without checking that neither of these are ~1
|
||||||
* (which means there is no platform below the enemy/player)
|
* (which means there is no platform below the enemy/player)
|
||||||
* there is a subscript error because the PathFinding.start
|
* there is a subscript error because the PathFinding.start
|
||||||
* function expects neither of these values to be ~1. *)
|
* function expects neither of these values to be ~1. *)
|
||||||
getPatrollPatches (enemy, wallTree, platformTree, acc)
|
getPatrollPatches (enemy, wallTree, platformTree, acc)
|
||||||
|
else if eID = #nextPlatID enemy then
|
||||||
|
getLandingPatches (eID, platforms, enemy, acc)
|
||||||
else if eID = pID then
|
else if eID = pID then
|
||||||
getPatrollPatches (enemy, wallTree, platformTree, acc)
|
getPatrollPatches (enemy, wallTree, platformTree, acc)
|
||||||
else
|
else
|
||||||
|
|||||||
@@ -100,45 +100,68 @@ struct
|
|||||||
QuadTree.getItemID (x, y, width, height, 0, 0, ww, wh, tree)
|
QuadTree.getItemID (x, y, width, height, 0, 0, ww, wh, tree)
|
||||||
end
|
end
|
||||||
|
|
||||||
fun getWallPatches (walls: wall vector, lst, acc) =
|
fun getWallPatches (x, y, walls, wallTree, acc) =
|
||||||
let
|
let
|
||||||
open QuadTree
|
val size = Fn.entitySize
|
||||||
|
val moveBy = Fn.moveBy
|
||||||
|
val ww = Constants.worldWidth
|
||||||
|
val wh = Constants.worldHeight
|
||||||
|
|
||||||
|
(* check collision with wall to the left *)
|
||||||
|
val acc =
|
||||||
|
let
|
||||||
|
val leftWallID = QuadTree.getItemID
|
||||||
|
(x - 1, y, 1, 1, 0, 0, ww, wh, wallTree)
|
||||||
|
in
|
||||||
|
if leftWallID <> ~1 then
|
||||||
|
let
|
||||||
|
val {x = wallX, width = wallWidth, ...} =
|
||||||
|
Vector.sub (walls, leftWallID - 1)
|
||||||
|
|
||||||
|
val newX = wallX + wallWidth
|
||||||
|
in
|
||||||
|
Fn.W_X newX :: acc
|
||||||
|
end
|
||||||
|
else
|
||||||
|
acc
|
||||||
|
end
|
||||||
|
|
||||||
|
(* check collision with wall to the right *)
|
||||||
|
val acc =
|
||||||
|
let
|
||||||
|
val rightWallID = QuadTree.getItemID
|
||||||
|
(x + size - 1, y, 1, 1, 0, 0, ww, wh, wallTree)
|
||||||
|
in
|
||||||
|
if rightWallID <> ~1 then
|
||||||
|
let
|
||||||
|
val {x = wallX, ...} = Vector.sub (walls, rightWallID - 1)
|
||||||
|
|
||||||
|
val newX = wallX - size
|
||||||
|
in
|
||||||
|
Fn.W_X newX :: acc
|
||||||
|
end
|
||||||
|
else
|
||||||
|
acc
|
||||||
|
end
|
||||||
|
|
||||||
|
(* check collision with wall below *)
|
||||||
|
val downWallID = QuadTree.getItemID
|
||||||
|
(x + moveBy + 1, y + size, 1, 1, 0, 0, ww, wh, wallTree)
|
||||||
in
|
in
|
||||||
case lst of
|
if downWallID <> ~1 then
|
||||||
(QUERY_ON_LEFT_SIDE, wallID) :: tl =>
|
let
|
||||||
let
|
val {y = wallY, ...} = Vector.sub (walls, downWallID - 1)
|
||||||
val {x = wallX, width = wallWidth, ...} =
|
|
||||||
Vector.sub (walls, wallID - 1)
|
|
||||||
|
|
||||||
val newX = wallX + wallWidth
|
val newY = wallY - size
|
||||||
val acc = Fn.W_X newX :: acc
|
in
|
||||||
in
|
Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
|
||||||
getWallPatches (walls, tl, acc)
|
end
|
||||||
end
|
else
|
||||||
| (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
|
acc
|
||||||
let
|
|
||||||
val {x = wallX, width = wallWidth, ...} =
|
|
||||||
Vector.sub (walls, wallID - 1)
|
|
||||||
|
|
||||||
val newX = wallX - Fn.entitySize
|
|
||||||
val acc = Fn.W_X newX :: acc
|
|
||||||
in
|
|
||||||
getWallPatches (walls, tl, acc)
|
|
||||||
end
|
|
||||||
| (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
|
|
||||||
let
|
|
||||||
val {y = wallY, ...} = Vector.sub (walls, wallID - 1)
|
|
||||||
|
|
||||||
val newY = wallY - Fn.entitySize
|
|
||||||
val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
|
|
||||||
in
|
|
||||||
getWallPatches (walls, tl, acc)
|
|
||||||
end
|
|
||||||
| (QUERY_ON_TOP_SIDE, wallID) :: tl => getWallPatches (walls, tl, acc)
|
|
||||||
| [] => acc
|
|
||||||
end
|
end
|
||||||
|
|
||||||
fun getEnvironmentPatches (input, walls, wallTree, platforms, platformTree) =
|
fun getEnvironmentPatches
|
||||||
|
(input, walls: wall vector, wallTree, platforms, platformTree) =
|
||||||
let
|
let
|
||||||
(* react to platform and wall collisions *)
|
(* react to platform and wall collisions *)
|
||||||
val x = Fn.getX input
|
val x = Fn.getX input
|
||||||
@@ -199,16 +222,11 @@ struct
|
|||||||
else Fn.W_Y_AXIS FALLING :: acc
|
else Fn.W_Y_AXIS FALLING :: acc
|
||||||
| _ => acc
|
| _ => acc
|
||||||
|
|
||||||
val wallCollisions = QuadTree.getCollisionSides
|
val acc = getWallPatches (x, y, walls, wallTree, acc)
|
||||||
(x, y, size, size, 0, 0, ww, wh, 0, wallTree)
|
|
||||||
val acc = getWallPatches (walls, wallCollisions, acc)
|
|
||||||
|
|
||||||
val standPlatID = standingOnAreaID (x, y, platformTree)
|
val standPlatID = standingOnAreaID (x, y, platformTree)
|
||||||
in
|
in
|
||||||
if standPlatID <> ~1 then
|
if standPlatID <> ~1 then Fn.W_PLAT_ID standPlatID :: acc else acc
|
||||||
Fn.W_PLAT_ID standPlatID :: acc
|
|
||||||
else
|
|
||||||
acc
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@@ -261,5 +279,5 @@ structure EnemyPhysics =
|
|||||||
val W_X = EnemyPatch.W_X
|
val W_X = EnemyPatch.W_X
|
||||||
val W_Y = EnemyPatch.W_Y
|
val W_Y = EnemyPatch.W_Y
|
||||||
val W_Y_AXIS = EnemyPatch.W_Y_AXIS
|
val W_Y_AXIS = EnemyPatch.W_Y_AXIS
|
||||||
val W_PLAT_ID = EnemyPatch.W_PLAT_ID
|
val W_PLAT_ID = EnemyPatch.W_PLAT_ID
|
||||||
end)
|
end)
|
||||||
|
|||||||
@@ -4,10 +4,6 @@ sig
|
|||||||
|
|
||||||
val empty: t
|
val empty: t
|
||||||
|
|
||||||
val whichQuadrant: int * int * int * int *
|
|
||||||
int * int * int * int
|
|
||||||
-> QuadTreeType.quadrant
|
|
||||||
|
|
||||||
datatype collision_side =
|
datatype collision_side =
|
||||||
QUERY_ON_LEFT_SIDE
|
QUERY_ON_LEFT_SIDE
|
||||||
| QUERY_ON_TOP_SIDE
|
| QUERY_ON_TOP_SIDE
|
||||||
@@ -50,6 +46,43 @@ struct
|
|||||||
|
|
||||||
type item = QuadTreeType.item
|
type item = QuadTreeType.item
|
||||||
|
|
||||||
|
fun visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
|
||||||
|
let
|
||||||
|
val midX = qW div 2 + qX
|
||||||
|
val midY = qH div 2 + qY
|
||||||
|
in
|
||||||
|
iX <= midX andalso iY <= midY
|
||||||
|
end
|
||||||
|
|
||||||
|
fun visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH) =
|
||||||
|
let
|
||||||
|
val midX = qW div 2 + qX
|
||||||
|
val midY = qH div 2 + qY
|
||||||
|
in
|
||||||
|
iX >= midX andalso iY <= midY
|
||||||
|
end
|
||||||
|
|
||||||
|
fun visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
|
||||||
|
let
|
||||||
|
val midX = qW div 2 + qX
|
||||||
|
val midY = qH div 2 + qY
|
||||||
|
|
||||||
|
val iFinishY = iY + iH
|
||||||
|
in
|
||||||
|
iX <= midX andalso iFinishY >= midY
|
||||||
|
end
|
||||||
|
|
||||||
|
fun visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH) =
|
||||||
|
let
|
||||||
|
val midX = qW div 2 + qX
|
||||||
|
val midY = qH div 2 + qY
|
||||||
|
|
||||||
|
val iFinishX = iX + iH
|
||||||
|
val iFinishY = iY + iH
|
||||||
|
in
|
||||||
|
iFinishX >= midX andalso iFinishY >= midY
|
||||||
|
end
|
||||||
|
|
||||||
fun mkItem (id, startX, startY, width, height) : item =
|
fun mkItem (id, startX, startY, width, height) : item =
|
||||||
{ itemID = id
|
{ itemID = id
|
||||||
, startX = startX
|
, startX = startX
|
||||||
@@ -58,6 +91,21 @@ struct
|
|||||||
, height = height
|
, height = height
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fun itemToString {itemID, startX, startY, width, height} =
|
||||||
|
String.concat [
|
||||||
|
"{itemID = ",
|
||||||
|
Int.toString itemID,
|
||||||
|
", startX = ",
|
||||||
|
Int.toString startX,
|
||||||
|
", startY = ",
|
||||||
|
Int.toString startY,
|
||||||
|
", width = ",
|
||||||
|
Int.toString width,
|
||||||
|
", height = ",
|
||||||
|
Int.toString height,
|
||||||
|
"}"
|
||||||
|
]
|
||||||
|
|
||||||
type t = QuadTreeType.t
|
type t = QuadTreeType.t
|
||||||
|
|
||||||
val empty = LEAF (Vector.fromList [])
|
val empty = LEAF (Vector.fromList [])
|
||||||
@@ -433,6 +481,19 @@ struct
|
|||||||
LEAF elements
|
LEAF elements
|
||||||
end
|
end
|
||||||
|
|
||||||
|
fun isBetween (start, checkStart, finish, checkFinish) =
|
||||||
|
(* if check containhs start/finish *)
|
||||||
|
(checkStart <= start andalso checkFinish >= finish)
|
||||||
|
orelse
|
||||||
|
(* if start/finish containhs check *)
|
||||||
|
(start <= checkStart andalso finish >= checkFinish)
|
||||||
|
orelse
|
||||||
|
(* if checkStart between start and finish *)
|
||||||
|
(start <= checkStart andalso finish >= checkStart)
|
||||||
|
orelse
|
||||||
|
(* if checkFinish is between start and finish *)
|
||||||
|
(start <= checkFinish andalso finish >= checkFinish)
|
||||||
|
|
||||||
fun isColliding (iX, iY, iW, iH, itemID, checkWith: item) =
|
fun isColliding (iX, iY, iW, iH, itemID, checkWith: item) =
|
||||||
let
|
let
|
||||||
val itemEndX = iX + iW
|
val itemEndX = iX + iW
|
||||||
@@ -441,8 +502,9 @@ struct
|
|||||||
val endX = startX + width
|
val endX = startX + width
|
||||||
val endY = startY + height
|
val endY = startY + height
|
||||||
in
|
in
|
||||||
iX < endX andalso itemEndX > startX andalso iY < endY
|
isBetween (iX, startX, itemEndX, endX) andalso
|
||||||
andalso itemEndY > startY andalso itemID <> checkID
|
isBetween (iY, startY, itemEndY, endY) andalso
|
||||||
|
itemID <> checkID
|
||||||
end
|
end
|
||||||
|
|
||||||
fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
|
fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
|
||||||
@@ -500,133 +562,53 @@ struct
|
|||||||
(* get colliding elements in this node first *)
|
(* get colliding elements in this node first *)
|
||||||
val acc = getCollisionsVec
|
val acc = getCollisionsVec
|
||||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||||
val halfWidth = quadWidth div 2
|
|
||||||
val halfHeight = quadHeight div 2
|
val halfW = quadWidth div 2
|
||||||
|
val halfH = quadHeight div 2
|
||||||
|
|
||||||
|
val midX = halfW + quadX
|
||||||
|
val midY = halfH + quadY
|
||||||
|
|
||||||
|
val iX = itemX
|
||||||
|
val iY = itemY
|
||||||
|
val iW = itemWidth
|
||||||
|
val iH = itemHeight
|
||||||
|
|
||||||
|
val qX = quadX
|
||||||
|
val qY = quadY
|
||||||
|
val qW = quadWidth
|
||||||
|
val qH = quadHeight
|
||||||
|
|
||||||
|
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 acc =
|
||||||
|
if vtl then
|
||||||
|
helpGetCollisions
|
||||||
|
(iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, acc, topLeft)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vtr then
|
||||||
|
helpGetCollisions
|
||||||
|
(iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, acc, topRight)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vbl then
|
||||||
|
helpGetCollisions
|
||||||
|
(iX, iY, iW, iH, qX, midY, halfW, halfH, itemID, acc, bottomLeft)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vbl then
|
||||||
|
helpGetCollisions
|
||||||
|
(iX, iY, iW, iH, midX, midY, halfW, halfH, itemID, acc, bottomRight)
|
||||||
|
else acc
|
||||||
in
|
in
|
||||||
(case
|
acc
|
||||||
whichQuadrant
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, quadWidth
|
|
||||||
, quadHeight
|
|
||||||
)
|
|
||||||
of
|
|
||||||
TOP_LEFT =>
|
|
||||||
helpGetCollisions
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
| TOP_RIGHT =>
|
|
||||||
helpGetCollisions
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX + halfWidth
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
| BOTTOM_LEFT =>
|
|
||||||
helpGetCollisions
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY + halfHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
| BOTTOM_RIGHT =>
|
|
||||||
helpGetCollisions
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX + halfWidth
|
|
||||||
, quadY + halfHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
| PARENT_QUADRANT =>
|
|
||||||
(* In this function, PARENT_QUADRANT means
|
|
||||||
* that the item is not in any of the main quadrants
|
|
||||||
* but may possibly in the parent quadrant OR
|
|
||||||
* it may be in any of the child quadrants.
|
|
||||||
* So descend down on all the children, accumulating acc.
|
|
||||||
* *)
|
|
||||||
let
|
|
||||||
val acc = getCollisionsAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
|
|
||||||
val acc = getCollisionsAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
|
|
||||||
val acc = getCollisionsAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
in
|
|
||||||
getCollisionsAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
end)
|
|
||||||
end
|
end
|
||||||
| LEAF elements =>
|
| LEAF elements =>
|
||||||
getCollisionsVec
|
getCollisionsVec
|
||||||
@@ -769,133 +751,53 @@ struct
|
|||||||
(* get colliding elements in this node first *)
|
(* get colliding elements in this node first *)
|
||||||
val acc = getCollisionSideVec
|
val acc = getCollisionSideVec
|
||||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||||
val halfWidth = quadWidth div 2
|
|
||||||
val halfHeight = quadHeight div 2
|
val halfW = quadWidth div 2
|
||||||
|
val halfH = quadHeight div 2
|
||||||
|
|
||||||
|
val midX = halfW + quadX
|
||||||
|
val midY = halfH + quadY
|
||||||
|
|
||||||
|
val iX = itemX
|
||||||
|
val iY = itemY
|
||||||
|
val iW = itemWidth
|
||||||
|
val iH = itemHeight
|
||||||
|
|
||||||
|
val qX = quadX
|
||||||
|
val qY = quadY
|
||||||
|
val qW = quadWidth
|
||||||
|
val qH = quadHeight
|
||||||
|
|
||||||
|
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 acc =
|
||||||
|
if vtl then
|
||||||
|
helpGetCollisionSides
|
||||||
|
(iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, acc, topLeft)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vtr then
|
||||||
|
helpGetCollisionSides
|
||||||
|
(iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, acc, topRight)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vbl then
|
||||||
|
helpGetCollisionSides
|
||||||
|
(iX, iY, iW, iH, qX, midY, halfW, halfH, itemID, acc, bottomLeft)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vbl then
|
||||||
|
helpGetCollisionSides
|
||||||
|
(iX, iY, iW, iH, midX, midY, halfW, halfH, itemID, acc, bottomRight)
|
||||||
|
else acc
|
||||||
in
|
in
|
||||||
(case
|
acc
|
||||||
whichQuadrant
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, quadWidth
|
|
||||||
, quadHeight
|
|
||||||
)
|
|
||||||
of
|
|
||||||
TOP_LEFT =>
|
|
||||||
helpGetCollisionSides
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
| TOP_RIGHT =>
|
|
||||||
helpGetCollisionSides
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX + halfWidth
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
| BOTTOM_LEFT =>
|
|
||||||
helpGetCollisionSides
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY + halfHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
| BOTTOM_RIGHT =>
|
|
||||||
helpGetCollisionSides
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX + halfWidth
|
|
||||||
, quadY + halfHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
| PARENT_QUADRANT =>
|
|
||||||
(* In this function, PARENT_QUADRANT means
|
|
||||||
* that the item is not in any of the main quadrants
|
|
||||||
* but may possibly in the parent quadrant OR
|
|
||||||
* it may be in any of the child quadrants.
|
|
||||||
* So descend down on all the children, accumulating acc.
|
|
||||||
* *)
|
|
||||||
let
|
|
||||||
val acc = getCollisionSidesAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
|
|
||||||
val acc = getCollisionSidesAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
|
|
||||||
val acc = getCollisionSidesAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
in
|
|
||||||
getCollisionSidesAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
end)
|
|
||||||
end
|
end
|
||||||
| LEAF elements =>
|
| LEAF elements =>
|
||||||
getCollisionSideVec
|
getCollisionSideVec
|
||||||
@@ -990,133 +892,53 @@ struct
|
|||||||
(* get colliding elements in this node first *)
|
(* get colliding elements in this node first *)
|
||||||
val acc = getCollisionsBelowVec
|
val acc = getCollisionsBelowVec
|
||||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||||
val halfWidth = quadWidth div 2
|
|
||||||
val halfHeight = quadHeight div 2
|
val halfW = quadWidth div 2
|
||||||
|
val halfH = quadHeight div 2
|
||||||
|
|
||||||
|
val midX = halfW + quadX
|
||||||
|
val midY = halfH + quadY
|
||||||
|
|
||||||
|
val iX = itemX
|
||||||
|
val iY = itemY
|
||||||
|
val iW = itemWidth
|
||||||
|
val iH = itemHeight
|
||||||
|
|
||||||
|
val qX = quadX
|
||||||
|
val qY = quadY
|
||||||
|
val qW = quadWidth
|
||||||
|
val qH = quadHeight
|
||||||
|
|
||||||
|
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 acc =
|
||||||
|
if vtl then
|
||||||
|
helpGetCollisionsBelow
|
||||||
|
(iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, acc, topLeft)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vtr then
|
||||||
|
helpGetCollisionsBelow
|
||||||
|
(iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, acc, topRight)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vbl then
|
||||||
|
helpGetCollisionsBelow
|
||||||
|
(iX, iY, iW, iH, qX, midY, halfW, halfH, itemID, acc, bottomLeft)
|
||||||
|
else acc
|
||||||
|
|
||||||
|
val acc =
|
||||||
|
if vbl then
|
||||||
|
helpGetCollisionsBelow
|
||||||
|
(iX, iY, iW, iH, midX, midY, halfW, halfH, itemID, acc, bottomRight)
|
||||||
|
else acc
|
||||||
in
|
in
|
||||||
(case
|
acc
|
||||||
whichQuadrant
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, quadWidth
|
|
||||||
, quadHeight
|
|
||||||
)
|
|
||||||
of
|
|
||||||
TOP_LEFT =>
|
|
||||||
helpGetCollisionsBelow
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
| TOP_RIGHT =>
|
|
||||||
helpGetCollisionsBelow
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX + halfWidth
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
| BOTTOM_LEFT =>
|
|
||||||
helpGetCollisionsBelow
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, quadY + halfHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
| BOTTOM_RIGHT =>
|
|
||||||
helpGetCollisionsBelow
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX + halfWidth
|
|
||||||
, quadY + halfHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
| PARENT_QUADRANT =>
|
|
||||||
(* In this function, PARENT_QUADRANT means
|
|
||||||
* that the item is not in any of the main quadrants
|
|
||||||
* but may possibly in the parent quadrant OR
|
|
||||||
* it may be in any of the child quadrants.
|
|
||||||
* So descend down on all the children, accumulating acc.
|
|
||||||
* *)
|
|
||||||
let
|
|
||||||
val acc = getCollisionsBelowAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
|
|
||||||
val acc = getCollisionsBelowAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
|
|
||||||
val acc = getCollisionsBelowAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
in
|
|
||||||
getCollisionsBelowAll
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, acc
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
end)
|
|
||||||
end
|
end
|
||||||
| LEAF elements =>
|
| LEAF elements =>
|
||||||
getCollisionsBelowVec
|
getCollisionsBelowVec
|
||||||
@@ -1155,8 +977,16 @@ struct
|
|||||||
let
|
let
|
||||||
val item = Vector.sub (elements, pos)
|
val item = Vector.sub (elements, pos)
|
||||||
in
|
in
|
||||||
|
if
|
||||||
isColliding (iX, iY, iW, iH, itemID, item)
|
isColliding (iX, iY, iW, iH, itemID, item)
|
||||||
orelse hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
|
then
|
||||||
|
let val _ = print ("quad-tree.sml: has collision: \n" ^ itemToString
|
||||||
|
item ^ "\n")
|
||||||
|
in
|
||||||
|
true
|
||||||
|
end
|
||||||
|
else
|
||||||
|
hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
|
||||||
end
|
end
|
||||||
|
|
||||||
fun hasCollisionAt
|
fun hasCollisionAt
|
||||||
@@ -1176,95 +1006,54 @@ struct
|
|||||||
hasCollisionAtVec
|
hasCollisionAtVec
|
||||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements)
|
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements)
|
||||||
orelse
|
orelse
|
||||||
(case
|
let
|
||||||
whichQuadrant
|
val halfW = quadWidth div 2
|
||||||
( itemX
|
val halfH = quadHeight div 2
|
||||||
, itemY
|
|
||||||
, itemWidth
|
val midX = halfW + quadX
|
||||||
, itemHeight
|
val midY = halfH + quadY
|
||||||
, quadX
|
|
||||||
, quadY
|
val iX = itemX
|
||||||
, quadWidth
|
val iY = itemY
|
||||||
, quadHeight
|
val iW = itemWidth
|
||||||
)
|
val iH = itemHeight
|
||||||
of
|
|
||||||
TOP_LEFT =>
|
val qX = quadX
|
||||||
let
|
val qY = quadY
|
||||||
val halfWidth = quadWidth div 2
|
val qW = quadWidth
|
||||||
val halfHeight = quadHeight div 2
|
val qH = quadHeight
|
||||||
in
|
|
||||||
hasCollisionAt
|
val vtl = visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH)
|
||||||
( itemX
|
val vtr = visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH)
|
||||||
, itemY
|
val vbl = visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH)
|
||||||
, itemWidth
|
val vbr = visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH)
|
||||||
, itemHeight
|
|
||||||
, quadX
|
val tl =
|
||||||
, quadY
|
if vtl then
|
||||||
, halfWidth
|
hasCollisionAt
|
||||||
, halfHeight
|
(iX, iY, iW, iH, qX, qY, halfW, halfH, itemID, topLeft)
|
||||||
, itemID
|
else false
|
||||||
, topLeft
|
|
||||||
)
|
val tr =
|
||||||
end
|
if vtr then
|
||||||
| TOP_RIGHT =>
|
hasCollisionAt
|
||||||
let
|
(iX, iY, iW, iH, midX, qY, halfW, halfH, itemID, topRight)
|
||||||
val halfWidth = quadWidth div 2
|
else false
|
||||||
val halfHeight = quadHeight div 2
|
|
||||||
val middleX = quadX + halfWidth
|
val bl =
|
||||||
in
|
if vbl then
|
||||||
hasCollisionAt
|
hasCollisionAt
|
||||||
( itemX
|
(iX, iY, iW, iH, qX, midY, halfW, halfH, itemID, bottomLeft)
|
||||||
, itemY
|
else false
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
val br =
|
||||||
, middleX
|
if vbl then
|
||||||
, quadY
|
hasCollisionAt
|
||||||
, halfWidth
|
(iX, iY, iW, iH, midX, midY, halfW, halfH, itemID, bottomRight)
|
||||||
, halfHeight
|
else false
|
||||||
, itemID
|
in
|
||||||
, topRight
|
tl orelse tr orelse bl orelse br
|
||||||
)
|
end
|
||||||
end
|
|
||||||
| BOTTOM_LEFT =>
|
|
||||||
let
|
|
||||||
val halfWidth = quadWidth div 2
|
|
||||||
val halfHeight = quadHeight div 2
|
|
||||||
val middleY = quadY + halfHeight
|
|
||||||
in
|
|
||||||
hasCollisionAt
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, quadX
|
|
||||||
, middleY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
end
|
|
||||||
| BOTTOM_RIGHT =>
|
|
||||||
let
|
|
||||||
val halfWidth = quadWidth div 2
|
|
||||||
val halfHeight = quadHeight div 2
|
|
||||||
val middleX = quadX + halfWidth
|
|
||||||
val middleY = quadY + halfHeight
|
|
||||||
in
|
|
||||||
hasCollisionAt
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemWidth
|
|
||||||
, itemHeight
|
|
||||||
, middleX
|
|
||||||
, middleY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, itemID
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
end
|
|
||||||
| PARENT_QUADRANT => false)
|
|
||||||
| LEAF elements =>
|
| LEAF elements =>
|
||||||
hasCollisionAtVec
|
hasCollisionAtVec
|
||||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements)
|
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements)
|
||||||
@@ -1285,87 +1074,53 @@ struct
|
|||||||
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
||||||
let
|
let
|
||||||
val tryID = getItemIDVec (itemX, itemY, itemW, itemH, 0, elements)
|
val tryID = getItemIDVec (itemX, itemY, itemW, itemH, 0, elements)
|
||||||
|
|
||||||
|
val halfW = quadW div 2
|
||||||
|
val halfH = quadH div 2
|
||||||
|
|
||||||
|
val midX = halfW + quadX
|
||||||
|
val midY = halfH + quadY
|
||||||
|
|
||||||
|
val iX = itemX
|
||||||
|
val iY = itemY
|
||||||
|
val iW = itemW
|
||||||
|
val iH = itemH
|
||||||
|
|
||||||
|
val qX = quadX
|
||||||
|
val qY = quadY
|
||||||
|
val qW = quadW
|
||||||
|
val qH = quadH
|
||||||
|
|
||||||
|
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 tryID =
|
||||||
|
if vtl andalso tryID = ~1 then
|
||||||
|
getItemID
|
||||||
|
(iX, iY, iW, iH, qX, qY, halfW, halfH, topLeft)
|
||||||
|
else tryID
|
||||||
|
|
||||||
|
val tryID =
|
||||||
|
if vtr andalso tryID = ~1 then
|
||||||
|
getItemID
|
||||||
|
(iX, iY, iW, iH, midX, qY, halfW, halfH, topRight)
|
||||||
|
else tryID
|
||||||
|
|
||||||
|
val tryID =
|
||||||
|
if vbl andalso tryID = ~1 then
|
||||||
|
getItemID
|
||||||
|
(iX, iY, iW, iH, qX, midY, halfW, halfH, bottomLeft)
|
||||||
|
else tryID
|
||||||
|
|
||||||
|
val tryID =
|
||||||
|
if vbl andalso tryID <> ~1 then
|
||||||
|
getItemID
|
||||||
|
(iX, iY, iW, iH, midX, midY, halfW, halfH, bottomRight)
|
||||||
|
else tryID
|
||||||
in
|
in
|
||||||
if tryID = ~1 then
|
tryID
|
||||||
(case
|
|
||||||
whichQuadrant
|
|
||||||
(itemX, itemY, itemW, itemH, quadX, quadY, quadW, quadH)
|
|
||||||
of
|
|
||||||
TOP_LEFT =>
|
|
||||||
let
|
|
||||||
val halfWidth = quadW div 2
|
|
||||||
val halfHeight = quadH div 2
|
|
||||||
in
|
|
||||||
getItemID
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemW
|
|
||||||
, itemH
|
|
||||||
, quadX
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, topLeft
|
|
||||||
)
|
|
||||||
end
|
|
||||||
| TOP_RIGHT =>
|
|
||||||
let
|
|
||||||
val halfWidth = quadW div 2
|
|
||||||
val halfHeight = quadH div 2
|
|
||||||
val middleX = quadX + halfWidth
|
|
||||||
in
|
|
||||||
getItemID
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemW
|
|
||||||
, itemH
|
|
||||||
, middleX
|
|
||||||
, quadY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, topRight
|
|
||||||
)
|
|
||||||
end
|
|
||||||
| BOTTOM_LEFT =>
|
|
||||||
let
|
|
||||||
val halfWidth = quadW div 2
|
|
||||||
val halfHeight = quadH div 2
|
|
||||||
val middleY = quadY + halfHeight
|
|
||||||
in
|
|
||||||
getItemID
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemW
|
|
||||||
, itemH
|
|
||||||
, quadX
|
|
||||||
, middleY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, bottomLeft
|
|
||||||
)
|
|
||||||
end
|
|
||||||
| BOTTOM_RIGHT =>
|
|
||||||
let
|
|
||||||
val halfWidth = quadW div 2
|
|
||||||
val halfHeight = quadH div 2
|
|
||||||
val middleX = quadX + halfWidth
|
|
||||||
val middleY = quadY + halfHeight
|
|
||||||
in
|
|
||||||
getItemID
|
|
||||||
( itemX
|
|
||||||
, itemY
|
|
||||||
, itemW
|
|
||||||
, itemH
|
|
||||||
, middleX
|
|
||||||
, middleY
|
|
||||||
, halfWidth
|
|
||||||
, halfHeight
|
|
||||||
, bottomRight
|
|
||||||
)
|
|
||||||
end
|
|
||||||
| PARENT_QUADRANT => ~1)
|
|
||||||
else
|
|
||||||
tryID
|
|
||||||
end
|
end
|
||||||
| LEAF elements => getItemIDVec (itemX, itemY, itemW, itemH, 0, elements)
|
| LEAF elements => getItemIDVec (itemX, itemY, itemW, itemH, 0, elements)
|
||||||
end
|
end
|
||||||
|
|||||||
Reference in New Issue
Block a user