move quad tree helper functions which are useful in quad-tree.sml and will be useful in quad-tree-fold.sml, to quad-tree-type.sml, so quad-tree.sml only exports public API suitable for users
This commit is contained in:
1
fcore/quad-tree-fold.sml
Normal file
1
fcore/quad-tree-fold.sml
Normal file
@@ -0,0 +1 @@
|
||||
|
||||
@@ -15,12 +15,17 @@ sig
|
||||
}
|
||||
| LEAF of {items: item vector, x: int, y: int, w: int, h: int}
|
||||
|
||||
datatype quadrant =
|
||||
TOP_LEFT
|
||||
| TOP_RIGHT
|
||||
| BOTTOM_LEFT
|
||||
| BOTTOM_RIGHT
|
||||
| PARENT_QUADRANT
|
||||
val isColliding: int * int * int * int * int * int * int * int -> bool
|
||||
|
||||
val isCollidingPlus: int * int * int * int * int * int * int * int -> 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 QuadTreeType :> QUAD_TREE_TYPE =
|
||||
@@ -40,10 +45,84 @@ struct
|
||||
}
|
||||
| LEAF of {items: item vector, x: int, y: int, w: int, h: int}
|
||||
|
||||
datatype quadrant =
|
||||
TOP_LEFT
|
||||
| TOP_RIGHT
|
||||
| BOTTOM_LEFT
|
||||
| BOTTOM_RIGHT
|
||||
| PARENT_QUADRANT
|
||||
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 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
|
||||
|
||||
@@ -2,12 +2,6 @@ signature QUAD_TREE =
|
||||
sig
|
||||
type t
|
||||
|
||||
datatype collision_side =
|
||||
QUERY_ON_LEFT_SIDE
|
||||
| QUERY_ON_TOP_SIDE
|
||||
| QUERY_ON_RIGHT_SIDE
|
||||
| QUERY_ON_BOTTOM_SIDE
|
||||
|
||||
val insert: int * int * int * int * int * t -> t
|
||||
|
||||
val getCollisions: int * int * int * int * int * t -> int list
|
||||
@@ -30,87 +24,6 @@ struct
|
||||
fun create (width, 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
|
||||
|
||||
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 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
|
||||
|
||||
fun mkItem (id, startX, startY, width, height) : item =
|
||||
{ itemID = id
|
||||
, startX = startX
|
||||
@@ -350,54 +263,6 @@ struct
|
||||
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
|
||||
* after checking that there is any collision. *)
|
||||
datatype collision_side =
|
||||
QUERY_ON_LEFT_SIDE
|
||||
| QUERY_ON_TOP_SIDE
|
||||
| QUERY_ON_RIGHT_SIDE
|
||||
| QUERY_ON_BOTTOM_SIDE
|
||||
|
||||
(* getCollisionSide function ported from this answer:
|
||||
* https://stackoverflow.com/a/56607347
|
||||
* *)
|
||||
fun getCollisionSide (iX, iY, iW, iH, checkWith: item) =
|
||||
let
|
||||
val iFinishX = iX + iW
|
||||
val iFinishY = iY + iH
|
||||
val iHalfW = iW div 2
|
||||
val iHalfH = iH div 2
|
||||
val iCentreX = iX + iHalfW
|
||||
val iCentreY = iY + iHalfH
|
||||
|
||||
val {startX = cX, startY = cY, width = cW, height = cH, ...} = checkWith
|
||||
|
||||
val cFinishX = cX + cW
|
||||
val cFinishY = cY + cH
|
||||
val cHalfW = cW div 2
|
||||
val cHalfH = cH div 2
|
||||
val cCentreX = cX + cHalfW
|
||||
val cCentreY = cY + cHalfH
|
||||
|
||||
val diffX = iCentreX - cCentreX
|
||||
val diffY = iCentreY - cCentreY
|
||||
|
||||
val minXDist = iHalfW + cHalfW
|
||||
val minYDist = iHalfH + cHalfH
|
||||
|
||||
val depthX = if diffX > 0 then minXDist - diffX else (~minXDist) - diffX
|
||||
|
||||
val depthY = if diffY > 0 then minYDist - diffY else (~minYDist) - diffY
|
||||
in
|
||||
if abs depthX < abs depthY then
|
||||
if depthX > 0 then QUERY_ON_LEFT_SIDE else QUERY_ON_RIGHT_SIDE
|
||||
else if depthY > 0 then
|
||||
QUERY_ON_TOP_SIDE
|
||||
else
|
||||
QUERY_ON_BOTTOM_SIDE
|
||||
end
|
||||
|
||||
fun hasCollisionAtVec (iX, iY, iW, iH, itemID, pos, elements) =
|
||||
if pos = Vector.length elements then
|
||||
false
|
||||
|
||||
Reference in New Issue
Block a user