fix compile errors after previous commit (which involved reimplementing the quad tree to eliminate the possibility of a class of bugs I was experiencing; the problem was that the quad bounds were being passed recursively in different functions, but the long argument list in these functions made it difficult to see where the mismatch was)
This commit is contained in:
@@ -8,21 +8,15 @@ sig
|
||||
| QUERY_ON_RIGHT_SIDE
|
||||
| QUERY_ON_BOTTOM_SIDE
|
||||
|
||||
val insert: int * int * int * int *
|
||||
int * t -> t
|
||||
val insert: int * int * int * int * int * t -> t
|
||||
|
||||
val getCollisions: int * int * int * int *
|
||||
int * t -> int list
|
||||
val getCollisions: int * int * int * int * int * t -> int list
|
||||
|
||||
val helpGetCollisions: int * int * int * int *
|
||||
int * int list * t
|
||||
-> int list
|
||||
val helpGetCollisions: int * int * int * int * int * int list * t -> int list
|
||||
|
||||
val hasCollisionAt: int * int * int * int *
|
||||
int * t -> bool
|
||||
val hasCollisionAt: int * int * int * int * int * t -> bool
|
||||
|
||||
val getItemID: int * int * int * int *
|
||||
t -> int
|
||||
val getItemID: int * int * int * int * t -> int
|
||||
|
||||
val create: int * int -> t
|
||||
end
|
||||
@@ -34,29 +28,20 @@ struct
|
||||
type item = QuadTreeType.item
|
||||
|
||||
fun create (width, height) =
|
||||
LEAF {
|
||||
items = Vector.fromList [],
|
||||
x = 0,
|
||||
y = 0,
|
||||
w = width,
|
||||
h = height
|
||||
}
|
||||
LEAF {items = Vector.fromList [], x = 0, y = 0, w = width, h = height}
|
||||
|
||||
fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) =
|
||||
ix < cfx andalso
|
||||
ifx > cx andalso
|
||||
iy < cfy andalso
|
||||
ify > cy
|
||||
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
|
||||
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 visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
|
||||
let
|
||||
@@ -82,7 +67,7 @@ struct
|
||||
|
||||
val ifx = iX + iW
|
||||
val ify = iY + iH
|
||||
|
||||
|
||||
val qmx = qX + hw
|
||||
val qmy = qY + hh
|
||||
|
||||
@@ -99,7 +84,7 @@ struct
|
||||
|
||||
val ifx = iX + iW
|
||||
val ify = iY + iH
|
||||
|
||||
|
||||
val qmx = qX + hw
|
||||
val qmy = qY + hh
|
||||
|
||||
@@ -116,7 +101,7 @@ struct
|
||||
|
||||
val ifx = iX + iW
|
||||
val ify = iY + iH
|
||||
|
||||
|
||||
val qmx = qX + hw
|
||||
val qmy = qY + hh
|
||||
|
||||
@@ -145,13 +130,7 @@ struct
|
||||
val hw = w div 2
|
||||
val hh = h div 2
|
||||
in
|
||||
LEAF {
|
||||
items = items,
|
||||
x = x,
|
||||
y = y,
|
||||
w = hw,
|
||||
h = hh
|
||||
}
|
||||
LEAF {items = items, x = x, y = y, w = hw, h = hh}
|
||||
end
|
||||
|
||||
fun mkTopRight (x, y, w, h, items) =
|
||||
@@ -161,13 +140,7 @@ struct
|
||||
val hh = h div 2
|
||||
val x = x + hw
|
||||
in
|
||||
LEAF {
|
||||
items = items,
|
||||
x = x,
|
||||
y = y,
|
||||
w = hw,
|
||||
h = hh
|
||||
}
|
||||
LEAF {items = items, x = x, y = y, w = hw, h = hh}
|
||||
end
|
||||
|
||||
fun mkBottomLeft (x, y, w, h, items) =
|
||||
@@ -177,13 +150,7 @@ struct
|
||||
val hh = h div 2
|
||||
val y = y + hh
|
||||
in
|
||||
LEAF {
|
||||
items = items,
|
||||
x = x,
|
||||
y = y,
|
||||
w = hw,
|
||||
h = hh
|
||||
}
|
||||
LEAF {items = items, x = x, y = y, w = hw, h = hh}
|
||||
end
|
||||
|
||||
fun mkBottomRight (x, y, w, h, items) =
|
||||
@@ -194,17 +161,21 @@ struct
|
||||
val x = x + hw
|
||||
val y = y + hh
|
||||
in
|
||||
LEAF {
|
||||
items = items,
|
||||
x = x,
|
||||
y = y,
|
||||
w = hw,
|
||||
h = hh
|
||||
}
|
||||
LEAF {items = items, x = x, y = y, w = hw, h = hh}
|
||||
end
|
||||
|
||||
fun splitLeaf (x, y, w, h, tl: item list, tr: item list, bl: item list, br:
|
||||
item list, elements, pos) =
|
||||
fun splitLeaf
|
||||
( x
|
||||
, y
|
||||
, w
|
||||
, h
|
||||
, tl: item list
|
||||
, tr: item list
|
||||
, bl: item list
|
||||
, br: item list
|
||||
, elements
|
||||
, pos
|
||||
) =
|
||||
if pos < 0 then
|
||||
let
|
||||
val tl = mkTopLeft (x, y, w, h, tl)
|
||||
@@ -247,22 +218,29 @@ struct
|
||||
fun insert (iX, iY, iW, iH, itemID, tree: t) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
let
|
||||
(* we are not necessarily inserting into all nodes.
|
||||
* If isCollidingPlus returns false recursively,
|
||||
* we return the same node back. *)
|
||||
val tl = insert (iX, iY, iW, iH, itemID, topLeft)
|
||||
val tr = insert (iX, iY, iW, iH, itemID, topRight)
|
||||
val bl = insert (iX, iY, iW, iH, itemID, bottomLeft)
|
||||
val br = insert (iX, iY, iW, iH, itemID, bottomRight)
|
||||
in
|
||||
NODE {topLeft = tl, topRight = tr, bottomLeft = bl, bottomRight = br
|
||||
, x = x, y = y, w = w, h = h
|
||||
}
|
||||
end
|
||||
else
|
||||
tree
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
let
|
||||
(* we are not necessarily inserting into all nodes.
|
||||
* If isCollidingPlus returns false recursively,
|
||||
* we return the same node back. *)
|
||||
val tl = insert (iX, iY, iW, iH, itemID, topLeft)
|
||||
val tr = insert (iX, iY, iW, iH, itemID, topRight)
|
||||
val bl = insert (iX, iY, iW, iH, itemID, bottomLeft)
|
||||
val br = insert (iX, iY, iW, iH, itemID, bottomRight)
|
||||
in
|
||||
NODE
|
||||
{ topLeft = tl
|
||||
, topRight = tr
|
||||
, bottomLeft = bl
|
||||
, bottomRight = br
|
||||
, x = x
|
||||
, y = y
|
||||
, w = w
|
||||
, h = h
|
||||
}
|
||||
end
|
||||
else
|
||||
tree
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
if Vector.length items + 1 > maxSize then
|
||||
@@ -284,18 +262,7 @@ struct
|
||||
|
||||
val br = if vbr then [item] else []
|
||||
in
|
||||
splitLeaf
|
||||
( x
|
||||
, y
|
||||
, w
|
||||
, h
|
||||
, tl
|
||||
, tr
|
||||
, bl
|
||||
, br
|
||||
, items
|
||||
, pos
|
||||
)
|
||||
splitLeaf (x, y, w, h, tl, tr, bl, br, items, pos)
|
||||
end
|
||||
else
|
||||
(* can insert itemID in items vector *)
|
||||
@@ -305,19 +272,23 @@ struct
|
||||
in
|
||||
LEAF {items = items, x = x, y = y, w = w, h = h}
|
||||
end
|
||||
else
|
||||
else
|
||||
(* bounds of new item don't fit inside leaf so return old tree *)
|
||||
tree
|
||||
|
||||
fun isColliding (iX, iY, iW, iH, itemID, checkWith: item) =
|
||||
let
|
||||
val {itemID = checkID, startX = cX, startY = cY, width = cW, height = cH, ...} = checkWith
|
||||
val
|
||||
{ itemID = checkID
|
||||
, startX = cX
|
||||
, startY = cY
|
||||
, width = cW
|
||||
, height = cH
|
||||
, ...
|
||||
} = checkWith
|
||||
in
|
||||
iX < cX + cW andalso
|
||||
iX + iW > cX andalso
|
||||
iY < cY + cH andalso
|
||||
iY + iH > cY andalso
|
||||
itemID <> checkID
|
||||
iX < cX + cW andalso iX + iW > cX andalso iY < cY + cH
|
||||
andalso iY + iH > cY andalso itemID <> checkID
|
||||
end
|
||||
|
||||
fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
|
||||
@@ -338,93 +309,46 @@ struct
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
let
|
||||
val acc = getCollisionsAll
|
||||
(iX, iY, iW, iH, itemID, acc, topLeft)
|
||||
val acc = getCollisionsAll (iX, iY, iW, iH, itemID, acc, topLeft)
|
||||
|
||||
val acc = getCollisionsAll
|
||||
(iX, iY, iW, iH, itemID, acc, topRight)
|
||||
val acc = getCollisionsAll (iX, iY, iW, iH, itemID, acc, topRight)
|
||||
|
||||
val acc = getCollisionsAll
|
||||
(iX, iY, iW, iH, itemID, acc, bottomLeft)
|
||||
val acc = getCollisionsAll (iX, iY, iW, iH, itemID, acc, bottomLeft)
|
||||
in
|
||||
getCollisionsAll
|
||||
(iX, iY, iW, iH, itemID, acc, bottomRight)
|
||||
getCollisionsAll (iX, iY, iW, iH, itemID, acc, bottomRight)
|
||||
end
|
||||
else
|
||||
acc
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
getCollisionsVec (iX, iY, iW, iH, itemID, 0, items, acc)
|
||||
else acc
|
||||
|
||||
fun helpGetCollisions
|
||||
( iX
|
||||
, iY
|
||||
, iW
|
||||
, iH
|
||||
, itemID
|
||||
, acc
|
||||
, tree: t
|
||||
) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
let
|
||||
val acc =
|
||||
helpGetCollisions
|
||||
(iX, iY, iW, iH, itemID, acc, topLeft)
|
||||
|
||||
val acc =
|
||||
helpGetCollisions
|
||||
(iX, iY, iW, iH, itemID, acc, topRight)
|
||||
|
||||
val acc =
|
||||
helpGetCollisions
|
||||
( iX
|
||||
, iY
|
||||
, iW
|
||||
, iH
|
||||
, itemID
|
||||
, acc
|
||||
, bottomLeft
|
||||
)
|
||||
in
|
||||
helpGetCollisions
|
||||
( iX
|
||||
, iY
|
||||
, iW
|
||||
, iH
|
||||
, itemID
|
||||
, acc
|
||||
, bottomRight
|
||||
)
|
||||
end
|
||||
else
|
||||
acc
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
getCollisionsVec
|
||||
(iX, iY, iW, iH, itemID, 0, items, acc)
|
||||
else
|
||||
acc
|
||||
|
||||
fun getCollisions
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, itemID
|
||||
, tree
|
||||
) =
|
||||
helpGetCollisions
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, itemID
|
||||
, []
|
||||
, tree
|
||||
)
|
||||
fun helpGetCollisions (iX, iY, iW, iH, itemID, acc, tree: t) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
let
|
||||
val acc = helpGetCollisions (iX, iY, iW, iH, itemID, acc, topLeft)
|
||||
|
||||
val acc = helpGetCollisions (iX, iY, iW, iH, itemID, acc, topRight)
|
||||
|
||||
val acc = helpGetCollisions
|
||||
(iX, iY, iW, iH, itemID, acc, bottomLeft)
|
||||
in
|
||||
helpGetCollisions (iX, iY, iW, iH, itemID, acc, bottomRight)
|
||||
end
|
||||
else
|
||||
acc
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
getCollisionsVec (iX, iY, iW, iH, itemID, 0, items, acc)
|
||||
else
|
||||
acc
|
||||
|
||||
fun getCollisions (itemX, itemY, itemWidth, itemHeight, itemID, tree) =
|
||||
helpGetCollisions (itemX, itemY, itemWidth, itemHeight, itemID, [], tree)
|
||||
|
||||
(* no variant to represent 'no collision' case
|
||||
* because caller should only try getting collision side
|
||||
@@ -481,38 +405,25 @@ struct
|
||||
let
|
||||
val item = Vector.sub (elements, pos)
|
||||
in
|
||||
isColliding (iX, iY, iW, iH, itemID, item) orelse
|
||||
hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
|
||||
isColliding (iX, iY, iW, iH, itemID, item)
|
||||
orelse hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
|
||||
end
|
||||
|
||||
fun hasCollisionAt
|
||||
( iX
|
||||
, iY
|
||||
, iW
|
||||
, iH
|
||||
, itemID
|
||||
, tree
|
||||
) =
|
||||
fun hasCollisionAt (iX, iY, iW, iH, itemID, tree) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
hasCollisionAt
|
||||
(iX, iY, iW, iH, itemID, topLeft)
|
||||
orelse
|
||||
hasCollisionAt
|
||||
(iX, iY, iW, iH, itemID, topRight)
|
||||
orelse
|
||||
hasCollisionAt
|
||||
(iX, iY, iW, iH, itemID, bottomLeft)
|
||||
orelse
|
||||
hasCollisionAt
|
||||
(iX, iY, iW, iH, itemID, bottomRight)
|
||||
else
|
||||
hasCollisionAt (iX, iY, iW, iH, itemID, topLeft)
|
||||
orelse hasCollisionAt (iX, iY, iW, iH, itemID, topRight)
|
||||
orelse hasCollisionAt (iX, iY, iW, iH, itemID, bottomLeft)
|
||||
orelse hasCollisionAt (iX, iY, iW, iH, itemID, bottomRight)
|
||||
else
|
||||
false
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
hasCollisionAtVec (iX, iY, iW, iH, itemID, 0, items)
|
||||
else false
|
||||
else
|
||||
false
|
||||
|
||||
fun getItemIDVec (iX, iY, iW, iH, pos, elements) =
|
||||
if pos = Vector.length elements then
|
||||
@@ -545,7 +456,7 @@ struct
|
||||
end
|
||||
else
|
||||
~1
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
| LEAF {items, x, y, w, h} =>
|
||||
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
|
||||
getItemIDVec (iX, iY, iW, iH, 0, items)
|
||||
else
|
||||
|
||||
Reference in New Issue
Block a user