get player to react to wall quad tree
This commit is contained in:
109
fcore/player.sml
109
fcore/player.sml
@@ -5,53 +5,100 @@ struct
|
||||
|
||||
(* width/height *)
|
||||
val size = 35
|
||||
val realSize = 35.0
|
||||
|
||||
val moveBy = 5
|
||||
val jumpLimit = 55
|
||||
val jumpLimit = 150
|
||||
|
||||
type t = {yAxis: y_axis, xAxis: x_axis, health: int, x: int, y: int}
|
||||
|
||||
(* placeholder *)
|
||||
val initial: t =
|
||||
{yAxis = JUMPING 0, xAxis = STAY_STILL, health = 3, x = 500, y = 500}
|
||||
|
||||
(* placeholder *)
|
||||
fun getVec ({x, y, ...}: t) =
|
||||
Block.lerp (x, y, realSize, realSize, 1920.0, 1080.0, 0.5, 0.5, 0.5)
|
||||
|
||||
fun mkPlayer (health, xAxis, yAxis, x, y) =
|
||||
{yAxis = yAxis, xAxis = xAxis, health = health, x = x, y = y}
|
||||
|
||||
fun move (player: t) =
|
||||
fun checkWalls (yAxis, xAxis, x, y, health, lst) =
|
||||
let
|
||||
val {yAxis, xAxis, x, y, health} = player
|
||||
open QuadTree
|
||||
in
|
||||
case lst of
|
||||
(QUERY_ON_LEFT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
|
||||
val newX = wallX + wallWidth
|
||||
in
|
||||
checkWalls (yAxis, xAxis, newX, y, health, tl)
|
||||
end
|
||||
| (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
|
||||
val newX = wallX - size
|
||||
in
|
||||
checkWalls (yAxis, xAxis, newX, y, health, tl)
|
||||
end
|
||||
| (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {y = wallY, ...} = Wall.getID wallID
|
||||
val newY = wallY - size
|
||||
in
|
||||
checkWalls (yAxis, xAxis, x, newY, health, tl)
|
||||
end
|
||||
| (QUERY_ON_TOP_SIDE, wallID) :: tl =>
|
||||
checkWalls (yAxis, xAxis, x, y, health, tl)
|
||||
| [] => mkPlayer (health, xAxis, yAxis, x, y)
|
||||
end
|
||||
|
||||
(* todo: check for wall and platform collisions
|
||||
* in case analysis for both axis
|
||||
* *)
|
||||
val x =
|
||||
fun move ({x, y, xAxis, yAxis, health}: t) =
|
||||
let
|
||||
(* check against wall quad tree *)
|
||||
val desiredX =
|
||||
case xAxis of
|
||||
MOVE_LEFT =>
|
||||
(* todo: check if we are trying to move left
|
||||
* even though player is against wall.
|
||||
* In that case, keep same action (it is a sign for us to animate),
|
||||
* but don't actually move leftwards. *)
|
||||
x - moveBy
|
||||
| MOVE_RIGHT => (* todo: check against wall *) x + moveBy
|
||||
| STAY_STILL => x
|
||||
STAY_STILL => x
|
||||
| MOVE_LEFT => x - moveBy
|
||||
| MOVE_RIGHT => x + moveBy
|
||||
in
|
||||
case yAxis of
|
||||
JUMPING jumped =>
|
||||
(* check if we hit jump limit;
|
||||
* if we did, change to falling case.
|
||||
* *)
|
||||
if jumped + moveBy <= jumpLimit then
|
||||
ON_GROUND =>
|
||||
let
|
||||
val collisions = QuadTree.getCollisionSides
|
||||
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
|
||||
in
|
||||
checkWalls (yAxis, xAxis, desiredX, y, health, collisions)
|
||||
end
|
||||
| FALLING =>
|
||||
let
|
||||
val desiredY = y + moveBy
|
||||
val collisions = QuadTree.getCollisionSides
|
||||
(desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
|
||||
in
|
||||
checkWalls (yAxis, xAxis, desiredX, desiredY, health, collisions)
|
||||
end
|
||||
| JUMPING jumped =>
|
||||
if jumped + moveBy > jumpLimit then
|
||||
(* if we are above the jump limit, trigger a fall *)
|
||||
let
|
||||
val jumped = jumped + moveBy
|
||||
val yAxis = JUMPING jumped
|
||||
val y = y + moveBy
|
||||
val collisions = QuadTree.getCollisionSides
|
||||
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
|
||||
in
|
||||
mkPlayer (health, xAxis, yAxis, x, y)
|
||||
checkWalls (FALLING, xAxis, desiredX, y, health, collisions)
|
||||
end
|
||||
else
|
||||
mkPlayer (health, xAxis, FALLING, x, y)
|
||||
| FALLING =>
|
||||
(* todo: keep decrementing and falling down
|
||||
* until we hit ground or platform
|
||||
* *)
|
||||
mkPlayer (health, xAxis, yAxis, x, y - moveBy)
|
||||
| ON_GROUND => mkPlayer (health, xAxis, yAxis, x, y)
|
||||
(* jump *)
|
||||
let
|
||||
val newJumped = jumped + moveBy
|
||||
val yAxis = JUMPING newJumped
|
||||
val desiredY = y - moveBy
|
||||
|
||||
val collisions = QuadTree.getCollisionSides
|
||||
(desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
|
||||
in
|
||||
checkWalls (yAxis, xAxis, desiredX, desiredY, health, collisions)
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@@ -8,20 +8,18 @@ sig
|
||||
| QUERY_ON_RIGHT_SIDE
|
||||
| QUERY_ON_BOTTOM_SIDE
|
||||
|
||||
val insert : int * int * int * int *
|
||||
int * int * int * int *
|
||||
int * t -> t
|
||||
val insert: int * int * int * int * int * int * int * int * int * t -> t
|
||||
|
||||
val getCollisions : int * int * int * int *
|
||||
int * int * int * int *
|
||||
int * t -> int list
|
||||
val fromItem: int * int * int * int * int -> t
|
||||
|
||||
val getCollisionSides : int * int * int * int *
|
||||
int * int * int * int *
|
||||
int * t -> (collision_side * int) list
|
||||
val getCollisions: int * int * int * int * int * int * int * int * int * t
|
||||
-> int list
|
||||
|
||||
val getCollisionSides: int * int * int * int * int * int * int * int * int * t
|
||||
-> (collision_side * int) list
|
||||
end
|
||||
|
||||
structure QuadTree : QUAD_TREE =
|
||||
structure QuadTree: QUAD_TREE =
|
||||
struct
|
||||
type item = {itemID: int, startX: int, startY: int, width: int, height: int}
|
||||
|
||||
@@ -43,6 +41,14 @@ struct
|
||||
}
|
||||
| LEAF of item vector
|
||||
|
||||
fun fromItem (itemID, startX, startY, width, height) =
|
||||
let
|
||||
val item = mkItem (itemID, startX, startY, width, height)
|
||||
val elements = Vector.fromList [item]
|
||||
in
|
||||
LEAF elements
|
||||
end
|
||||
|
||||
(* max size of vector before we split it further *)
|
||||
val maxSize = 3
|
||||
|
||||
@@ -68,23 +74,47 @@ struct
|
||||
val middleY = quadY + halfHeight
|
||||
|
||||
val isInTopLeft = isItemInQuad
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, halfWidth, halfHeight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
)
|
||||
|
||||
val isInTopRight = isItemInQuad
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, middleX, quadY, halfWidth, halfHeight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, middleX
|
||||
, quadY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
)
|
||||
|
||||
val isInBottomLeft = isItemInQuad
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, middleY, halfWidth, halfHeight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, middleY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
)
|
||||
|
||||
val isInBottomRight = isItemInQuad
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, middleX, middleY, halfWidth, halfHeight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, middleX
|
||||
, middleY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
)
|
||||
in
|
||||
if isInTopLeft then TOP_LEFT
|
||||
@@ -135,9 +165,16 @@ struct
|
||||
end
|
||||
|
||||
fun insert
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, tree: t
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, tree: t
|
||||
) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
||||
@@ -146,8 +183,14 @@ struct
|
||||
* Else, add to elements vector in current node. *)
|
||||
(case
|
||||
whichQuadrant
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
)
|
||||
of
|
||||
TOP_LEFT =>
|
||||
@@ -160,9 +203,16 @@ struct
|
||||
val halfHeight = quadHeight div 2
|
||||
|
||||
val newTopLeft = insert
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, halfWidth, halfHeight
|
||||
, itemID, topLeft
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, topLeft
|
||||
)
|
||||
in
|
||||
NODE
|
||||
@@ -180,9 +230,16 @@ struct
|
||||
val middleX = quadX + halfWidth
|
||||
|
||||
val newTopRight = insert
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, middleX, quadY, halfWidth, halfHeight
|
||||
, itemID, topRight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, middleX
|
||||
, quadY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, topRight
|
||||
)
|
||||
in
|
||||
NODE
|
||||
@@ -200,9 +257,16 @@ struct
|
||||
val middleY = quadY + halfHeight
|
||||
|
||||
val newBottomLeft = insert
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, middleY, halfWidth, halfHeight
|
||||
, itemID, bottomLeft
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, middleY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, bottomLeft
|
||||
)
|
||||
in
|
||||
NODE
|
||||
@@ -221,9 +285,16 @@ struct
|
||||
val middleY = quadY + halfHeight
|
||||
|
||||
val newBottomRight = insert
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, middleX, middleY, halfWidth, halfHeight
|
||||
, itemID, bottomRight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, middleX
|
||||
, middleY
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, bottomRight
|
||||
)
|
||||
in
|
||||
NODE
|
||||
@@ -258,39 +329,85 @@ struct
|
||||
in
|
||||
(case
|
||||
whichQuadrant
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
)
|
||||
of
|
||||
TOP_LEFT =>
|
||||
splitLeaf
|
||||
( quadX, quadY, quadWidth, quadHeight
|
||||
, [item], [], [], [], []
|
||||
, elements, pos
|
||||
( quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, [item]
|
||||
, []
|
||||
, []
|
||||
, []
|
||||
, []
|
||||
, elements
|
||||
, pos
|
||||
)
|
||||
| TOP_RIGHT =>
|
||||
splitLeaf
|
||||
( quadX, quadY, quadWidth, quadHeight
|
||||
, [], [item], [], [], []
|
||||
, elements, pos
|
||||
( quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, []
|
||||
, [item]
|
||||
, []
|
||||
, []
|
||||
, []
|
||||
, elements
|
||||
, pos
|
||||
)
|
||||
| BOTTOM_LEFT =>
|
||||
splitLeaf
|
||||
( quadX, quadY, quadWidth, quadHeight
|
||||
, [], [], [item], [], []
|
||||
, elements, pos
|
||||
( quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, []
|
||||
, []
|
||||
, [item]
|
||||
, []
|
||||
, []
|
||||
, elements
|
||||
, pos
|
||||
)
|
||||
| BOTTOM_RIGHT =>
|
||||
splitLeaf
|
||||
( quadX, quadY, quadWidth, quadHeight
|
||||
, [], [], [], [item], []
|
||||
, elements, pos
|
||||
( quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, []
|
||||
, []
|
||||
, []
|
||||
, [item]
|
||||
, []
|
||||
, elements
|
||||
, pos
|
||||
)
|
||||
| PARENT_QUADRANT =>
|
||||
splitLeaf
|
||||
( quadX, quadY, quadWidth, quadHeight
|
||||
, [], [], [], [], [item]
|
||||
, elements, pos
|
||||
( quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, []
|
||||
, []
|
||||
, []
|
||||
, []
|
||||
, [item]
|
||||
, elements
|
||||
, pos
|
||||
))
|
||||
end
|
||||
else
|
||||
@@ -310,11 +427,8 @@ struct
|
||||
val endX = startX + width
|
||||
val endY = startY + height
|
||||
in
|
||||
iX < endX
|
||||
andalso itemEndX > startX
|
||||
andalso iY < endY
|
||||
andalso itemEndY > startY
|
||||
andalso itemID <> checkID
|
||||
iX < endX andalso itemEndX > startX andalso iY < endY
|
||||
andalso itemEndY > startY andalso itemID <> checkID
|
||||
end
|
||||
|
||||
fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
|
||||
@@ -323,150 +437,211 @@ struct
|
||||
else
|
||||
let
|
||||
val item = Vector.sub (elements, pos)
|
||||
val acc =
|
||||
if isColliding (iX, iY, iW, iH, itemID, item)
|
||||
then #itemID item :: acc
|
||||
val acc =
|
||||
if isColliding (iX, iY, iW, iH, itemID, item) then #itemID item :: acc
|
||||
else acc
|
||||
in
|
||||
getCollisionsVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
|
||||
end
|
||||
|
||||
fun getCollisionsAll
|
||||
( iX, iY, iW, iH, qW, qH
|
||||
, itemID, acc, tree
|
||||
) =
|
||||
case tree of
|
||||
fun getCollisionsAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
||||
let
|
||||
val acc =
|
||||
getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)
|
||||
val acc = getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)
|
||||
val halfWidth = qW div 2
|
||||
val halfHeight = qH div 2
|
||||
|
||||
val acc =
|
||||
getCollisionsAll
|
||||
( iX, iY, iW, iH, halfWidth, halfHeight
|
||||
, itemID, acc, topLeft
|
||||
)
|
||||
val acc = getCollisionsAll
|
||||
(iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)
|
||||
|
||||
val acc =
|
||||
getCollisionsAll
|
||||
( iX, iY, iW, iH, halfWidth, halfHeight
|
||||
, itemID, acc, topRight
|
||||
)
|
||||
val acc = getCollisionsAll
|
||||
(iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)
|
||||
|
||||
val acc =
|
||||
getCollisionsAll
|
||||
( iX, iY, iW, iH, halfWidth, halfHeight
|
||||
, itemID, acc, bottomLeft
|
||||
)
|
||||
val acc = getCollisionsAll
|
||||
(iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
|
||||
in
|
||||
getCollisionsAll
|
||||
( iX, iY, iW, iH, halfWidth, halfWidth
|
||||
, itemID, acc, bottomRight
|
||||
)
|
||||
(iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
|
||||
end
|
||||
| LEAF elements =>
|
||||
getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)
|
||||
|
||||
fun helpGetCollisions
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, acc, tree: t
|
||||
fun helpGetCollisions
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, acc
|
||||
, tree: t
|
||||
) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
||||
let
|
||||
(* get colliding elements in this node first *)
|
||||
val acc =
|
||||
getCollisionsVec
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, itemID, 0, elements, acc
|
||||
)
|
||||
val acc = getCollisionsVec
|
||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||
val halfWidth = quadWidth div 2
|
||||
val halfHeight = quadHeight div 2
|
||||
in
|
||||
(case whichQuadrant
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
)
|
||||
(case
|
||||
whichQuadrant
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
)
|
||||
of
|
||||
TOP_LEFT =>
|
||||
helpGetCollisions
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, halfWidth, halfHeight
|
||||
, itemID, acc, topLeft
|
||||
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
|
||||
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
|
||||
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
|
||||
| BOTTOM_RIGHT =>
|
||||
helpGetCollisions
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX + halfWidth
|
||||
, quadY + halfHeight
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, acc
|
||||
, bottomRight
|
||||
)
|
||||
| PARENT_QUADRANT =>
|
||||
| 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
|
||||
)
|
||||
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
|
||||
, 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)
|
||||
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
|
||||
| LEAF elements =>
|
||||
getCollisionsVec
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, itemID, 0, elements, acc
|
||||
)
|
||||
getCollisionsVec
|
||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||
|
||||
fun getCollisions
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, tree
|
||||
fun getCollisions
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, tree
|
||||
) =
|
||||
helpGetCollisions
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, [], tree
|
||||
helpGetCollisions
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, []
|
||||
, tree
|
||||
)
|
||||
|
||||
(* no variant to represent 'no collision' case
|
||||
@@ -505,26 +680,16 @@ struct
|
||||
val minXDist = iHalfW + cHalfW
|
||||
val minYDist = iHalfH + cHalfH
|
||||
|
||||
val depthX =
|
||||
if diffX > 0
|
||||
then minXDist - diffX
|
||||
else (~minXDist) - diffX
|
||||
val depthX = if diffX > 0 then minXDist - diffX else (~minXDist) - diffX
|
||||
|
||||
val depthY =
|
||||
if diffY > 0
|
||||
then minYDist - diffY
|
||||
else (~minYDist) - diffY
|
||||
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
|
||||
if depthX > 0 then QUERY_ON_LEFT_SIDE else QUERY_ON_RIGHT_SIDE
|
||||
else if depthY > 0 then
|
||||
QUERY_ON_TOP_SIDE
|
||||
else
|
||||
if depthY > 0 then
|
||||
QUERY_ON_TOP_SIDE
|
||||
else
|
||||
QUERY_ON_BOTTOM_SIDE
|
||||
QUERY_ON_BOTTOM_SIDE
|
||||
end
|
||||
|
||||
(* like getCollisionsVec, but instead of consing just the itemID,
|
||||
@@ -536,153 +701,215 @@ struct
|
||||
else
|
||||
let
|
||||
val item = Vector.sub (elements, pos)
|
||||
val acc =
|
||||
if isColliding (iX, iY, iW, iH, itemID, item) then
|
||||
let
|
||||
val side = getCollisionSide (iX, iY, iW, iH, item)
|
||||
in
|
||||
(side, #itemID item) :: acc
|
||||
val acc =
|
||||
if isColliding (iX, iY, iW, iH, itemID, item) then
|
||||
let val side = getCollisionSide (iX, iY, iW, iH, item)
|
||||
in (side, #itemID item) :: acc
|
||||
end
|
||||
else acc
|
||||
else
|
||||
acc
|
||||
in
|
||||
getCollisionSideVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
|
||||
end
|
||||
|
||||
fun getCollisionSidesAll
|
||||
( iX, iY, iW, iH, qW, qH
|
||||
, itemID, acc, tree
|
||||
) =
|
||||
case tree of
|
||||
fun getCollisionSidesAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
||||
let
|
||||
val acc =
|
||||
getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc)
|
||||
val acc = getCollisionSideVec
|
||||
(iX, iY, iW, iH, itemID, 0, elements, acc)
|
||||
val halfWidth = qW div 2
|
||||
val halfHeight = qH div 2
|
||||
|
||||
val acc =
|
||||
getCollisionSidesAll
|
||||
( iX, iY, iW, iH, halfWidth, halfHeight
|
||||
, itemID, acc, topLeft
|
||||
)
|
||||
val acc = getCollisionSidesAll
|
||||
(iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)
|
||||
|
||||
val acc =
|
||||
getCollisionSidesAll
|
||||
( iX, iY, iW, iH, halfWidth, halfHeight
|
||||
, itemID, acc, topRight
|
||||
)
|
||||
val acc = getCollisionSidesAll
|
||||
(iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)
|
||||
|
||||
val acc =
|
||||
getCollisionSidesAll
|
||||
( iX, iY, iW, iH, halfWidth, halfHeight
|
||||
, itemID, acc, bottomLeft
|
||||
)
|
||||
val acc = getCollisionSidesAll
|
||||
(iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
|
||||
in
|
||||
getCollisionSidesAll
|
||||
( iX, iY, iW, iH, halfWidth, halfWidth
|
||||
, itemID, acc, bottomRight
|
||||
)
|
||||
(iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
|
||||
end
|
||||
| LEAF elements =>
|
||||
getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc)
|
||||
|
||||
fun helpGetCollisionSides
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, acc, tree: t
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, acc
|
||||
, tree: t
|
||||
) =
|
||||
case tree of
|
||||
NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
|
||||
let
|
||||
(* get colliding elements in this node first *)
|
||||
val acc =
|
||||
getCollisionSideVec
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, itemID, 0, elements, acc
|
||||
)
|
||||
val acc = getCollisionSideVec
|
||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||
val halfWidth = quadWidth div 2
|
||||
val halfHeight = quadHeight div 2
|
||||
in
|
||||
(case whichQuadrant
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
)
|
||||
(case
|
||||
whichQuadrant
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
)
|
||||
of
|
||||
TOP_LEFT =>
|
||||
helpGetCollisionSides
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, halfWidth, halfHeight
|
||||
, itemID, acc, topLeft
|
||||
( 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
|
||||
( 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
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY + halfHeight
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, acc
|
||||
, bottomLeft
|
||||
)
|
||||
| BOTTOM_RIGHT =>
|
||||
| BOTTOM_RIGHT =>
|
||||
helpGetCollisionSides
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX + halfWidth, quadY + halfHeight
|
||||
, halfWidth, halfHeight
|
||||
, itemID, acc, bottomRight
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX + halfWidth
|
||||
, quadY + halfHeight
|
||||
, halfWidth
|
||||
, halfHeight
|
||||
, itemID
|
||||
, acc
|
||||
, bottomRight
|
||||
)
|
||||
| PARENT_QUADRANT =>
|
||||
| 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
|
||||
)
|
||||
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
|
||||
, 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)
|
||||
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
|
||||
| LEAF elements =>
|
||||
getCollisionSideVec
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, itemID, 0, elements, acc
|
||||
)
|
||||
(itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
|
||||
|
||||
fun getCollisionSides
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, tree
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, tree
|
||||
) =
|
||||
helpGetCollisionSides
|
||||
( itemX, itemY, itemWidth, itemHeight
|
||||
, quadX, quadY, quadWidth, quadHeight
|
||||
, itemID, [], tree
|
||||
( itemX
|
||||
, itemY
|
||||
, itemWidth
|
||||
, itemHeight
|
||||
, quadX
|
||||
, quadY
|
||||
, quadWidth
|
||||
, quadHeight
|
||||
, itemID
|
||||
, []
|
||||
, tree
|
||||
)
|
||||
end
|
||||
|
||||
@@ -1,9 +1,52 @@
|
||||
structure Wall =
|
||||
struct
|
||||
(* Wall or platform, where player can land after falling.
|
||||
* Difference between wall and platform is that one can jump to a platform
|
||||
* and go below it, but wall is completely opaque. *)
|
||||
datatype wall_type = WALL | PLATFORM
|
||||
type t = {id: int, x: int, y: int, width: int, height: int}
|
||||
|
||||
val wall1 = {id = 1, x = 0, y = 0, width = 100, height = 1080}
|
||||
val wall2 = {id = 2, x = 1820, y = 0, width = 100, height = 1080}
|
||||
val wall3 = {id = 3, x = 0, y = 980, width = 1920, height = 108}
|
||||
|
||||
val wallVec = Vector.fromList [wall1, wall2, wall3]
|
||||
|
||||
fun getID n =
|
||||
Vector.sub (wallVec, n - 1)
|
||||
|
||||
fun generateTree (pos, wallVec, acc) =
|
||||
if pos = Vector.length wallVec then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val {id, x, y, width, height} = Vector.sub (wallVec, pos)
|
||||
val acc = QuadTree.insert
|
||||
(x, y, width, height, 0, 0, 1920, 1080, id, acc)
|
||||
in
|
||||
generateTree (pos + 1, wallVec, acc)
|
||||
end
|
||||
|
||||
val tree =
|
||||
let
|
||||
val {id, x, y, width, height} = Vector.sub (wallVec, 0)
|
||||
val acc = QuadTree.fromItem (id, x, y, width, height)
|
||||
in
|
||||
generateTree (1, wallVec, acc)
|
||||
end
|
||||
|
||||
fun helpGenerateWalls (pos, wallVec, acc, winWidth, winHeight) =
|
||||
if pos = Vector.length wallVec then
|
||||
Vector.concat acc
|
||||
else
|
||||
let
|
||||
val wall = Vector.sub (wallVec, pos)
|
||||
val {x, y, width, height, ...} = wall
|
||||
val width = Real32.fromInt width
|
||||
val height = Real32.fromInt height
|
||||
val block = Block.lerp
|
||||
(x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0)
|
||||
val acc = block :: acc
|
||||
in
|
||||
helpGenerateWalls (pos + 1, wallVec, acc, winWidth, winHeight)
|
||||
end
|
||||
|
||||
fun generateWalls () =
|
||||
helpGenerateWalls (0, wallVec, [], 1920.0, 1080.0)
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user