humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

get player to react to wall quad tree

Browse Source
This commit is contained in:
Humza Shahid
2024-12-13 22:48:34 +00:00
parent 9d42e14b2f
commit 9144c97fba
6 changed files with 741 additions and 308 deletions
Download Patch File Download Diff File Expand all files Collapse all files

109
fcore/player.sml
View File

@@ -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

757
fcore/quad-tree.sml
View File

@@ -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

51
fcore/wall.sml
View File

@@ -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

11
message-types/input-msg.sml Normal file
View File

@@ -0,0 +1,11 @@
signature INPUT_MSG =
sig
datatype t =
RESIZE_WINDOW of {width: int, height: int}
end
structure InputMsg =
struct
datatype t =
RESIZE_WINDOW of {width: int, height: int}
end

4
oms.mlb
View File

@@ -1,6 +1,8 @@
$(SML_LIB)/basis/basis.mlb
(* fcore *)
message-types/input-msg.sml
ann
"allowVectorExps true"
in
@@ -8,8 +10,8 @@ in
end
fcore/quad-tree.sml
fcore/player.sml
fcore/wall.sml
fcore/player.sml
(* shell *)
$(SML_LIB)/basis/mlton.mlb

117
shell/gl-draw.sml
View File

@@ -2,7 +2,16 @@ structure GlDraw =
struct
open CML
type t = { window: MLton.Pointer.t }
type t =
{ window: MLton.Pointer.t
, mbox: InputMsg.t Mailbox.mbox
, wallVertexBuffer: Word32.word
, wallProgram: Word32.word
, wallLength: int
, playerVertexBuffer: Word32.word
, playerProgram: Word32.word
, playerLength: int
}
fun createShader (shaderType, shaderString) =
let
@@ -25,17 +34,86 @@ struct
fun create window =
let
val mbox = Mailbox.mailbox ()
(* create vertex buffer, program, etc. *)
val textVertexBuffer = Gles3.createBuffer ()
val xyrgbVertexShader = createShader
(Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString)
val rgbFragmentShader = createShader
(Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString)
val placeholderProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
(* wall here includes both walls and platforms *)
val wallVertexBuffer = Gles3.createBuffer ()
val wallProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
val playerVertexBuffer = Gles3.createBuffer ()
val playerProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
in
{window = window}
{ window = window
, mbox = mbox
, wallVertexBuffer = wallVertexBuffer
, wallProgram = wallProgram
, wallLength = 0
, playerVertexBuffer = playerVertexBuffer
, playerProgram = playerProgram
, playerLength = 0
}
end
fun uploadWall (shellState: t, vec) =
let
val
{ window
, mbox
, playerVertexBuffer
, playerProgram
, playerLength
, wallVertexBuffer
, wallProgram
, wallLength = _
} = shellState
val _ = Gles3.bindBuffer wallVertexBuffer
val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
val newWallLength = Vector.length vec div 5
in
{ window = window
, mbox = mbox
, playerVertexBuffer = playerVertexBuffer
, playerProgram = playerProgram
, playerLength = playerLength
, wallVertexBuffer = wallVertexBuffer
, wallProgram = wallProgram
, wallLength = newWallLength
}
end
fun uploadPlayer (shellState: t, vec) =
let
val
{ window
, mbox
, wallVertexBuffer
, wallProgram
, wallLength
, playerVertexBuffer
, playerProgram
, playerLength = _
} = shellState
val _ = Gles3.bindBuffer playerVertexBuffer
val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
val newPlayerLength = Vector.length vec div 5
in
{ window = window
, mbox = mbox
, wallVertexBuffer = wallVertexBuffer
, wallProgram = wallProgram
, wallLength = wallLength
, playerVertexBuffer = playerVertexBuffer
, playerProgram = playerProgram
, playerLength = newPlayerLength
}
end
fun drawXyrgb (vertexBuffer, program, drawLength) =
@@ -57,7 +135,21 @@ struct
else
()
fun helpLoop (shellState as {window, ...}: t) =
fun drawWall ({wallVertexBuffer, wallProgram, wallLength, ...}: t) =
drawXyrgb (wallVertexBuffer, wallProgram, wallLength)
fun drawPlayer ({playerVertexBuffer, playerProgram, playerLength, ...}: t) =
drawXyrgb (playerVertexBuffer, playerProgram, playerLength)
fun draw (shellState: t) =
let
val _ = drawWall shellState
val _ = drawPlayer shellState
in
()
end
fun helpLoop (shellState as {window, ...}: t, player) =
case Glfw.windowShouldClose window of
false =>
let
@@ -69,15 +161,26 @@ struct
* - consume draw messages
* - finally, draw
* *)
val wallVec = Wall.generateWalls ()
val shellState = uploadWall (shellState, wallVec)
val player = Player.move player
val playerVec = Player.getVec player
val shellState = uploadWall (shellState, wallVec)
val shellState = uploadPlayer (shellState, playerVec)
val _ = draw shellState
val _ = Glfw.swapBuffers window
val _ = Glfw.waitEvents ()
in
helpLoop shellState
helpLoop (shellState, player)
end
| true => Glfw.terminate ()
fun loop window =
let val shellState = create window
in helpLoop shellState
in helpLoop (shellState, Player.initial)
end
end