functorise environment collision patches
This commit is contained in:
@@ -29,7 +29,7 @@ struct
|
||||
acc
|
||||
else
|
||||
let
|
||||
val patches = EnemyPhysics.getPatches enemy
|
||||
val patches = EnemyPhysics.getPhysicsPatches enemy
|
||||
val patches = EnemyPatch.W_HEALTH (health - 1) :: patches
|
||||
val enemy = EnemyPatch.withPatches (enemy, patches)
|
||||
in
|
||||
@@ -37,7 +37,7 @@ struct
|
||||
end
|
||||
else
|
||||
let
|
||||
val patches = EnemyPhysics.getPatches enemy
|
||||
val patches = EnemyPhysics.getPhysicsPatches enemy
|
||||
val enemy = EnemyPatch.withPatches (enemy, patches)
|
||||
in
|
||||
enemy :: acc
|
||||
|
||||
@@ -3,6 +3,8 @@ sig
|
||||
type t
|
||||
type patch
|
||||
|
||||
val entitySize: int
|
||||
|
||||
(* constants for physics *)
|
||||
val moveBy: int
|
||||
val floatLimit: int
|
||||
@@ -23,7 +25,7 @@ functor MakePhysics(Fn: PHYSICS_INPUT) =
|
||||
struct
|
||||
open GameType
|
||||
|
||||
fun getPatches input =
|
||||
fun getPhysicsPatches input =
|
||||
let
|
||||
val x = Fn.getX input
|
||||
val y = Fn.getY input
|
||||
@@ -70,6 +72,94 @@ struct
|
||||
[Fn.W_X desiredX, Fn.W_Y desiredY, Fn.W_Y_AXIS newYAxis]
|
||||
end
|
||||
end
|
||||
|
||||
fun getPlatformPatches (yAxis, platforms: platform vector, lst, acc) =
|
||||
let
|
||||
open QuadTree
|
||||
in
|
||||
case lst of
|
||||
platID :: tl =>
|
||||
(case yAxis of
|
||||
DROP_BELOW_PLATFORM =>
|
||||
(* pass through, allowing player to drop below the platform *)
|
||||
getPlatformPatches (yAxis, platforms, tl, acc)
|
||||
| JUMPING _ =>
|
||||
(* pass through, allowing player to jump above the platform *)
|
||||
getPlatformPatches (yAxis, platforms, tl, acc)
|
||||
| _ =>
|
||||
let
|
||||
(* default case:
|
||||
* player will land on platform and stay on the ground there. *)
|
||||
val {y = platY, ...} = Vector.sub (platforms, platID - 1)
|
||||
|
||||
val newY = platY - Fn.entitySize
|
||||
val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
|
||||
in
|
||||
getPlatformPatches (yAxis, platforms, tl, acc)
|
||||
end)
|
||||
| [] => acc
|
||||
end
|
||||
|
||||
fun getWallPatches (walls: wall vector, lst, acc) =
|
||||
let
|
||||
open QuadTree
|
||||
in
|
||||
case lst of
|
||||
(QUERY_ON_LEFT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {x = wallX, width = wallWidth, ...} =
|
||||
Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newX = wallX + wallWidth
|
||||
val acc = Fn.W_X newX :: acc
|
||||
in
|
||||
getWallPatches (walls, tl, acc)
|
||||
end
|
||||
| (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
|
||||
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
|
||||
|
||||
fun getEnvironmentPatches (input, walls, wallTree, platforms, platformTree) =
|
||||
let
|
||||
(* first apply physics *)
|
||||
|
||||
(* then react to platform and environment collisions *)
|
||||
val x = Fn.getX input
|
||||
val y = Fn.getY input
|
||||
val yAxis = Fn.getYAxis input
|
||||
|
||||
val size = Fn.entitySize
|
||||
val ww = Constants.worldWidth
|
||||
val wh = Constants.worldHeight
|
||||
|
||||
val platCollisions = QuadTree.getCollisionsBelow
|
||||
(x, y, size, size, 0, 0, ww, wh, 0, platformTree)
|
||||
val acc = getPlatformPatches (yAxis, platforms, platCollisions, [])
|
||||
|
||||
val wallCollisions = QuadTree.getCollisionSides
|
||||
(x, y, size, size, 0, 0, ww, wh, 0, wallTree)
|
||||
in
|
||||
getWallPatches (walls, wallCollisions, acc)
|
||||
end
|
||||
end
|
||||
|
||||
structure PlayerPhysics =
|
||||
@@ -78,6 +168,8 @@ structure PlayerPhysics =
|
||||
type t = GameType.player
|
||||
type patch = PlayerPatch.player_patch
|
||||
|
||||
val entitySize = Constants.playerSize
|
||||
|
||||
(* constants for physics *)
|
||||
val moveBy = Constants.movePlayerBy
|
||||
val floatLimit = Constants.floatLimit
|
||||
@@ -101,6 +193,8 @@ structure EnemyPhysics =
|
||||
type t = GameType.enemy
|
||||
type patch = EnemyPatch.enemy_patch
|
||||
|
||||
val entitySize = Constants.enemySize
|
||||
|
||||
(* constants for physics *)
|
||||
val moveBy = Constants.moveEnemyBy
|
||||
val floatLimit = Constants.floatLimit
|
||||
|
||||
@@ -49,92 +49,6 @@ struct
|
||||
if jumpPressed then (* apply gravity *) FALLING else JUMPING 0
|
||||
| _ => prevAxis
|
||||
|
||||
fun checkWalls (player, walls, lst, acc) =
|
||||
let
|
||||
open QuadTree
|
||||
in
|
||||
case lst of
|
||||
(QUERY_ON_LEFT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {x = wallX, width = wallWidth, ...} =
|
||||
Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newX = wallX + wallWidth
|
||||
val acc = W_X newX :: acc
|
||||
in
|
||||
checkWalls (player, walls, tl, acc)
|
||||
end
|
||||
| (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {x = wallX, width = wallWidth, ...} =
|
||||
Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newX = wallX - Constants.playerSize
|
||||
val acc = W_X newX :: acc
|
||||
in
|
||||
checkWalls (player, walls, tl, acc)
|
||||
end
|
||||
| (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {y = wallY, ...} = Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newY = wallY - Constants.playerSize
|
||||
val acc = W_Y_AXIS ON_GROUND :: W_Y newY :: acc
|
||||
in
|
||||
checkWalls (player, walls, tl, acc)
|
||||
end
|
||||
| (QUERY_ON_TOP_SIDE, wallID) :: tl => checkWalls (player, walls, tl, acc)
|
||||
| [] => acc
|
||||
end
|
||||
|
||||
fun checkPlatforms (player, platforms, lst, acc) =
|
||||
let
|
||||
open QuadTree
|
||||
in
|
||||
case lst of
|
||||
platID :: tl =>
|
||||
(case #yAxis player of
|
||||
DROP_BELOW_PLATFORM =>
|
||||
(* pass through, allowing player to drop below the platform *)
|
||||
checkPlatforms (player, platforms, tl, acc)
|
||||
| JUMPING _ =>
|
||||
(* pass through, allowing player to jump above the platform *)
|
||||
checkPlatforms (player, platforms, tl, acc)
|
||||
| _ =>
|
||||
let
|
||||
(* default case:
|
||||
* player will land on platform and stay on the ground there. *)
|
||||
val {y = platY, ...} = Vector.sub (platforms, platID - 1)
|
||||
|
||||
val newY = platY - Constants.playerSize
|
||||
val acc = W_Y_AXIS ON_GROUND :: W_Y newY :: acc
|
||||
in
|
||||
checkPlatforms (player, platforms, tl, acc)
|
||||
end)
|
||||
| [] => acc
|
||||
end
|
||||
|
||||
(* only checks for collisions with environment (walls and platforms) *)
|
||||
fun getEnvironmentPatches (player, game) =
|
||||
let
|
||||
val {walls, wallTree, platformTree, platforms, ...} = game
|
||||
|
||||
val {x, y, ...} = player
|
||||
|
||||
val size = Constants.playerSize
|
||||
val ww = Constants.worldWidth
|
||||
val wh = Constants.worldHeight
|
||||
|
||||
val platCollisions = QuadTree.getCollisionsBelow
|
||||
(x, y, size, size, 0, 0, ww, wh, 0, platformTree)
|
||||
val acc = checkPlatforms (player, platforms, platCollisions, [])
|
||||
|
||||
val wallCollisions = QuadTree.getCollisionSides
|
||||
(x, y, size, size, 0, 0, ww, wh, 0, wallTree)
|
||||
in
|
||||
checkWalls (player, walls, wallCollisions, acc)
|
||||
end
|
||||
|
||||
fun getJumpPatches (player, upHeld, downHeld, acc) =
|
||||
let
|
||||
val {yAxis, jumpPressed, ...} = player
|
||||
@@ -432,10 +346,12 @@ struct
|
||||
PlayerPatch.withPatches (player, patches)
|
||||
end
|
||||
|
||||
val patches = PlayerPhysics.getPatches player
|
||||
val patches = PlayerPhysics.getPhysicsPatches player
|
||||
val player = PlayerPatch.withPatches (player, patches)
|
||||
|
||||
val patches = getEnvironmentPatches (player, game)
|
||||
val {walls, wallTree, platforms, platformTree, ...} = game
|
||||
val patches = PlayerPhysics.getEnvironmentPatches
|
||||
(player, walls, wallTree, platforms, platformTree)
|
||||
in
|
||||
PlayerPatch.withPatches (player, patches)
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user