refactor player.sml for easier extensibility when fields are added to player type (we accept a list of values to change, instead of destructuring the player.sml values on each function call)
This commit is contained in:
@@ -19,11 +19,14 @@ sig
|
||||
|
||||
datatype facing = FACING_LEFT | FACING_RIGHT
|
||||
|
||||
datatype main_attack = MAIN_UNUSED | MAIN_ATTACKING of int
|
||||
|
||||
type player =
|
||||
{ yAxis: player_y_axis
|
||||
, xAxis: player_x_axis
|
||||
, recoil: player_recoil
|
||||
, attacked: player_attacked
|
||||
, mainAttack: main_attack
|
||||
, facing: facing
|
||||
, health: int
|
||||
, x: int
|
||||
@@ -68,11 +71,14 @@ struct
|
||||
|
||||
datatype facing = FACING_LEFT | FACING_RIGHT
|
||||
|
||||
datatype main_attack = MAIN_UNUSED | MAIN_ATTACKING of int
|
||||
|
||||
type player =
|
||||
{ yAxis: player_y_axis
|
||||
, xAxis: player_x_axis
|
||||
, recoil: player_recoil
|
||||
, attacked: player_attacked
|
||||
, mainAttack: main_attack
|
||||
, facing: facing
|
||||
, health: int
|
||||
, x: int
|
||||
@@ -99,6 +105,7 @@ struct
|
||||
, xAxis = STAY_STILL
|
||||
, recoil = NO_RECOIL
|
||||
, attacked = NOT_ATTACKED
|
||||
, mainAttack = MAIN_UNUSED
|
||||
, facing = FACING_RIGHT
|
||||
, health = 3
|
||||
, x = 500
|
||||
|
||||
879
fcore/player.sml
879
fcore/player.sml
@@ -2,6 +2,198 @@ structure Player =
|
||||
struct
|
||||
open GameType
|
||||
|
||||
datatype patch =
|
||||
W_X_AXIS of player_x_axis
|
||||
| W_Y_AXIS of player_y_axis
|
||||
| W_RECOIL of player_recoil
|
||||
| W_ATTACKED of player_attacked
|
||||
| W_MAIN_ATTACK of main_attack
|
||||
| W_FACING of facing
|
||||
| W_HEALTH of int
|
||||
| W_X of int
|
||||
| W_Y of int
|
||||
| W_JUMP_PRESSED of bool
|
||||
|
||||
fun mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
) =
|
||||
{ yAxis = yAxis
|
||||
, xAxis = xAxis
|
||||
, recoil = recoil
|
||||
, attacked = attacked
|
||||
, mainAttack = MAIN_UNUSED
|
||||
, facing = facing
|
||||
, health = health
|
||||
, x = x
|
||||
, y = y
|
||||
, jumpPressed = jumpPressed
|
||||
}
|
||||
|
||||
fun withPatch (player: player, patch) =
|
||||
let
|
||||
val
|
||||
{ yAxis
|
||||
, xAxis
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
, health
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
} = player
|
||||
in
|
||||
case patch of
|
||||
W_X_AXIS xAxis =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_Y_AXIS yAxis =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_RECOIL recoil =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_ATTACKED attacked =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_MAIN_ATTACK mainAttack =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_FACING facing =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_HEALTH health =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_X x =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_Y y =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
| W_JUMP_PRESSED jumpPressed =>
|
||||
mkPlayer
|
||||
( health
|
||||
, xAxis
|
||||
, yAxis
|
||||
, x
|
||||
, y
|
||||
, jumpPressed
|
||||
, recoil
|
||||
, attacked
|
||||
, mainAttack
|
||||
, facing
|
||||
)
|
||||
end
|
||||
|
||||
fun withPatches (player: player, lst) =
|
||||
case lst of
|
||||
hd :: tl =>
|
||||
let val player = withPatch (player, hd)
|
||||
in withPatches (player, tl)
|
||||
end
|
||||
| [] => player
|
||||
|
||||
(* width/height *)
|
||||
val size = 35
|
||||
val realSize = 35.0
|
||||
@@ -13,317 +205,7 @@ struct
|
||||
val recoilLimit = 15
|
||||
val attackLimit = 55
|
||||
|
||||
fun mkPlayer
|
||||
( health, xAxis, yAxis, x, y
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing
|
||||
) =
|
||||
{ yAxis = yAxis
|
||||
, xAxis = xAxis
|
||||
, recoil = recoil
|
||||
, attacked = attacked
|
||||
, facing = facing
|
||||
, health = health
|
||||
, x = x
|
||||
, y = y
|
||||
, jumpPressed = jumpPressed
|
||||
}
|
||||
|
||||
fun checkWalls
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, lst, game: game_type
|
||||
) =
|
||||
let
|
||||
open QuadTree
|
||||
in
|
||||
case lst of
|
||||
(QUERY_ON_LEFT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {walls, ...} = game
|
||||
val {x = wallX, width = wallWidth, ...} =
|
||||
Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newX = wallX + wallWidth
|
||||
in
|
||||
checkWalls
|
||||
( yAxis, xAxis, newX, y, health, jumpPressed
|
||||
, recoil, attacked, facing, tl, game
|
||||
)
|
||||
end
|
||||
| (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {walls, ...} = game
|
||||
val {x = wallX, width = wallWidth, ...} =
|
||||
Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newX = wallX - size
|
||||
in
|
||||
checkWalls
|
||||
( yAxis, xAxis, newX, y, health, jumpPressed
|
||||
, recoil, attacked, facing, tl, game
|
||||
)
|
||||
end
|
||||
| (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
|
||||
let
|
||||
val {walls, ...} = game
|
||||
val {y = wallY, ...} = Vector.sub (walls, wallID - 1)
|
||||
|
||||
val newY = wallY - size
|
||||
in
|
||||
checkWalls
|
||||
( ON_GROUND, xAxis, x, newY, health, jumpPressed
|
||||
, recoil, attacked, facing, tl, game
|
||||
)
|
||||
end
|
||||
| (QUERY_ON_TOP_SIDE, wallID) :: tl =>
|
||||
checkWalls
|
||||
( yAxis, xAxis, x, y, health, jumpPressed
|
||||
, recoil, attacked, facing, tl, game
|
||||
)
|
||||
| [] =>
|
||||
mkPlayer
|
||||
( health, xAxis, yAxis, x, y
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
)
|
||||
end
|
||||
|
||||
fun helpCheckPlatforms
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, platList, wallList, game
|
||||
) =
|
||||
let
|
||||
open QuadTree
|
||||
in
|
||||
case platList of
|
||||
platID :: tl =>
|
||||
(case yAxis of
|
||||
DROP_BELOW_PLATFORM =>
|
||||
(* pass through, allowing player to drop below the platform *)
|
||||
helpCheckPlatforms
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, tl, wallList, game
|
||||
)
|
||||
| JUMPING _ =>
|
||||
(* pass through, allowing player to jump above the platform *)
|
||||
helpCheckPlatforms
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, tl, wallList, game
|
||||
)
|
||||
| _ =>
|
||||
let
|
||||
(* default case:
|
||||
* player will land on platform and stay on the ground there. *)
|
||||
|
||||
val {platforms, ...} = game
|
||||
val {y = platY, ...} = Vector.sub (platforms, platID - 1)
|
||||
|
||||
val newY = platY - size
|
||||
in
|
||||
helpCheckPlatforms
|
||||
( ON_GROUND, xAxis, x, newY, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, tl, wallList, game
|
||||
)
|
||||
end)
|
||||
| [] =>
|
||||
checkWalls
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, wallList, game
|
||||
)
|
||||
end
|
||||
|
||||
fun checkEnemies
|
||||
( yAxis, xAxis, x, y, health, jumpPressed, recoil, attacked, facing
|
||||
, enemyCollisions, platCollisions, wallCollisions, game
|
||||
) =
|
||||
case enemyCollisions of
|
||||
id :: tl =>
|
||||
let
|
||||
val newRecoil =
|
||||
(* check if collision is closer to left side of enemy or right
|
||||
* and then chose appropriate direction to recoil in *)
|
||||
let
|
||||
val pFinishX = x + size
|
||||
val pHalfW = size div 2
|
||||
val pCentreX = x + pHalfW
|
||||
|
||||
val {x = ex, y = ey, ...} = Vector.sub (#enemies game, id - 1)
|
||||
val eFinishX = ex + Enemy.size
|
||||
val eHalfW = Enemy.size div 2
|
||||
val eCentreX = ex + eHalfW
|
||||
in
|
||||
if eCentreX < pCentreX then
|
||||
RECOIL_RIGHT 0
|
||||
else
|
||||
RECOIL_LEFT 0
|
||||
end
|
||||
|
||||
val facing =
|
||||
case newRecoil of
|
||||
RECOIL_LEFT _ => FACING_RIGHT
|
||||
| RECOIL_RIGHT _ => FACING_LEFT
|
||||
| NO_RECOIL => facing
|
||||
|
||||
val attacked = ATTACKED 0
|
||||
in
|
||||
checkEnemies
|
||||
( FALLING, STAY_STILL, x, y, health
|
||||
, jumpPressed, newRecoil, ATTACKED 0, facing
|
||||
, tl, platCollisions, wallCollisions, game
|
||||
)
|
||||
end
|
||||
| [] =>
|
||||
helpCheckPlatforms
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, platCollisions, wallCollisions, game
|
||||
)
|
||||
|
||||
fun checkCollisions
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil
|
||||
, attacked, facing, game
|
||||
) =
|
||||
let
|
||||
val {wallTree, platformTree, enemyTree, ...} = game
|
||||
|
||||
(* control flow is: check enemies -> check platforms -> check walls
|
||||
* but this is not visible in this function as everything is implemented
|
||||
* by tail call.
|
||||
* So, when one function hits the end of its collision list,
|
||||
* it calls the next function at its tail. *)
|
||||
|
||||
val platCollisions = QuadTree.getCollisionsBelow
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, platformTree)
|
||||
|
||||
val wallCollisions = QuadTree.getCollisionSides
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, wallTree)
|
||||
in
|
||||
(* skip enemy collisions if player is in attacked state
|
||||
* because games often offer a short cooldown period
|
||||
* where player can walk through enemies without receiving damage
|
||||
* in which case enemy collisions don't count
|
||||
* *)
|
||||
case attacked of
|
||||
NOT_ATTACKED =>
|
||||
let
|
||||
val enemyCollisions = QuadTree.getCollisions
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, enemyTree)
|
||||
in
|
||||
checkEnemies
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, enemyCollisions, platCollisions, wallCollisions, game
|
||||
)
|
||||
end
|
||||
| ATTACKED amt =>
|
||||
if amt = attackLimit then
|
||||
(* if we hit limit, exit ATTACKED phase
|
||||
* and react to enemy collisions again
|
||||
* *)
|
||||
let
|
||||
val enemyCollisions = QuadTree.getCollisions
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, enemyTree)
|
||||
in
|
||||
checkEnemies
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, NOT_ATTACKED, facing
|
||||
, enemyCollisions, platCollisions, wallCollisions, game
|
||||
)
|
||||
end
|
||||
else
|
||||
let
|
||||
val amt = amt + 1
|
||||
val attacked = ATTACKED amt
|
||||
in
|
||||
helpCheckPlatforms
|
||||
( yAxis, xAxis, x, y, health
|
||||
, jumpPressed, recoil, attacked, facing
|
||||
, platCollisions, wallCollisions, game
|
||||
)
|
||||
end
|
||||
end
|
||||
|
||||
fun helpMove
|
||||
( x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
) =
|
||||
let
|
||||
(* check against wall quad tree *)
|
||||
val desiredX =
|
||||
case xAxis of
|
||||
STAY_STILL => x
|
||||
| MOVE_LEFT => x - moveBy
|
||||
| MOVE_RIGHT => x + moveBy
|
||||
in
|
||||
case yAxis of
|
||||
ON_GROUND =>
|
||||
checkCollisions
|
||||
( yAxis, xAxis, desiredX, y, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
| FLOATING floated =>
|
||||
let
|
||||
val yAxis =
|
||||
if floated = floatLimit then FALLING else FLOATING (floated + 1)
|
||||
in
|
||||
checkCollisions
|
||||
( yAxis, xAxis, desiredX, y, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
end
|
||||
| FALLING =>
|
||||
let
|
||||
val desiredY = y + moveBy
|
||||
in
|
||||
checkCollisions
|
||||
( yAxis, xAxis, desiredX, desiredY, health
|
||||
, jumpPressed, recoil, attacked, facing, game
|
||||
)
|
||||
end
|
||||
| DROP_BELOW_PLATFORM =>
|
||||
let
|
||||
val desiredY = y + moveBy
|
||||
in
|
||||
checkCollisions
|
||||
( yAxis, xAxis, desiredX, desiredY, health
|
||||
, jumpPressed, recoil, attacked, facing, game
|
||||
)
|
||||
end
|
||||
| JUMPING jumped =>
|
||||
if jumped + moveBy > jumpLimit then
|
||||
(* if we are above the jump limit, trigger a fall *)
|
||||
let
|
||||
val newYAxis = FLOATING 0
|
||||
in
|
||||
checkCollisions
|
||||
( newYAxis, xAxis, desiredX, y, health
|
||||
, jumpPressed, recoil, attacked, facing, game
|
||||
)
|
||||
end
|
||||
else
|
||||
(* jump *)
|
||||
let
|
||||
val newJumped = jumped + moveBy
|
||||
val newYAxis = JUMPING newJumped
|
||||
val desiredY = y - moveBy
|
||||
in
|
||||
checkCollisions
|
||||
( newYAxis, xAxis, desiredX, desiredY
|
||||
, health, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
end
|
||||
end
|
||||
|
||||
(* helper functions checking input *)
|
||||
fun getXAxis (lh, rh) =
|
||||
case (lh, rh) of
|
||||
(false, false) => STAY_STILL
|
||||
@@ -365,17 +247,211 @@ struct
|
||||
fun onJumpPressed (prevAxis, jumpPressed) =
|
||||
case prevAxis of
|
||||
ON_GROUND =>
|
||||
if jumpPressed then
|
||||
(* apply gravity *)
|
||||
FALLING
|
||||
else
|
||||
JUMPING 0
|
||||
if jumpPressed then (* apply gravity *) FALLING else JUMPING 0
|
||||
| _ => prevAxis
|
||||
|
||||
fun handleInput (game: game_type, input, recoil) =
|
||||
fun checkWalls (player, walls, lst, acc) =
|
||||
let
|
||||
val {x, y, yAxis, health, jumpPressed, attacked, facing, ...} = #player game
|
||||
val {leftHeld, rightHeld, upHeld, downHeld} = input
|
||||
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 - size
|
||||
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 - size
|
||||
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 - size
|
||||
val acc = W_Y_AXIS ON_GROUND :: W_Y newY :: acc
|
||||
in
|
||||
checkPlatforms (player, platforms, tl, acc)
|
||||
end)
|
||||
| [] => acc
|
||||
end
|
||||
|
||||
fun checkEnemies (player, enemies, lst, acc) =
|
||||
case lst of
|
||||
id :: tl =>
|
||||
let
|
||||
val newRecoil =
|
||||
(* check if collision is closer to left side of enemy or right
|
||||
* and then chose appropriate direction to recoil in *)
|
||||
let
|
||||
val {x, ...} = player
|
||||
val pFinishX = x + size
|
||||
val pHalfW = size div 2
|
||||
val pCentreX = x + pHalfW
|
||||
|
||||
val {x = ex, y = ey, ...} = Vector.sub (enemies, id - 1)
|
||||
val eFinishX = ex + Enemy.size
|
||||
val eHalfW = Enemy.size div 2
|
||||
val eCentreX = ex + eHalfW
|
||||
in
|
||||
if eCentreX < pCentreX then RECOIL_RIGHT 0 else RECOIL_LEFT 0
|
||||
end
|
||||
|
||||
val acc = W_RECOIL newRecoil :: acc
|
||||
|
||||
val acc =
|
||||
case newRecoil of
|
||||
RECOIL_LEFT _ => W_FACING FACING_RIGHT :: acc
|
||||
| RECOIL_RIGHT _ => W_FACING FACING_LEFT :: acc
|
||||
| NO_RECOIL => acc
|
||||
|
||||
val acc =
|
||||
W_ATTACKED (ATTACKED 0) :: W_Y_AXIS (FALLING) :: W_X_AXIS STAY_STILL
|
||||
:: acc
|
||||
in
|
||||
checkEnemies (player, enemies, tl, acc)
|
||||
end
|
||||
| [] => acc
|
||||
|
||||
fun getCollisionPatches (player, game) =
|
||||
let
|
||||
val {walls, wallTree, platformTree, platforms, enemyTree, enemies, ...} =
|
||||
game
|
||||
|
||||
val {x, y, attacked, ...} = player
|
||||
|
||||
val platCollisions = QuadTree.getCollisionsBelow
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, platformTree)
|
||||
val acc = checkPlatforms (player, platforms, platCollisions, [])
|
||||
|
||||
val wallCollisions = QuadTree.getCollisionSides
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, wallTree)
|
||||
val acc = checkWalls (player, walls, wallCollisions, acc)
|
||||
in
|
||||
(* skip enemy collisions if player is in attacked state
|
||||
* because games often offer a short cooldown period
|
||||
* where player can walk through enemies without receiving damage
|
||||
* in which case enemy collisions don't count
|
||||
* *)
|
||||
case #attacked player of
|
||||
NOT_ATTACKED =>
|
||||
let
|
||||
val {x, y, ...} = player
|
||||
val enemyCollisions = QuadTree.getCollisions
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, enemyTree)
|
||||
in
|
||||
checkEnemies (player, enemies, enemyCollisions, acc)
|
||||
end
|
||||
| ATTACKED amt =>
|
||||
if amt = attackLimit then
|
||||
(* if we hit limit, exit ATTACKED phase
|
||||
* and react to enemy collisions again
|
||||
* *)
|
||||
let
|
||||
val {x, y, ...} = player
|
||||
val enemyCollisions = QuadTree.getCollisions
|
||||
(x, y, size, size, 0, 0, 1920, 1080, 0, enemyTree)
|
||||
|
||||
val acc = W_ATTACKED NOT_ATTACKED :: acc
|
||||
in
|
||||
checkEnemies (player, enemies, enemyCollisions, acc)
|
||||
end
|
||||
else
|
||||
let
|
||||
val amt = amt + 1
|
||||
val attacked = ATTACKED amt
|
||||
in
|
||||
W_ATTACKED attacked :: acc
|
||||
end
|
||||
end
|
||||
|
||||
fun getMovePatches player =
|
||||
let
|
||||
val {xAxis, yAxis, x, y, ...} = player
|
||||
|
||||
val desiredX =
|
||||
case xAxis of
|
||||
STAY_STILL => x
|
||||
| MOVE_LEFT => x - moveBy
|
||||
| MOVE_RIGHT => x + moveBy
|
||||
in
|
||||
case yAxis of
|
||||
ON_GROUND => [W_X desiredX]
|
||||
| FLOATING floated =>
|
||||
let
|
||||
val yAxis =
|
||||
if floated = floatLimit then FALLING else FLOATING (floated + 1)
|
||||
in
|
||||
[W_X desiredX, W_Y_AXIS yAxis]
|
||||
end
|
||||
| FALLING =>
|
||||
let val desiredY = y + moveBy
|
||||
in [W_X desiredX, W_Y desiredY]
|
||||
end
|
||||
| DROP_BELOW_PLATFORM =>
|
||||
let val desiredY = y + moveBy
|
||||
in [W_X desiredX, W_Y desiredY]
|
||||
end
|
||||
| JUMPING jumped =>
|
||||
if jumped + moveBy > jumpLimit then
|
||||
(* if we are above the jump limit, trigger a fall *)
|
||||
let val newYAxis = FLOATING 0
|
||||
in [W_X desiredX, W_Y_AXIS newYAxis]
|
||||
end
|
||||
else
|
||||
(* jump *)
|
||||
let
|
||||
val newJumped = jumped + moveBy
|
||||
val newYAxis = JUMPING newJumped
|
||||
val desiredY = y - moveBy
|
||||
in
|
||||
[W_X desiredX, W_Y desiredY, W_Y_AXIS newYAxis]
|
||||
end
|
||||
end
|
||||
|
||||
fun getInputPatches (player: player, input) =
|
||||
let
|
||||
val {x, y, yAxis, health, jumpPressed, attacked, facing, ...} = player
|
||||
val {leftHeld, rightHeld, upHeld, downHeld, attackHeld} = input
|
||||
|
||||
val xAxis = getXAxis (leftHeld, rightHeld)
|
||||
val facing = getFacing (facing, xAxis)
|
||||
@@ -386,101 +462,118 @@ struct
|
||||
val yAxis = defaultYAxis yAxis
|
||||
val jumpPressed = false
|
||||
in
|
||||
helpMove
|
||||
( x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
[ W_X_AXIS xAxis
|
||||
, W_Y_AXIS yAxis
|
||||
, W_JUMP_PRESSED jumpPressed
|
||||
, W_FACING facing
|
||||
]
|
||||
end
|
||||
| (true, true) =>
|
||||
let
|
||||
val yAxis = defaultYAxis yAxis
|
||||
in
|
||||
helpMove
|
||||
( x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
let val yAxis = defaultYAxis yAxis
|
||||
in [W_X_AXIS xAxis, W_Y_AXIS yAxis, W_FACING facing]
|
||||
end
|
||||
| (true, false) =>
|
||||
let
|
||||
val yAxis = onJumpPressed (yAxis, jumpPressed)
|
||||
val jumpPressed = true
|
||||
in
|
||||
helpMove
|
||||
( x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
[ W_X_AXIS xAxis
|
||||
, W_Y_AXIS yAxis
|
||||
, W_JUMP_PRESSED jumpPressed
|
||||
, W_FACING facing
|
||||
]
|
||||
end
|
||||
| (false, true) =>
|
||||
let
|
||||
val jumpPressed = false
|
||||
val yAxis = DROP_BELOW_PLATFORM
|
||||
in
|
||||
helpMove
|
||||
(x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
[ W_X_AXIS xAxis
|
||||
, W_Y_AXIS yAxis
|
||||
, W_JUMP_PRESSED jumpPressed
|
||||
, W_FACING facing
|
||||
]
|
||||
end
|
||||
end
|
||||
|
||||
fun getRecoilPatches player =
|
||||
case #recoil player of
|
||||
NO_RECOIL => []
|
||||
| RECOIL_LEFT recoiled =>
|
||||
(* if player is recoiling, don't accept or adjust any input.
|
||||
* However, if player has reached the recoil limit, exit the recoil
|
||||
* state and accept input.
|
||||
* *)
|
||||
if recoiled = recoilLimit then
|
||||
[W_RECOIL NO_RECOIL]
|
||||
else
|
||||
let
|
||||
val {x, y, health, attacked, facing, xAxis, ...} = player
|
||||
(* difference between RECOIL_LEFT and RECOIL_RIGHT
|
||||
* is the direction player moves back in *)
|
||||
val x = x - 5
|
||||
|
||||
val xAxis = STAY_STILL
|
||||
val yAxis = FALLING
|
||||
val jumpPressed = false
|
||||
val recoiled = recoiled + 1
|
||||
val recoil = RECOIL_LEFT recoiled
|
||||
val facing = getFacing (facing, xAxis)
|
||||
in
|
||||
[ W_X x
|
||||
, W_X_AXIS xAxis
|
||||
, W_Y_AXIS yAxis
|
||||
, W_JUMP_PRESSED jumpPressed
|
||||
, W_RECOIL recoil
|
||||
, W_FACING facing
|
||||
]
|
||||
end
|
||||
| RECOIL_RIGHT recoiled =>
|
||||
if recoiled = recoilLimit then
|
||||
[W_RECOIL NO_RECOIL]
|
||||
else
|
||||
let
|
||||
val {x, y, health, attacked, facing, xAxis, ...} = player
|
||||
val x = x + 5
|
||||
|
||||
val xAxis = STAY_STILL
|
||||
val yAxis = FALLING
|
||||
val jumpPressed = false
|
||||
val recoiled = recoiled + 1
|
||||
val recoil = RECOIL_RIGHT recoiled
|
||||
val facing = getFacing (facing, xAxis)
|
||||
in
|
||||
[ W_X x
|
||||
, W_X_AXIS xAxis
|
||||
, W_Y_AXIS yAxis
|
||||
, W_JUMP_PRESSED jumpPressed
|
||||
, W_RECOIL recoil
|
||||
, W_FACING facing
|
||||
]
|
||||
end
|
||||
|
||||
fun move (game: game_type, input) =
|
||||
let
|
||||
val player = #player game
|
||||
val recoil = #recoil player
|
||||
|
||||
val patches = getRecoilPatches player
|
||||
val player = withPatches (player, patches)
|
||||
|
||||
val player =
|
||||
(* we only accept and handle input if player is not recoiling *)
|
||||
case #recoil player of
|
||||
NO_RECOIL =>
|
||||
let val patches = getInputPatches (player, input)
|
||||
in withPatches (player, patches)
|
||||
end
|
||||
| _ => player
|
||||
|
||||
val patches = getMovePatches player
|
||||
val player = withPatches (player, patches)
|
||||
|
||||
val patches = getCollisionPatches (player, game)
|
||||
in
|
||||
case recoil of
|
||||
NO_RECOIL => handleInput (game, input, recoil)
|
||||
| RECOIL_LEFT recoiled =>
|
||||
(* if player is recoiling, don't accept or adjust any input.
|
||||
* However, if player has reached the recoil limit, exit the recoil
|
||||
* state and accept input.
|
||||
* *)
|
||||
if recoiled = recoilLimit then
|
||||
handleInput (game, input, NO_RECOIL)
|
||||
else
|
||||
let
|
||||
val {x, y, health, attacked, facing, xAxis, ...} = player
|
||||
(* difference between RECOIL_LEFT and RECOIL_RIGHT
|
||||
* is the direction player moves back in *)
|
||||
val x = x - 5
|
||||
|
||||
val xAxis = STAY_STILL
|
||||
val yAxis = FALLING
|
||||
val jumpPressed = false
|
||||
val recoiled = recoiled + 1
|
||||
val recoil = RECOIL_LEFT recoiled
|
||||
val facing = getFacing (facing, xAxis)
|
||||
in
|
||||
helpMove
|
||||
( x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
end
|
||||
| RECOIL_RIGHT recoiled =>
|
||||
if recoiled = recoilLimit then
|
||||
handleInput (game, input, NO_RECOIL)
|
||||
else
|
||||
let
|
||||
val {x, y, health, attacked, facing, xAxis, ...} = player
|
||||
val x = x + 5
|
||||
|
||||
val xAxis = STAY_STILL
|
||||
val yAxis = FALLING
|
||||
val jumpPressed = false
|
||||
val recoiled = recoiled + 1
|
||||
val recoil = RECOIL_RIGHT recoiled
|
||||
val facing = getFacing (facing, xAxis)
|
||||
in
|
||||
helpMove
|
||||
( x, y, xAxis, yAxis, health
|
||||
, jumpPressed, recoil, attacked
|
||||
, facing, game
|
||||
)
|
||||
end
|
||||
withPatches (player, patches)
|
||||
end
|
||||
|
||||
(* block is placeholder asset *)
|
||||
|
||||
@@ -6,6 +6,7 @@ struct
|
||||
, rightHeld = ref false
|
||||
, upHeld = ref false
|
||||
, downHeld = ref false
|
||||
, attackHeld = ref false
|
||||
, width = ref (1920.0 : Real32.real)
|
||||
, height = ref (1080.0 : Real32.real)
|
||||
}
|
||||
@@ -15,6 +16,7 @@ struct
|
||||
, rightHeld = !(#rightHeld state)
|
||||
, upHeld = !(#upHeld state)
|
||||
, downHeld = !(#downHeld state)
|
||||
, attackHeld = !(#attackHeld state)
|
||||
}
|
||||
|
||||
fun getWidth () =
|
||||
@@ -45,6 +47,10 @@ struct
|
||||
if action = PRESS then (#rightHeld state) := true
|
||||
else if action = RELEASE then (#rightHeld state) := false
|
||||
else ()
|
||||
else if key = KEY_J then
|
||||
if action = PRESS then (#attackHeld state) := true
|
||||
else if action = RELEASE then (#attackHeld state) := false
|
||||
else ()
|
||||
else
|
||||
()
|
||||
|
||||
|
||||
Reference in New Issue
Block a user