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

begin parameterising level so that it fits into larger type (with different modes like TITLE, LEVEL, SETTINGS, etc.)

Browse Source
This commit is contained in:
Humza Shahid
2025-02-18 13:16:52 +00:00
parent b426ddbdd1
commit afe878c05d
33 changed files with 235 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
fcore/level/chain-edge.sml Normal file
View File

@@ -0,0 +1,49 @@
structure ChainEdgeRight =
struct
fun lerp (startX, startY, drawWidth, drawHeight, windowWidth, windowHeight, r, g, b) : Real32.real vector =
let
val endY = windowHeight - startY
val startY = windowHeight - (startY + drawHeight)
val endX = startX + drawWidth
val windowHeight = windowHeight / 2.0
val windowWidth = windowWidth / 2.0
in
#[ (((startX * (1.0 - 0.0)) + (endX * 0.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.799999952316)) + (endY * 0.799999952316)) / windowHeight) - 1.0,
r, g, b,
(((startX * (1.0 - 0.0)) + (endX * 0.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
r, g, b,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.485714316368)) + (endY * 0.485714316368)) / windowHeight) - 1.0,
r, g, b
]
end
end
structure ChainEdgeLeft =
struct
fun lerp (startX, startY, drawWidth, drawHeight, windowWidth, windowHeight, r, g, b) : Real32.real vector =
let
val endY = windowHeight - startY
val startY = windowHeight - (startY + drawHeight)
val endX = startX + drawWidth
val windowHeight = windowHeight / 2.0
val windowWidth = windowWidth / 2.0
in
#[ (((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.799999952316)) + (endY * 0.799999952316)) / windowHeight) - 1.0,
r, g, b,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
r, g, b,
(((startX * (1.0 - 0.0)) + (endX * 0.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.485714316368)) + (endY * 0.485714316368)) / windowHeight) - 1.0,
r, g, b
]
end
end

15
fcore/level/collision.sml Normal file
View File

@@ -0,0 +1,15 @@
structure Collision =
struct
fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) =
ix < cfx andalso ifx > cx andalso iy < cfy andalso ify > cy
fun isCollidingPlus (ix, iy, iw, ih, cx, cy, cw, ch) =
let
val ifx = ix + iw
val ify = iy + ih
val cfx = cx + cw
val cfy = cy + ch
in
isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy)
end
end

553
fcore/level/enemy/enemy-behaviour.sml Normal file
View File

@@ -0,0 +1,553 @@
structure EnemyBehaviour =
struct
open EnemyType
open EntityType
fun canWalkAhead (x, y, wallTree, platformTree) =
let
val y = y + Constants.enemySize - 5
val searchHeight = 10
val searchWidth = Constants.moveEnemyBy
in
QuadTree.hasCollisionAt (x, y, searchWidth, searchHeight, ~1, wallTree)
orelse
QuadTree.hasCollisionAt
(x, y, searchWidth, searchHeight, ~1, platformTree)
end
(* same function takes either wallTree or platformTree and returns true
* if standing on tree.
* Function is monomorphic in the sense that wallTree and platformTree
* are both same type (no generics/parametric polymorphism).
* *)
fun standingOnArea (enemy: enemy, tree) =
let
val {x = ex, y = ey, ...} = enemy
val ey = ey + Constants.enemySize - 1
val width = Constants.enemySize
val height = Platform.platHeight
in
QuadTree.hasCollisionAt (ex, ey, width, height, ~1, tree)
end
fun getPatrolPatches (enemy: enemy, wallTree, platformTree, acc) =
let
(* This function is meant to check
* if enemy should switch the horizontal direction
* if the enemy is patrolling.
*
* Algorithm:
* 1. Check if enemy there is a wall ahead of the enemy
* in the direction the enemy is walking.
* 1.1. If there is a wall, then invert the direction.
*
* 2. If there is no wall, check if there is space to
* walk ahead on, such that enemy will not fall
* if enemy continues to walk.
* 2.1. If continuing to walk will cause the enemy to fall,
* then invert the direction.
*
* 3. Else, do not invert direction and simply return given list.
* *)
val {x, y, xAxis, ...} = enemy
in
case xAxis of
MOVE_LEFT =>
let
(* search to see if there is wall on left side *)
val searchStartX = x - Constants.moveEnemyBy
val searchWidth = Constants.moveEnemyBy
val searchHeight = Constants.enemySize - 5
val hasWallAhead = QuadTree.hasCollisionAt
(searchStartX, y, searchWidth, searchHeight, ~1, wallTree)
in
if hasWallAhead then
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_X_AXIS MOVE_RIGHT
:: acc
else if canWalkAhead (searchStartX, y, wallTree, platformTree) then
(* invert direction if moving further left
* will result in falling down *)
acc
else
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_X_AXIS MOVE_RIGHT
:: acc
end
| MOVE_RIGHT =>
let
(* enemy's x field is top left coordinate
* but we want to check top * right coordinate,
* so add enemySize *)
val searchStartX = x + Constants.enemySize + Constants.moveEnemyBy
val searchWidth = Constants.moveEnemyBy
val searchHeight = Constants.enemySize - 5
val hasWallAhead = QuadTree.hasCollisionAt
(searchStartX, y, searchWidth, searchHeight, ~1, wallTree)
in
if hasWallAhead then
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT
:: acc
else if canWalkAhead (searchStartX, y, wallTree, platformTree) then
(* invert direction if moving further right
* will result in falling down *)
acc
else
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT
:: acc
end
| STAY_STILL => acc
end
(* pathfinding *)
fun isBetween (p1, check, p2) = check >= p1 andalso check <= p2
fun getHighestPlatform (collisions, platforms, highestY, highestID, checkY) =
case collisions of
id :: tl =>
let
val {y = platY, ...} = Platform.find (id, platforms)
in
(* platY < highestY is correct because lowest number = highest
* in * this case *)
if platY < highestY andalso checkY <= platY then
getHighestPlatform (tl, platforms, platY, id, checkY)
else
getHighestPlatform (tl, platforms, highestY, highestID, checkY)
end
| [] => highestID
fun getPlatformBelowEnemy (enemy: enemy, platformTree, platforms) =
let
val {x, y, ...} = enemy
val searchWidth = Constants.enemySize
val searchHeight = Constants.worldHeight - y
val y = y + Constants.enemySize
val collisions = QuadTree.getCollisions
(x, y, searchWidth, searchHeight, ~1, platformTree)
val wh = Constants.worldHeight
in
getHighestPlatform (collisions, platforms, wh, ~1, y)
end
fun canJump (prevPlatform, nextPlatform) =
let
val {x = pPlatX, y = pPlatY, width = pPlatW, ...} = prevPlatform
val pPlatFinishX = pPlatX + pPlatW
val {x = nPlatX, y = nPlatY, width = nPlatW, ...} = nextPlatform
val nPlatFinishX = nPlatX + nPlatW
in
(isBetween (nPlatX, pPlatX, nPlatFinishX)
orelse isBetween (nPlatX, pPlatFinishX, nPlatFinishX))
andalso pPlatY > nPlatY
end
fun getJumpPatches (nextPlatform, platformTree, enemy, acc) =
let
val {x = platX, y = platY, width = platWidth, ...} = nextPlatform
val platFinishX = platX + platWidth
val {x = eX, y = ey, yAxis = eyAxis, xAxis = exAxis, ...} = enemy
val ecx = eX + (Constants.enemySize div 2)
val ey = ey + Constants.enemySize
val standingOnPlat = standingOnArea (enemy, platformTree)
in
if ey >= platY andalso standingOnPlat then
if
isBetween (platX, ecx, platFinishX)
then
(* can jump from same position enemy is at *)
let
(* since we want to jump vertically and not risk falling off by
* jumping + moving either left or right, make enemy stay still *)
in
case eyAxis of
ON_GROUND => EnemyPatch.W_Y_AXIS (JUMPING 0) :: acc
| FALLING => EnemyPatch.W_Y_AXIS (JUMPING 0) :: acc
| _ => acc
end
else (* have to travel either left or right before jumping *) if
ecx < platX
then
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_X_AXIS MOVE_RIGHT
:: acc
else
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT
:: acc
else
acc
end
fun canDrop (prevPlatform, nextPlatform) =
let
val {x = pPlatX, y = pPlatY, width = pPlatW, ...} = prevPlatform
val pPlatFinishX = pPlatX + pPlatW
val {x = nPlatX, y = nPlatY, width = nPlatW, ...} = nextPlatform
val nPlatFinishX = nPlatX + nPlatW
in
(isBetween (nPlatX, pPlatX, nPlatFinishX)
orelse isBetween (nPlatX, pPlatFinishX, nPlatFinishX))
andalso pPlatY < nPlatY
end
fun getDropPatches (nextPlatform, platformTree, enemy, acc) =
let
val {x = platX, y = platY, width = platWidth, ...} = nextPlatform
val platFinishX = platX + platWidth
val {x = eX, y = ey, yAxis = eyAxis, xAxis = exAxis, ...} = enemy
val ecx = eX + (Constants.enemySize div 2)
val ey = ey + Constants.enemySize
val standingOnPlat = standingOnArea (enemy, platformTree)
in
if ey <= platY andalso standingOnPlat then
if
isBetween (platX, ecx, platFinishX)
then
(* can jump from same position enemy is at *)
let in
case eyAxis of
ON_GROUND => EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM :: acc
| FALLING => EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM :: acc
| _ => acc
end
else (* have to travel either left or right before jumping *) if
ecx < platX
then
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_X_AXIS MOVE_RIGHT
:: acc
else
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT
:: acc
else
acc
end
fun getMoveRightPatches (nextPlatform, enemy, platformTree, acc) =
(* important to check for drop first because path of traceRightJump includes
* descent of jump/drop.
* So, if we check for jump first, we would always jump before dropping
* even if jumping is not necessary. *)
if TraceJump.traceRightDrop (enemy, #id nextPlatform, platformTree) then
EnemyPatch.W_FACING FACING_RIGHT
:: EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM
:: EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else if TraceJump.traceRightJump (enemy, #id nextPlatform, platformTree) then
if standingOnArea (enemy, platformTree) then
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_Y_AXIS (JUMPING 0)
:: EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_X_AXIS MOVE_RIGHT
:: acc
else
EnemyPatch.W_FACING FACING_RIGHT :: EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
fun getMoveLeftPatches (nextPlatform, enemy, platformTree, acc) =
if TraceJump.traceLeftDrop (enemy, #id nextPlatform, platformTree) then
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM
:: EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else if TraceJump.traceLeftJump (enemy, #id nextPlatform, platformTree) then
if standingOnArea (enemy, platformTree) then
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_Y_AXIS (JUMPING 0)
:: EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
(* get patches to help enemy move to nextPlatformID *)
fun getPathToNextPlatform
(nextPlatformID, platforms, platformTree, enemy, eID, pID, acc) =
let
val currentPlatform = Platform.find (eID, platforms)
val nextPlatform = Platform.find (nextPlatformID, platforms)
val canJump = canJump (currentPlatform, nextPlatform)
val canDrop = canDrop (currentPlatform, nextPlatform)
in
if canJump then
getJumpPatches (nextPlatform, platformTree, enemy, acc)
else if canDrop then
getDropPatches (nextPlatform, platformTree, enemy, acc)
else
let
(* if can neither jump or drop to next platform vertically
* then remaining options are either jumping to the right or left.
* Figure out which the enemy needs to do and progress to it. *)
val {x = eX, ...} = enemy
val {x = nPlatX, width = nPlatW, ...} = nextPlatform
in
if eX < nPlatX then
getMoveRightPatches (nextPlatform, enemy, platformTree, acc)
else
getMoveLeftPatches (nextPlatform, enemy, platformTree, acc)
end
end
(* if only one side in x direction overlaps with platform,
* then move enemy left/right to make them fully overlap with platform *)
fun getHorizontalLandingPatches (enemy, nextPlatform, acc) = acc
fun getFallingPatches (enemy, newPlatformID, platforms, acc) =
EnemyPatch.W_NEXT_PLAT_ID ~1 :: acc
fun getJumpLandingPatches (enemy, nextPlatformID, platforms, acc) = acc
fun getLandingPatches (newPlatformID, platforms, enemy, acc) =
case #yAxis enemy of
JUMPING _ => getJumpLandingPatches (enemy, newPlatformID, platforms, acc)
| _ => getFallingPatches (enemy, newPlatformID, platforms, acc)
(* to be called by FOLLOW_SIME. The FOLLOW_SIME sometimes changes its x axis
* to STAY_STILL, so if this happens and we want to patrol,
* then start patrolling in the direction the player is in *)
fun startPatrolPatches (player, enemy, wallTree, platformTree, acc) =
case #xAxis enemy of
STAY_STILL =>
(case #facing enemy of
FACING_RIGHT => EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
| FACING_LEFT => EnemyPatch.W_X_AXIS MOVE_LEFT :: acc)
| _ => getPatrolPatches (enemy, wallTree, platformTree, acc)
fun isInFollowRange (player, enemy) =
let
val {x = px, y = py, ...} = player
val pfx = px + Constants.playerWidth
val pfy = py + Constants.playerHeight
val range = 199
val {x = ex, y = ey, ...} = enemy
val eStartX = ex - range
val eStartY = ey - range
val efx = ex + Constants.enemySize + range
val efy = ey + Constants.enemySize + range
in
Collision.isColliding (px, py, pfx, pfy, eStartX, eStartY, efx, efy)
end
fun getFollowPatches
( player: PlayerType.player
, enemy
, wallTree
, platformTree
, platforms
, graph
, acc
) =
let
val pID = #platID player
val eID = #platID enemy
in
if eID = ~1 orelse pID = ~1 then
(* without checking that neither of these are ~1
* (which means there is no platform below the enemy/player)
* there is a subscript error because the PathFinding.start
* function expects neither of these values to be ~1. *)
startPatrolPatches (player, enemy, wallTree, platformTree, acc)
else if eID = #nextPlatID enemy then
getLandingPatches (eID, platforms, enemy, acc)
else if eID = pID then
startPatrolPatches (player, enemy, wallTree, platformTree, acc)
else if isInFollowRange (player, enemy) then
(* line of sight: only follow player if player is in some range *)
let
val bestPath = PathFinding.start
(pID, eID, platforms, platformTree, graph)
in
case bestPath of
nextPlatformID :: _ =>
let
val acc = EnemyPatch.W_NEXT_PLAT_ID nextPlatformID :: acc
val acc = getPathToNextPlatform
( nextPlatformID
, platforms
, platformTree
, enemy
, eID
, pID
, acc
)
in
EnemyPatch.W_X_AXIS STAY_STILL :: acc
end
| [] =>
startPatrolPatches (player, enemy, wallTree, platformTree, acc)
end
else
startPatrolPatches (player, enemy, wallTree, platformTree, acc)
end
fun withDefaultYAxis (enemy: enemy) =
case #yAxis enemy of
ON_GROUND => EnemyPatch.withPatch (enemy, EnemyPatch.W_Y_AXIS FALLING)
| _ => enemy
fun updatePatrolState
(player, enemy, walls, wallTree, platforms, platformTree) =
let
val {x, y, ...} = enemy
val size = Constants.enemySize
val enemy = withDefaultYAxis enemy
val patches = getPatrolPatches (enemy, wallTree, platformTree, [])
val enemy = EnemyPatch.withPatches (enemy, patches)
val patches = EnemyPhysics.getPhysicsPatches enemy
val enemy = EnemyPatch.withPatches (enemy, patches)
val patches = EnemyPhysics.getEnvironmentPatches
(enemy, walls, wallTree, platforms, platformTree)
in
EnemyPatch.withPatches (enemy, patches)
end
fun updateFollowState
(player, enemy, walls, wallTree, platforms, platformTree, graph) =
let
val {x, y, ...} = enemy
val size = Constants.enemySize
val enemy = withDefaultYAxis enemy
val patches = getFollowPatches
(player, enemy, wallTree, platformTree, platforms, graph, [])
val enemy = EnemyPatch.withPatches (enemy, patches)
val patches = EnemyPhysics.getPhysicsPatches enemy
val enemy = EnemyPatch.withPatches (enemy, patches)
val patches = EnemyPhysics.getEnvironmentPatches
(enemy, walls, wallTree, platforms, platformTree)
in
EnemyPatch.withPatches (enemy, patches)
end
fun updateStraightBat (player, enemy, walls, wallTree) =
let
val {x, y, batRest, batDirY, batMinY, batMaxY, xAxis, ...} = enemy
val size = Constants.enemySize
val moveByY = Constants.moveBatY
val moveByX = Constants.moveBatX
val patches =
(* get apatches for up/down movement *)
case batDirY of
UP =>
if y - moveByY <= batMaxY then
[EnemyPatch.W_BAT_DIR_Y DOWN, EnemyPatch.W_Y (y + moveByY)]
else
[EnemyPatch.W_Y (y - moveByY)]
| DOWN =>
if y + moveByY >= batMinY then
[EnemyPatch.W_BAT_DIR_Y UP, EnemyPatch.W_Y (y - moveByY)]
else
[EnemyPatch.W_Y (y + moveByY)]
val patches =
(* get patches for horizontal movement *)
if QuadTree.hasCollisionAt (x, y, size, size, ~1, wallTree) then
(* has collision with wall *)
if batRest >= Constants.batRestLimit then
(* make enemy move in opposite direction *)
case xAxis of
MOVE_RIGHT =>
EnemyPatch.W_FACING FACING_LEFT :: EnemyPatch.W_X_AXIS MOVE_LEFT
:: EnemyPatch.W_X (x - 1) :: patches
| MOVE_LEFT =>
EnemyPatch.W_FACING FACING_RIGHT
:: EnemyPatch.W_X_AXIS MOVE_RIGHT :: EnemyPatch.W_X (x + 1)
:: patches
| _ => patches
else
(* keep resting until we hit rest limit *)
EnemyPatch.W_BAT_REST (batRest + 1) :: patches
else
(* no collision, so continue moving in direction *)
let
val patches =
case xAxis of
MOVE_RIGHT => EnemyPatch.W_X (x + moveByX) :: patches
| MOVE_LEFT => EnemyPatch.W_X (x - moveByX) :: patches
| STAY_STILL => patches
in
EnemyPatch.W_BAT_REST 0 :: patches
end
in
EnemyPatch.withPatches (enemy, patches)
end
fun getShieldOnPatches (player, enemy) =
if #platID player = #platID enemy then
[]
else
(* turn off shield if player moved to a different platform *)
[EnemyPatch.W_SHIELD_ON false]
fun getShieldOffPatches
(player, enemy, walls, wallTree, platforms, platformTree) =
let
val {x = ex, y = ey, facing = eFacing, platID = eID, ...} = enemy
val {x = px, y = py, platID = pID, ...} = player
val shouldTurnShieldOn =
eID = pID
andalso
case eFacing of
FACING_RIGHT => px > ex
| FACING_LEFT => px < ex
in
if shouldTurnShieldOn then
[EnemyPatch.W_SHIELD_ON true, EnemyPatch.W_X_AXIS STAY_STILL]
else
startPatrolPatches (player, enemy, wallTree, platformTree, [])
end
fun updateShieldSlime
(player, enemy, walls, wallTree, platforms, platformTree) =
let
val size = Constants.enemySize
val enemy = withDefaultYAxis enemy
val patches =
if #shieldOn enemy then
getShieldOnPatches (player, enemy)
else
getShieldOffPatches
(player, enemy, walls, wallTree, platforms, platformTree)
val enemy = EnemyPatch.withPatches (enemy, patches)
val patches = EnemyPhysics.getPhysicsPatches enemy
val enemy = EnemyPatch.withPatches (enemy, patches)
val patches = EnemyPhysics.getEnvironmentPatches
(enemy, walls, wallTree, platforms, platformTree)
in
EnemyPatch.withPatches (enemy, patches)
end
fun updateEnemyState
(enemy, walls, wallTree, platforms, platformTree, player, graph) =
case #variant enemy of
PATROL_SLIME =>
updatePatrolState
(player, enemy, walls, wallTree, platforms, platformTree)
| FOLLOW_SLIME =>
updateFollowState
(player, enemy, walls, wallTree, platforms, platformTree, graph)
| STRAIGHT_BAT => updateStraightBat (player, enemy, walls, wallTree)
| SHIELD_SLIME =>
updateShieldSlime
(player, enemy, walls, wallTree, platforms, platformTree)
end

1
fcore/level/enemy/enemy-map.sml Normal file
View File

@@ -0,0 +1 @@
structure EnemyMap = MakeGapMap(EnemyPair)

11
fcore/level/enemy/enemy-pair.sml Normal file
View File

@@ -0,0 +1,11 @@
structure EnemyPair =
struct
type key = int
type value = EnemyType.enemy
fun l (a: int, b: int) = a < b
fun eq (a: int, b: int) = a = b
fun g (a: int, b: int) = a > b
val maxNodeSize = 8
end

338
fcore/level/enemy/enemy-patch.sml Normal file
View File

@@ -0,0 +1,338 @@
signature ENEMY_PATCH =
sig
datatype enemy_patch =
W_HEALTH of int
| W_X of int
| W_Y of int
| W_X_AXIS of EntityType.x_axis
| W_Y_AXIS of EntityType.y_axis
| W_PLAT_ID of int
| W_NEXT_PLAT_ID of int
| W_BAT_REST of int
| W_BAT_MAX_Y of int
| W_BAT_MIN_Y of int
| W_BAT_DIR_Y of EnemyType.bat_dir_y
| W_FACING of EntityType.facing
| W_SHIELD_ON of bool
val withPatch: EnemyType.enemy * enemy_patch -> EnemyType.enemy
val withPatches: EnemyType.enemy * enemy_patch list -> EnemyType.enemy
end
structure EnemyPatch: ENEMY_PATCH =
struct
datatype enemy_patch =
W_HEALTH of int
| W_X of int
| W_Y of int
| W_X_AXIS of EntityType.x_axis
| W_Y_AXIS of EntityType.y_axis
| W_PLAT_ID of int
| W_NEXT_PLAT_ID of int
| W_BAT_REST of int
| W_BAT_MAX_Y of int
| W_BAT_MIN_Y of int
| W_BAT_DIR_Y of EnemyType.bat_dir_y
| W_FACING of EntityType.facing
| W_SHIELD_ON of bool
fun mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
) =
{ id = id
, health = health
, x = x
, y = y
, xAxis = xAxis
, yAxis = yAxis
, variant = variant
, platID = platID
, nextPlatID = nextPlatID
, batRest = batRest
, batDirY = batDirY
, batMaxY = batMaxY
, batMinY = batMinY
, facing = facing
, shieldOn = shieldOn
}
fun withPatch (enemy, patch) =
let
val
{ id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
} = enemy
in
case patch of
W_HEALTH health =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_X x =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_X_AXIS xAxis =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_Y y =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_Y_AXIS yAxis =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_PLAT_ID platID =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_NEXT_PLAT_ID nextPlatID =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_BAT_REST batRest =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_BAT_MAX_Y batMaxY =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_BAT_MIN_Y batMinY =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_BAT_DIR_Y batDirY =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_FACING facing =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
| W_SHIELD_ON shieldOn =>
mkEnemy
( id
, health
, x
, y
, xAxis
, yAxis
, variant
, platID
, nextPlatID
, batRest
, batDirY
, batMaxY
, batMinY
, facing
, shieldOn
)
end
fun withPatches (enemy, lst) =
case lst of
hd :: tl =>
let val enemy = withPatch (enemy, hd)
in withPatches (enemy, tl)
end
| [] => enemy
end

59
fcore/level/enemy/enemy-type.sml Normal file
View File

@@ -0,0 +1,59 @@
signature ENEMY_TYPE =
sig
datatype variant = PATROL_SLIME | FOLLOW_SLIME | STRAIGHT_BAT | SHIELD_SLIME
datatype bat_dir_y = UP | DOWN
type enemy =
{ id: int
, health: int
, x: int
, y: int
, xAxis: EntityType.x_axis
, yAxis: EntityType.y_axis
, variant: variant
, platID: int
, nextPlatID: int
, batRest: int
, batDirY: bat_dir_y
, batMaxY: int
, batMinY: int
, facing: EntityType.facing
, shieldOn: bool
}
type falling_enemy = {x: int, y: int, variant: variant}
datatype shoot_x_axis = SHOOT_LEFT | SHOOT_RIGHT | NO_SHOOT_X
datatype shoot_y_axis = SHOOT_UP | SHOOT_DOWN | NO_SHOOT_Y
end
structure EnemyType: ENEMY_TYPE =
struct
datatype variant = PATROL_SLIME | FOLLOW_SLIME | STRAIGHT_BAT | SHIELD_SLIME
datatype bat_dir_y = UP | DOWN
type enemy =
{ id: int
, health: int
, x: int
, y: int
, xAxis: EntityType.x_axis
, yAxis: EntityType.y_axis
, variant: variant
, platID: int
, nextPlatID: int
, batRest: int
, batDirY: bat_dir_y
, batMaxY: int
, batMinY: int
, facing: EntityType.facing
, shieldOn: bool
}
type falling_enemy = {x: int, y: int, variant: variant}
datatype shoot_x_axis = SHOOT_LEFT | SHOOT_RIGHT | NO_SHOOT_X
datatype shoot_y_axis = SHOOT_UP | SHOOT_DOWN | NO_SHOOT_Y
end

133
fcore/level/enemy/enemy.sml Normal file
View File

@@ -0,0 +1,133 @@
structure Enemy =
struct
(* - Updating state of enemies per loop - *)
structure UpdateEnemies =
MakeGapMapMapper
(struct
structure Pair = EnemyPair
type env =
{ walls: Wall.t vector
, wallTree: QuadTree.t
, platforms: Platform.t vector
, platformTree: QuadTree.t
, player: PlayerType.player
, graph: PlatSet.elem vector vector
}
type state = EnemyMap.t
fun map (enemy, env) =
let
val {walls, wallTree, platforms, platformTree, player, graph} = env
in
EnemyBehaviour.updateEnemyState
(enemy, walls, wallTree, platforms, platformTree, player, graph)
end
end)
fun update (enemies, walls, wallTree, platforms, platformTree, player, graph) =
let
val env =
{ walls = walls
, wallTree = wallTree
, platforms = platforms
, platformTree = platformTree
, player = player
, graph = graph
}
in
UpdateEnemies.map (enemies, env)
end
(* - Generating enemy tree - *)
structure EnemyTree =
MakeGapMapFolder
(struct
structure Pair = EnemyPair
type env = unit
type state = QuadTree.t
fun fold (enemyID, enemy: EnemyType.enemy, (), quadTree) =
let
val {id, x, y, ...} = enemy
val size = Constants.enemySize
in
QuadTree.insert (x, y, size, size, id, quadTree)
end
end)
fun generateTree enemies =
EnemyTree.foldUnordered
( enemies
, ()
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
(* - Drawing enemies - *)
structure EnemyDrawVec =
MakeGapMapFolder
(struct
structure Pair = EnemyPair
type env = Real32.real * Real32.real
type state = Real32.real vector list
fun helpGetDrawVec (enemy: EnemyType.enemy, width, height) =
let
val {x, y, variant, ...} = enemy
val wratio = width / Constants.worldWidthReal
val hratio = height / Constants.worldHeightReal
open EnemyType
val (r, g, b) =
case variant of
PATROL_SLIME => (0.5, 0.5, 1.0)
| FOLLOW_SLIME => (1.0, 0.5, 0.5)
| STRAIGHT_BAT => (0.55, 0.55, 0.55)
| SHIELD_SLIME =>
if #shieldOn enemy then (0.33, 0.33, 0.11)
else (0.5, 0.5, 1.0)
in
if wratio < hratio then
let
val scale = Constants.worldHeightReal * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
val x = Real32.fromInt x * wratio
val y = Real32.fromInt y * wratio + yOffset
val realSize = Constants.enemySizeReal * wratio
in
Block.lerp (x, y, realSize, realSize, width, height, r, g, b)
end
else
let
val scale = Constants.worldWidthReal * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
val x = Real32.fromInt x * hratio + xOffset
val y = Real32.fromInt y * hratio
val realSize = Constants.enemySizeReal * hratio
in
Block.lerp (x, y, realSize, realSize, width, height, r, g, b)
end
end
fun fold (_, enemy: EnemyType.enemy, (width, height), acc) =
helpGetDrawVec (enemy, width, height) :: acc
end)
fun getDrawVec (enemies, width, height) =
let val vec = EnemyDrawVec.foldUnordered (enemies, (width, height), [])
in Vector.concat vec
end
end

147
fcore/level/enemy/falling-enemies.sml Normal file
View File

@@ -0,0 +1,147 @@
structure FallingEnemies =
struct
open EnemyType
open EntityType
(* - Generating tree of falling enemies - *)
structure FallingTree =
MakeGapMapFolder
(struct
structure Pair = FallingEnemyPair
type env = unit
type state = QuadTree.t
fun fold (fallingID, falling: EnemyType.falling_enemy, (), quadTree) =
let
val {x, y, ...} = falling
val size = Constants.enemySize
in
QuadTree.insert (x, y, size, size, fallingID, quadTree)
end
end)
fun generateTree falling =
FallingTree.foldUnordered
( falling
, ()
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
(* - Updating position of fallingEnemies
* - and filtering out enemies which are no longer in world bounds - *)
structure UpdateFalling =
MakeGapMapFolder
(struct
structure Pair = FallingEnemyPair
type env = unit
type state = FallingEnemyMap.t
fun fold (fallingID, fallingEnemy, (), fallingMap) =
let
val {x, y, variant} = fallingEnemy
val size = Constants.enemySize
val ww = Constants.worldWidth
val wh = Constants.worldHeight
in
if Collision.isCollidingPlus (x, y, size, size, 0, 0, ww, wh) then
let
val newFalling =
{x = x, y = y - Constants.moveEnemyBy, variant = variant}
in
FallingEnemyMap.add (fallingID, newFalling, fallingMap)
end
else
(* filter out since not in world bounds *)
fallingMap
end
end)
fun update fallingEnemies =
UpdateFalling.foldUnordered (fallingEnemies, (), FallingEnemyMap.empty)
(* - Drawing falling enemies - *)
structure FallingDrawVec =
MakeGapMapFolder
(struct
structure Pair = FallingEnemyPair
type env =
{ width: Real32.real
, height: Real32.real
, ratio: Real32.real
, xOffset: Real32.real
, yOffset: Real32.real
}
type state = Real32.real vector list
fun helpGetDrawVec
(fallingEnemy, width, height, ratio, xOffset, yOffset, acc) =
let
val {x, y, variant = _} = fallingEnemy
val x = Real32.fromInt x * ratio + xOffset
val y = Real32.fromInt y * ratio + yOffset
val size = Real32.fromInt Constants.enemySize * ratio
val vec = Block.lerp
(x, y, size, size, width, height, 0.3, 0.3, 0.3)
in
vec :: acc
end
fun fold (_, fallingEnemy, env, acc) =
let
val {width, height, ratio, xOffset, yOffset} = env
in
helpGetDrawVec
(fallingEnemy, width, height, ratio, xOffset, yOffset, acc)
end
end)
fun getDrawVec (game: LevelType.level_type, width, height) =
let
val fallingEnemies = #fallingEnemies game
val wratio = width / Constants.worldWidthReal
val hratio = height / Constants.worldHeightReal
val env =
if wratio < hratio then
let
val scale = Constants.worldHeightReal * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
in
{ width = width
, height = height
, ratio = wratio
, xOffset = 0.0
, yOffset = yOffset
}
end
else
let
val scale = Constants.worldWidthReal * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
in
{ width = width
, height = height
, ratio = hratio
, xOffset = xOffset
, yOffset = 0.0
}
end
val lst = FallingDrawVec.foldUnordered (fallingEnemies, env, [])
in
Vector.concat lst
end
end

1
fcore/level/enemy/falling-enemy-map.sml Normal file
View File

@@ -0,0 +1 @@
structure FallingEnemyMap = MakeGapMap(FallingEnemyPair)

11
fcore/level/enemy/falling-enemy-pair.sml Normal file
View File

@@ -0,0 +1,11 @@
structure FallingEnemyPair =
struct
type key = int
type value = EnemyType.falling_enemy
fun l (a: int, b: int) = a < b
fun eq (a: int, b: int) = a = b
fun g (a: int, b: int) = a > b
val maxNodeSize = 8
end

27
fcore/level/entity-type.sml Normal file
View File

@@ -0,0 +1,27 @@
signature ENTITY_TYPE =
sig
datatype y_axis =
ON_GROUND
| FALLING
| DROP_BELOW_PLATFORM
| JUMPING of int
| FLOATING of int
datatype x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
datatype facing = FACING_LEFT | FACING_RIGHT
end
structure EntityType :> ENTITY_TYPE =
struct
datatype y_axis =
ON_GROUND
| FALLING
| DROP_BELOW_PLATFORM
| JUMPING of int
| FLOATING of int
datatype x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
datatype facing = FACING_LEFT | FACING_RIGHT
end

213
fcore/level/graph.sml Normal file
View File

@@ -0,0 +1,213 @@
structure Graph =
struct
fun insertIfNew (dist, platSet, foldPlatID) =
let
val insRecord = {id = foldPlatID, distance = dist}
val pos = PlatSet.findInsPos (insRecord, platSet)
in
if pos <> ~1 andalso pos <> Vector.length platSet then
(* platSet may already contain foldPlatID; check *)
let
val {id = key, ...} = PlatSet.sub (platSet, pos)
in
if key = foldPlatID then
(* alread contains foldPlatID so return *)
platSet
else
(* foldPlatID is new; insert it *)
PlatSet.insert (platSet, insRecord, pos)
end
else
(* foldPlatID is new; insert it *)
PlatSet.insert (platSet, insRecord, pos)
end
(* duplicate of type alias declared in GameType.
* SML's structural type system is nice for allowing this. *)
type platform = {id: int, x: int, y: int, width: int}
type env = {platforms: platform vector, currentPlat: platform}
structure Vertical =
MakeQuadTreeFold
(struct
type env = env
type state = PlatSet.elem vector
fun fold (foldPlatID, env: env, platSet) =
let
val {platforms, currentPlat} = env
val {y = foldPlatY, ...} = Platform.find (foldPlatID, platforms)
val {y = currentPlatY, ...} = currentPlat
val newDist = abs (foldPlatY - currentPlatY)
in
insertIfNew (newDist, platSet, foldPlatID)
end
end)
structure Horizontal =
MakeQuadTreeFold
(struct
type env = env
type state = PlatSet.elem vector
fun minWidth (p1: platform, p2: platform) =
let
val {x = p1x, width = p1w, ...} = p1
val {x = p2x, width = p2w, ...} = p2
val p1fx = p1x + p1w
val p2fx = p2x + p2w
val w1 = abs (p1fx - p2fx)
val w2 = abs (p1fx - p2x)
val w3 = abs (p1x - p2x)
val w4 = abs (p1x - p2fx)
val min = Int.min (w1, w2)
val min = Int.min (min, w3)
in
Int.min (min, w4)
end
fun pythagoras (width, height) =
let
val wsq = width * width
val hsq = height * height
val hypotenuseSq = wsq + hsq
val hypSq = Real.fromInt hypotenuseSq
val hyp = Math.sqrt hypSq
in
Real.toInt IEEEReal.TO_NEAREST hyp
end
fun fold (foldPlatID, env: env, platSet) =
let
val {platforms, currentPlat} = env
val foldPlat = Platform.find (foldPlatID, platforms)
val foldPlatY = #y foldPlat
val {y = currentPlatY, ...} = currentPlat
val height = abs (foldPlatY - currentPlatY)
val width = minWidth (currentPlat, foldPlat)
val newDist = pythagoras (width, height)
in
insertIfNew (newDist, platSet, foldPlatID)
end
end)
fun traceRightDescent (x, y, platTree, env, platSet) =
if x >= Constants.worldWidth orelse y >= Constants.worldHeight then
(* we hit bounds of screen and saw that there was
* no way to jump to next nextPlatID *)
platSet
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val platSet = Horizontal.foldRegion
(x, y, width, height, env, platSet, platTree)
val nextX = x + Constants.moveEnemyBy
val nextY = y + Constants.moveEnemyBy
in
traceRightDescent (nextX, nextY, platTree, env, platSet)
end
fun traceRightJumpAscent (x, y, remainingJump, platTree, env, platSet) =
if remainingJump >= Constants.jumpLimit - Constants.enemySize then
traceRightDescent (x, y, platTree, env, platSet)
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val platSet = Horizontal.foldRegion
(x, y, width, height, env, platSet, platTree)
val nextX = x + Constants.moveEnemyBy
val nextY = y - Constants.moveEnemyBy
val nextJump = remainingJump + Constants.moveEnemyBy
in
traceRightJumpAscent (nextX, nextY, nextJump, platTree, env, platSet)
end
fun traceRightJump (currentPlat: platform, env, platSet, platTree) =
let
val {x, y, width, ...} = currentPlat
val x = x - Constants.enemySize + width
in
traceRightJumpAscent (x, y, 0, platTree, env, platSet)
end
fun traceLeftDescent (x, y, platTree, env, platSet) =
if x <= 0 orelse y >= Constants.worldHeight then
platSet
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val platSet = Horizontal.foldRegion
(x, y, width, height, env, platSet, platTree)
val nextX = x - Constants.moveEnemyBy
val nextY = y + Constants.moveEnemyBy
in
traceLeftDescent (nextX, nextY, platTree, env, platSet)
end
fun traceLeftJumpAscent (x, y, remainingJump, platTree, env, platSet) =
if remainingJump >= Constants.jumpLimit - Constants.enemySize then
traceLeftDescent (x, y, platTree, env, platSet)
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val platSet = Horizontal.foldRegion
(x, y, width, height, env, platSet, platTree)
val nextX = x - Constants.moveEnemyBy
val nextY = y - Constants.moveEnemyBy
val nextJump = remainingJump + Constants.moveEnemyBy
in
traceLeftJumpAscent (nextX, nextY, nextJump, platTree, env, platSet)
end
fun traceLeftJump (currentPlat: platform, env, platSet, platTree) =
let
val {x, y, ...} = currentPlat
val x = x + Constants.enemySize
in
traceLeftJumpAscent (x, y, 0, platTree, env, platSet)
end
fun start (currentPlat: platform, env: env, platSet, platformTree) =
let
val {x, y, width, ...} = currentPlat
(* calculate area to search in y axis *)
val searchY = y - Constants.jumpLimit
val height = Constants.worldHeight - searchY
val platSet = Vertical.foldRegion
(x, searchY, width, height, env, platSet, platformTree)
val platSet = traceRightJump (currentPlat, env, platSet, platformTree)
in
traceLeftJump (currentPlat, env, platSet, platformTree)
end
fun build (currentPlat, platforms, platformTree) =
let val env = {currentPlat = currentPlat, platforms = platforms}
in start (currentPlat, env, PlatSet.empty, platformTree)
end
fun fromPlatforms (platforms: platform vector, platformTree) =
Vector.map (fn plat => build (plat, platforms, platformTree)) platforms
end

148
fcore/level/level-type.sml Normal file
View File

@@ -0,0 +1,148 @@
signature LEVEL_TYPE =
sig
type level_type =
{ player: PlayerType.player
, walls: Wall.t vector
, wallTree: QuadTree.t
, platforms: Platform.t vector
, platformTree: QuadTree.t
, enemies: EnemyMap.t
, graph: PlatSet.elem vector vector
, fallingEnemies: FallingEnemyMap.t
, userKeys: CoreKey.user_key
}
val initial: CoreKey.user_key -> level_type
end
structure LevelType :> LEVEL_TYPE =
struct
type level_type =
{ player: PlayerType.player
, walls: Wall.t vector
, wallTree: QuadTree.t
, platforms: Platform.t vector
, platformTree: QuadTree.t
, enemies: EnemyMap.t
, graph: PlatSet.elem vector vector
, fallingEnemies: FallingEnemyMap.t
, userKeys: CoreKey.user_key
}
fun enemyMapFromList (hd :: tl, map) =
let val map = EnemyMap.add (#id hd, hd, map)
in enemyMapFromList (tl, map)
end
| enemyMapFromList ([], map) = map
fun initial userKeys =
let
val player =
{ yAxis = EntityType.JUMPING 0
, xAxis = EntityType.STAY_STILL
, facing = EntityType.FACING_RIGHT
, recoil = PlayerType.NO_RECOIL
, attacked = PlayerType.NOT_ATTACKED
, mainAttack = PlayerType.MAIN_NOT_ATTACKING
, mainAttackPressed = false
, health = 3
, x = 500
, y = 800
, jumpPressed = false
, enemies = Vector.fromList []
, charge = Constants.maxCharge
, projectiles = Vector.fromList []
, platID = ~1
}
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 walls = Vector.fromList [wall1, wall2, wall3]
val wallTree = Wall.generateTree walls
val plat1 = {id = 1, x = 255, y = 855, width = 199}
val plat2 = {id = 2, x = 750, y = 855, width = 199}
val plat3 = {id = 3, x = 399, y = 755, width = 399}
val plat4 = {id = 4, x = 255, y = 655, width = 199}
val plat5 = {id = 5, x = 750, y = 655, width = 199}
val plat6 = {id = 6, x = 171, y = 555, width = 99}
val plat7 = {id = 7, x = 934, y = 555, width = 99}
val plat8 = {id = 8, x = 399, y = 555, width = 399}
val plat9 = {id = 9, x = 255, y = 455, width = 199}
val plat10 = {id = 10, x = 750, y = 455, width = 199}
val plat11 = {id = 11, x = 399, y = 355, width = 399}
val plat12 = {id = 12, x = 255, y = 255, width = 199}
val plat13 = {id = 13, x = 750, y = 255, width = 199}
val plat14 = {id = 14, x = 399, y = 155, width = 399}
val plat15 = {id = 15, x = 171, y = 155, width = 99}
val plat16 = {id = 16, x = 934, y = 155, width = 99}
val platforms = Vector.fromList
[ plat1
, plat2
, plat3
, plat4
, plat5
, plat6
, plat7
, plat8
, plat9
, plat10
, plat11
, plat12
, plat13
, plat14
, plat15
, plat16
]
val platformTree = Platform.generateTree platforms
val enemy1 =
{ id = 1
, x = 751
, y = 555
, health = 1
, xAxis = EntityType.MOVE_RIGHT
, yAxis = EntityType.FALLING
, variant = EnemyType.FOLLOW_SLIME
, batDirY = EnemyType.UP
, platID = ~1
, nextPlatID = ~1
, batRest = 0
, batMaxY = 485
, batMinY = 625
, facing = EntityType.FACING_RIGHT
, shieldOn = false
}
val enemy2 =
{ id = 2
, x = 351
, y = 555
, health = 1
, xAxis = EntityType.MOVE_RIGHT
, yAxis = EntityType.FALLING
, variant = EnemyType.SHIELD_SLIME
, batDirY = EnemyType.UP
, platID = ~1
, nextPlatID = ~1
, batRest = 0
, batMaxY = 485
, batMinY = 625
, facing = EntityType.FACING_RIGHT
, shieldOn = false
}
val enemies = enemyMapFromList ([enemy1, enemy2], EnemyMap.empty)
val graph = Graph.fromPlatforms (platforms, platformTree)
in
{ player = player
, walls = walls
, wallTree = wallTree
, platforms = platforms
, platformTree = platformTree
, enemies = enemies
, graph = graph
, fallingEnemies = FallingEnemyMap.empty
, userKeys = userKeys
}
end
end

46
fcore/level/level-update.sml Normal file
View File

@@ -0,0 +1,46 @@
structure LevelUpdate =
struct
fun update (game, input) =
let
val
{ player
, walls
, wallTree
, platforms
, platformTree
, enemies
, graph
, fallingEnemies
, userKeys
} = game
val player = Player.runPhysicsAndInput (game, input)
val enemyTree = Enemy.generateTree enemies
val player = Player.checkEnemyCollisions (player, enemies, enemyTree)
val (player, enemies, fallingEnemies) =
PlayerAttack.attackEnemies (player, enemies, enemyTree, fallingEnemies)
val projectiles = #projectiles player
val (fallingEnemies, enemies) =
PlayerAttack.projectileHitEnemy
(projectiles, enemies, enemyTree, fallingEnemies)
val enemies = Enemy.update
(enemies, walls, wallTree, platforms, platformTree, player, graph)
val fallingEnemies = FallingEnemies.update fallingEnemies
in
{ player = player
, walls = walls
, wallTree = wallTree
, platforms = platforms
, platformTree = platformTree
, enemies = enemies
, graph = graph
, fallingEnemies = fallingEnemies
, userKeys = userKeys
}
end
end

120
fcore/level/path-finding.sml Normal file
View File

@@ -0,0 +1,120 @@
structure PathFinding =
struct
fun filterMinDuplicates (q, eKeys) =
if DistVec.isEmpty q then
q
else
let
val {id = min, ...} = DistVec.findMin q
val pos = IntSet.findInsPos (min, eKeys)
in
if IntSet.contains (min, eKeys) then
let val q = DistVec.deleteMin q
in filterMinDuplicates (q, eKeys)
end
else
q
end
fun helpGetPathList (curID, eID, eKeys, eVals, acc) =
if curID = eID then
(* reached starting ID of platform so return *)
acc
else
(* cons curID and traverse links backwards to reconstruct path *)
let
val acc = curID :: acc
val pos = IntSet.findInsPos (curID, eKeys)
val {from, distance, ...} = ValSet.sub (eVals, pos)
in
helpGetPathList (from, eID, eKeys, eVals, acc)
end
fun getPathList (pID, eID, eKeys, eVals) =
helpGetPathList (pID, eID, eKeys, eVals, [])
fun helpExplore (pos, graphNode, minID, distSoFar, q) =
if pos = Vector.length graphNode then
q
else
let
val {distance = newPlatDist, id = newPlatID} =
Vector.sub (graphNode, pos)
val totalDist = newPlatDist + distSoFar
val insRecord =
{distance = totalDist, id = newPlatID, comesFrom = minID}
val insPos = DistVec.findInsPos (insRecord, q)
val q = DistVec.insert (q, insRecord, insPos)
in
helpExplore (pos + 1, graphNode, minID, distSoFar, q)
end
fun explore (graphNode, minID, distSoFar, q) =
helpExplore (0, graphNode, minID, distSoFar, q)
fun loop (pID, eID, platforms, platformTree, q, eKeys, eVals, graph) =
if IntSet.contains (pID, eKeys) then
(* return path if we explored pid *)
getPathList (pID, eID, eKeys, eVals)
else
(* continue dijkstra's algorithm *)
let
(* filtering duplicates because we have no decrease-key operation *)
val q = filterMinDuplicates (q, eKeys)
in
if DistVec.isEmpty q then
(* return empty list to signify that there is no path *)
[]
else
(* find reachable values from min in quad tree *)
let
val {distance = distSoFar, id = minID, comesFrom} =
DistVec.findMin q
(* explore platforms connected to minID *)
val platPos = Platform.findPos (minID, platforms)
val plat = Vector.sub (platforms, platPos)
val graphNode = Vector.sub (graph, platPos)
(* on each loop, increment distSoFar by 15.
* Result: paths that require jumps to fewer platforms are
* incentivised a little bit. *)
val q = explore (graphNode, minID, distSoFar + 15, q)
(* mark platform with (id = minID) as explored *)
val insPos = IntSet.findInsPos (minID, eKeys)
val eKeys = IntSet.insert (eKeys, minID, insPos)
val eVals =
ValSet.insert
(eVals, {distance = distSoFar, from = comesFrom}, insPos)
in
loop (pID, eID, platforms, platformTree, q, eKeys, eVals, graph)
end
end
fun start (pID, eID, platforms, platformTree, graph) =
let
(* initialise data structures: the priority queue and the explored map *)
val q = DistVec.fromList [{distance = 0, id = eID, comesFrom = eID}]
(* explored keys and values *)
val eKeys = IntSet.empty
val eVals = ValSet.empty
(* important: starting node will have a key that points to itself.
* For example, if starting node is #"e", then the record will say
* the "from" field is #"e".
* This is different from the other nodes, where the "from" field
* will be the ID of the previous node which led to the current one.
* This is our terminating condition when reconstructing paths:
* If the key matching this value is the same as the "from" node,
* then we're done reconstructing the path and can return the path list.
* *)
in
loop (pID, eID, platforms, platformTree, q, eKeys, eVals, graph)
end
end

275
fcore/level/physics.sml Normal file
View File

@@ -0,0 +1,275 @@
signature PHYSICS_INPUT =
sig
type t
type patch
val entityWidth: int
val entityHeight: int
(* constants for physics *)
val moveBy: int
val floatLimit: int
val jumpLimit: int
(* destructuring functions *)
val getX: t -> int
val getY: t -> int
val getXAxis: t -> EntityType.x_axis
val getYAxis: t -> EntityType.y_axis
val W_X: int -> patch
val W_Y: int -> patch
val W_Y_AXIS: EntityType.y_axis -> patch
val W_PLAT_ID: int -> patch
end
functor MakePhysics(Fn: PHYSICS_INPUT) =
struct
open EntityType
fun getPhysicsPatches input =
let
val x = Fn.getX input
val y = Fn.getY input
val xAxis = Fn.getXAxis input
val yAxis = Fn.getYAxis input
val desiredX =
case xAxis of
STAY_STILL => x
| MOVE_LEFT => x - Fn.moveBy
| MOVE_RIGHT => x + Fn.moveBy
in
case yAxis of
ON_GROUND => [Fn.W_X desiredX]
| FLOATING floated =>
let
val yAxis =
if floated = Fn.floatLimit then FALLING
else FLOATING (floated + 1)
in
[Fn.W_X desiredX, Fn.W_Y_AXIS yAxis]
end
| FALLING =>
let val desiredY = y + Fn.moveBy
in [Fn.W_X desiredX, Fn.W_Y desiredY]
end
| DROP_BELOW_PLATFORM =>
let val desiredY = y + Fn.moveBy
in [Fn.W_X desiredX, Fn.W_Y desiredY]
end
| JUMPING jumped =>
if jumped + Fn.moveBy > Fn.jumpLimit then
(* if we are above the jump limit, trigger a fall *)
let val newYAxis = FLOATING 0
in [Fn.W_X desiredX, Fn.W_Y_AXIS newYAxis]
end
else
(* jump *)
let
val newJumped = jumped + Fn.moveBy
val newYAxis = JUMPING newJumped
val desiredY = y - Fn.moveBy
in
[Fn.W_X desiredX, Fn.W_Y desiredY, Fn.W_Y_AXIS newYAxis]
end
end
fun standingOnArea (x, y, tree) =
let
val y = y + Fn.entityHeight - 1
val width = Fn.entityWidth
val height = Platform.platHeight
val ww = Constants.worldWidth
val wh = Constants.worldHeight
in
QuadTree.hasCollisionAt (x, y, width, height, ~1, tree)
end
fun standingOnAreaID (x, y, tree) =
let
val y = y + Fn.entityHeight - 1
val width = Fn.entityWidth
val height = Platform.platHeight + 2
in
QuadTree.getItemID (x, y, width, height, tree)
end
fun getWallPatches (x, y, walls, wallTree, acc) =
let
val entityWidth = Fn.entityWidth
val entityHeight = Fn.entityHeight
val moveBy = Fn.moveBy
val ww = Constants.worldWidth
val wh = Constants.worldHeight
(* check collision with wall to the left *)
val acc =
let
val leftWallID = QuadTree.getItemID (x - 1, y, 1, 1, wallTree)
in
if leftWallID <> ~1 then
let
val {x = wallX, width = wallWidth, ...} =
Vector.sub (walls, leftWallID - 1)
val newX = wallX + wallWidth
in
Fn.W_X newX :: acc
end
else
acc
end
(* check collision with wall to the right *)
val acc =
let
val rightWallID = QuadTree.getItemID
(x + entityWidth - 1, y, 1, 1, wallTree)
in
if rightWallID <> ~1 then
let
val {x = wallX, ...} = Vector.sub (walls, rightWallID - 1)
val newX = wallX - entityWidth
in
Fn.W_X newX :: acc
end
else
acc
end
(* check collision with wall below *)
val downWallID = QuadTree.getItemID
(x + moveBy + 1, y + entityHeight, 1, 1, wallTree)
in
if downWallID <> ~1 then
let
val {y = wallY, ...} = Vector.sub (walls, downWallID - 1)
val newY = wallY - entityHeight
in
Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
end
else
acc
end
fun getEnvironmentPatches
(input, walls: Wall.t vector, wallTree, platforms, platformTree) =
let
(* react to platform and wall collisions *)
val x = Fn.getX input
val y = Fn.getY input
val yAxis = Fn.getYAxis input
val ew = Fn.entityWidth
val eh = Fn.entityHeight
val ww = Constants.worldWidth
val wh = Constants.worldHeight
val standPlatID = standingOnAreaID (x, y, platformTree)
val acc = []
val acc =
if standPlatID <> ~1 then
case yAxis of
(* pass through cases, allowing player to jump above
* or drop below the platform *)
JUMPING _ => acc
| DROP_BELOW_PLATFORM => acc
| FLOATING _ => acc
| _ =>
let
(* default case:
* player will land on platform and stay on the ground there. *)
val {y = platY, ...}: Platform.t =
Vector.sub (platforms, standPlatID - 1)
val newY = platY - eh
val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
in
acc
end
else
acc
val acc =
case yAxis of
DROP_BELOW_PLATFORM =>
(* if we dropped below platform before
* but we have fully passed the platform now
* such that there are no platform collisions
* then set new yAxis to FALLING
* so we do not drop below any platforms again
* *)
if QuadTree.hasCollisionAt (x, y, ew, eh, ~1, platformTree) then acc
else Fn.W_Y_AXIS FALLING :: acc
| _ => acc
val acc = getWallPatches (x, y, walls, wallTree, acc)
in
if standPlatID <> ~1 then Fn.W_PLAT_ID standPlatID :: acc else acc
end
end
structure PlayerPhysics =
MakePhysics
(struct
type t = PlayerType.player
type patch = PlayerPatch.player_patch
val entityWidth = Constants.playerWidth
val entityHeight = Constants.playerHeight
(* constants for physics *)
val moveBy = Constants.movePlayerBy
val floatLimit = Constants.floatLimit
val jumpLimit = Constants.jumpLimit
(* destructuring functions *)
fun getX ({x, ...}: t) = x
fun getY ({y, ...}: t) = y
fun getXAxis ({xAxis, ...}: t) = xAxis
fun getYAxis ({yAxis, ...}: t) = yAxis
val W_X = PlayerPatch.W_X
val W_Y = PlayerPatch.W_Y
val W_Y_AXIS = PlayerPatch.W_Y_AXIS
val W_PLAT_ID = PlayerPatch.W_PLAT_ID
end)
structure EnemyPhysics =
MakePhysics
(struct
type t = EnemyType.enemy
type patch = EnemyPatch.enemy_patch
val entityWidth = Constants.enemySize
val entityHeight = Constants.enemySize
(* constants for physics *)
val moveBy = Constants.moveEnemyBy
val floatLimit = Constants.floatLimit
val jumpLimit = Constants.jumpLimit
(* destructuring functions *)
fun getX ({x, ...}: t) = x
fun getY ({y, ...}: t) = y
fun getXAxis ({xAxis, ...}: t) = xAxis
fun getYAxis ({yAxis, ...}: t) = yAxis
val W_X = EnemyPatch.W_X
val W_Y = EnemyPatch.W_Y
val W_Y_AXIS = EnemyPatch.W_Y_AXIS
val W_PLAT_ID = EnemyPatch.W_PLAT_ID
end)

118
fcore/level/platform.sml Normal file
View File

@@ -0,0 +1,118 @@
structure Platform =
struct
type t = {id: int, x: int, y: int, width: int}
(* collision height of a platform.
* Visual height may (and probably will) be different. *)
val platHeight = 5
val rPlatHeight = 5.0
fun helpGenerateTree (pos, platVec, acc) =
if pos = Vector.length platVec then
acc
else
let
val {id, x, y, width} = Vector.sub (platVec, pos)
val acc = QuadTree.insert (x, y, width, platHeight, id, acc)
in
helpGenerateTree (pos + 1, platVec, acc)
end
fun generateTree platVec =
helpGenerateTree
( 0
, platVec
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
fun helpFindPos (findNum, vec, low, high) =
let
val mid = low + ((high - low) div 2)
val platform = Vector.sub (vec, mid)
val {id = curNum, x = _, y = _, width = _} = platform
in
if curNum = findNum then mid
else if curNum < findNum then helpFindPos (findNum, vec, mid + 1, high)
else helpFindPos (findNum, vec, low, mid - 1)
end
fun findPos (findNum, vec) =
helpFindPos (findNum, vec, 0, Vector.length vec - 1)
fun find (findNum, vec) =
let val pos = findPos (findNum, vec)
in Vector.sub (vec, pos)
end
fun helpGetDrawVecWider
(pos, platVec, acc, winWidth, winHeight, ratio, yOffset) =
if pos = Vector.length platVec then
Vector.concat acc
else
let
val plat = Vector.sub (platVec, pos)
val {x, y, width, id = _} = plat
val x = Real32.fromInt x * ratio
val y = Real32.fromInt y * ratio + yOffset
val width = Real32.fromInt width * ratio
val height = rPlatHeight * ratio
val block = Block.lerp
(x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0)
val acc = block :: acc
in
helpGetDrawVecWider
(pos + 1, platVec, acc, winWidth, winHeight, ratio, yOffset)
end
fun helpGetDrawVecTaller
(pos, platVec, acc, winWidth, winHeight, ratio, xOffset) =
if pos = Vector.length platVec then
Vector.concat acc
else
let
val plat = Vector.sub (platVec, pos)
val {x, y, width, id = _} = plat
val x = Real32.fromInt x * ratio + xOffset
val y = Real32.fromInt y * ratio
val width = Real32.fromInt width * ratio
val height = rPlatHeight * ratio
val block = Block.lerp
(x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0)
val acc = block :: acc
in
helpGetDrawVecTaller
(pos + 1, platVec, acc, winWidth, winHeight, ratio, xOffset)
end
fun getDrawVec (platVec, width, height) =
let
val wratio = width / 1920.0
val hratio = height / 1080.0
in
if wratio < hratio then
let
val scale = 1080.0 * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
in
helpGetDrawVecWider (0, platVec, [], width, height, wratio, yOffset)
end
else
let
val scale = 1920.0 * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
in
helpGetDrawVecTaller (0, platVec, [], width, height, hratio, xOffset)
end
end
end

150
fcore/level/player/player-attack.sml Normal file
View File

@@ -0,0 +1,150 @@
structure PlayerAttack =
struct
(* - Handle collisions where player hits enemy directly - *)
structure PlayerAttackEnemy =
MakeQuadTreeFold
(struct
type env = unit
type state = PlayerType.defeated_enemies list * EnemyMap.t
open EnemyType
fun defeatEnemy (enemyID, enemyMap, defeatedList) =
let
val defeatedList = {angle = 1} :: defeatedList
val enemyMap = EnemyMap.remove (enemyID, enemyMap)
in
(defeatedList, enemyMap)
end
fun shieldSlimeAttacked (enemyID, enemy, enemyMap, defeatedList) =
if #shieldOn enemy then (defeatedList, enemyMap)
else defeatEnemy (enemyID, enemyMap, defeatedList)
fun onPlayerAttack (enemyID, enemy, enemyMap, defeatedList) =
case #variant enemy of
PATROL_SLIME => defeatEnemy (enemyID, enemyMap, defeatedList)
| FOLLOW_SLIME => defeatEnemy (enemyID, enemyMap, defeatedList)
| STRAIGHT_BAT => defeatEnemy (enemyID, enemyMap, defeatedList)
| SHIELD_SLIME =>
shieldSlimeAttacked (enemyID, enemy, enemyMap, defeatedList)
fun fold (enemyID, (), (defeatedList, enemyMap)) =
case EnemyMap.get (enemyID, enemyMap) of
SOME enemy =>
onPlayerAttack (enemyID, enemy, enemyMap, defeatedList)
| NONE => (defeatedList, enemyMap)
end)
structure PlayerAttackFalling =
MakeQuadTreeFold
(struct
type env = unit
type state = PlayerType.defeated_enemies list * FallingEnemyMap.t
fun fold (fallingID, (), (defeatedList, fallingMap)) =
let
val defeatedList = {angle = 1} :: defeatedList
val fallingMap = FallingEnemyMap.remove (fallingID, fallingMap)
in
(defeatedList, fallingMap)
end
end)
fun attackEnemies (player: PlayerType.player, enemyMap, enemyTree, fallingMap) =
let
open PlayerType
val {x, y, facing, mainAttack, ...} = player
in
case mainAttack of
MAIN_ATTACKING {length, ...} =>
let
open EntityType
val height = Constants.playerHeight
val x =
(case facing of
FACING_RIGHT => x + Constants.playerWidth
| FACING_LEFT => x - length)
val (defeatedList, enemyMap) = PlayerAttackEnemy.foldRegion
(x, y, length, height, (), ([], enemyMap), enemyTree)
val fallingTree = FallingEnemies.generateTree fallingMap
val (defeatedList, fallingMap) = PlayerAttackFalling.foldRegion
( x
, y
, length
, height
, ()
, (defeatedList, fallingMap)
, fallingTree
)
val defeatedList = Vector.fromList defeatedList
val defeatedList = Vector.concat [defeatedList, #enemies player]
val player =
PlayerPatch.withPatch (player, PlayerPatch.W_ENEMIES defeatedList)
in
(player, enemyMap, fallingMap)
end
| _ => (player, enemyMap, fallingMap)
end
(* - Handle collisions when player's projectile hits enemy - *)
structure ProjectileHitEnemy =
MakeQuadTreeFold
(struct
type env = unit
type state = FallingEnemyMap.t * EnemyMap.t
open EnemyType
fun onDefeated (enemyID, enemy, enemyMap, fallingMap) =
let
val {x, y, variant, ...} = enemy
val fallingItem = {x = x, y = y, variant = variant}
val fallingMap =
FallingEnemyMap.add (enemyID, fallingItem, fallingMap)
val enemyMap = EnemyMap.remove (enemyID, enemyMap)
in
(fallingMap, enemyMap)
end
fun onShieldSlimeAttacked (enemyID, enemy, enemyMap, fallingMap) =
if #shieldOn enemy then (fallingMap, enemyMap)
else onDefeated (enemyID, enemy, enemyMap, fallingMap)
fun onProjectileAttack (enemyID, enemy, enemyMap, fallingMap) =
case #variant enemy of
PATROL_SLIME => onDefeated (enemyID, enemy, enemyMap, fallingMap)
| FOLLOW_SLIME => onDefeated (enemyID, enemy, enemyMap, fallingMap)
| STRAIGHT_BAT => onDefeated (enemyID, enemy, enemyMap, fallingMap)
| SHIELD_SLIME =>
onShieldSlimeAttacked (enemyID, enemy, enemyMap, fallingMap)
fun fold (enemyID, (), (fallingMap, enemyMap)) =
case EnemyMap.get (enemyID, enemyMap) of
SOME enemy =>
onProjectileAttack (enemyID, enemy, enemyMap, fallingMap)
| NONE => (fallingMap, enemyMap)
end)
fun helpProjectileHitEnemy (pos, projectiles, enemyTree, enemyMap, fallingMap) =
if pos = Vector.length projectiles then
(fallingMap, enemyMap)
else
let
val {x, y, ...}: PlayerType.player_projectile =
Vector.sub (projectiles, pos)
val size = Constants.projectileSizeInt
val (fallingMap, enemyMap) = ProjectileHitEnemy.foldRegion
(x, y, size, size, (), (fallingMap, enemyMap), enemyTree)
in
helpProjectileHitEnemy
(pos + 1, projectiles, enemyTree, enemyMap, fallingMap)
end
fun projectileHitEnemy (projectiles, enemyMap, enemyTree, fallingMap) =
helpProjectileHitEnemy (0, projectiles, enemyTree, enemyMap, fallingMap)
end

377
fcore/level/player/player-patch.sml Normal file
View File

@@ -0,0 +1,377 @@
signature PLAYER_PATCH =
sig
datatype player_patch =
W_X_AXIS of EntityType.x_axis
| W_Y_AXIS of EntityType.y_axis
| W_FACING of EntityType.facing
| W_RECOIL of PlayerType.player_recoil
| W_ATTACKED of PlayerType.player_attacked
| W_MAIN_ATTACK of PlayerType.main_attack
| W_HEALTH of int
| W_X of int
| W_Y of int
| W_JUMP_PRESSED of bool
| W_MAIN_ATTACK_PRESSED of bool
| W_ENEMIES of PlayerType.defeated_enemies vector
| W_CHARGE of int
| W_PROJECTILES of PlayerType.player_projectile vector
| W_PLAT_ID of int
val withPatch: PlayerType.player * player_patch -> PlayerType.player
val withPatches: PlayerType.player * player_patch list -> PlayerType.player
end
structure PlayerPatch: PLAYER_PATCH =
struct
datatype player_patch =
W_X_AXIS of EntityType.x_axis
| W_Y_AXIS of EntityType.y_axis
| W_FACING of EntityType.facing
| W_RECOIL of PlayerType.player_recoil
| W_ATTACKED of PlayerType.player_attacked
| W_MAIN_ATTACK of PlayerType.main_attack
| W_HEALTH of int
| W_X of int
| W_Y of int
| W_JUMP_PRESSED of bool
| W_MAIN_ATTACK_PRESSED of bool
| W_ENEMIES of PlayerType.defeated_enemies vector
| W_CHARGE of int
| W_PROJECTILES of PlayerType.player_projectile vector
| W_PLAT_ID of int
fun mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
) =
{ yAxis = yAxis
, xAxis = xAxis
, recoil = recoil
, attacked = attacked
, mainAttack = mainAttack
, mainAttackPressed = mainAttackPressed
, facing = facing
, health = health
, x = x
, y = y
, jumpPressed = jumpPressed
, enemies = enemies
, charge = charge
, projectiles = projectiles
, platID = platID
}
fun withPatch (player, patch) =
let
val
{ yAxis
, xAxis
, recoil
, attacked
, mainAttack
, mainAttackPressed
, facing
, health
, x
, y
, jumpPressed
, enemies
, charge
, projectiles
, platID
} = player
in
case patch of
W_X_AXIS xAxis =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_Y_AXIS yAxis =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_RECOIL recoil =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_ATTACKED attacked =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_MAIN_ATTACK mainAttack =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_FACING facing =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_HEALTH health =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_X x =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_Y y =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_JUMP_PRESSED jumpPressed =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_MAIN_ATTACK_PRESSED mainAttackPressed =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_ENEMIES enemies =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_CHARGE charge =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_PROJECTILES projectiles =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
| W_PLAT_ID platID =>
mkPlayer
( health
, xAxis
, yAxis
, x
, y
, jumpPressed
, recoil
, attacked
, mainAttack
, facing
, mainAttackPressed
, enemies
, charge
, projectiles
, platID
)
end
fun withPatches (player: PlayerType.player, lst) =
case lst of
hd :: tl =>
let val player = withPatch (player, hd)
in withPatches (player, tl)
end
| [] => player
end

223
fcore/level/player/player-sprite.sml Normal file
View File

@@ -0,0 +1,223 @@
structure PlayerSprite =
struct
fun lerp (startX, startY, drawWidth, drawHeight, windowWidth, windowHeight, r, g, b) : Real32.real vector =
let
val endY = windowHeight - startY
val startY = windowHeight - (startY + drawHeight)
val endX = startX + drawWidth
val windowHeight = windowHeight / 2.0
val windowWidth = windowWidth / 2.0
in
#[ (((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.950000047684)) + (endY * 0.950000047684)) / windowHeight) - 1.0,
r,
g,
b,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
r,
g,
b,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
r,
g,
b,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
r,
g,
b,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.950000047684)) + (endY * 0.950000047684)) / windowHeight) - 1.0,
r,
g,
b,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.950000047684)) + (endY * 0.950000047684)) / windowHeight) - 1.0,
r,
g,
b,
(((startX * (1.0 - 0.3125)) + (endX * 0.3125)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.0)) + (endY * 0.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.3125)) + (endX * 0.3125)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.25)) + (endX * 0.25)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.25)) + (endX * 0.25)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.25)) + (endX * 0.25)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.0)) + (endY * 0.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.3125)) + (endX * 0.3125)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.0)) + (endY * 0.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.6875)) + (endX * 0.6875)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.0)) + (endY * 0.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.6875)) + (endX * 0.6875)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.75)) + (endX * 0.75)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.75)) + (endX * 0.75)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.75)) + (endX * 0.75)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.0)) + (endY * 0.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.6875)) + (endX * 0.6875)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.0)) + (endY * 0.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.950000047684)) + (endY * 0.950000047684)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.950000047684)) + (endY * 0.950000047684)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.950000047684)) + (endY * 0.950000047684)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.9375)) + (endX * 0.9375)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 1.0)) + (endX * 1.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.25)) + (endY * 0.25)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0)) + (endX * 0.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0)) + (endX * 0.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0625)) + (endX * 0.0625)) / windowWidth) - 1.0,
(((startY * (1.0 - 0.200000017881)) + (endY * 0.200000017881)) / windowHeight) - 1.0,
0.0,
0.0,
0.0,
(((startX * (1.0 - 0.0)) + (endX * 0.0)) / windowWidth) - 1.0,
(((startY * (1.0 - 1.0)) + (endY * 1.0)) / windowHeight) - 1.0,
0.0,
0.0,
0.0
]
end
end

33
fcore/level/player/player-type.sml Normal file
View File

@@ -0,0 +1,33 @@
structure PlayerType =
struct
datatype player_recoil = NO_RECOIL | RECOIL_LEFT of int | RECOIL_RIGHT of int
datatype player_attacked = NOT_ATTACKED | ATTACKED of int
datatype main_attack =
MAIN_NOT_ATTACKING
| MAIN_ATTACKING of {length: int, growing: bool}
| MAIN_THROWING
type defeated_enemies = {angle: int}
type player_projectile = {x: int, y: int, facing: EntityType.facing}
type player =
{ yAxis: EntityType.y_axis
, xAxis: EntityType.x_axis
, recoil: player_recoil
, attacked: player_attacked
, mainAttack: main_attack
, mainAttackPressed: bool
, facing: EntityType.facing
, health: int
, x: int
, y: int
, jumpPressed: bool
, enemies: defeated_enemies vector
, charge: int
, projectiles: player_projectile vector
, platID: int
}
end

718
fcore/level/player/player.sml Normal file
View File

@@ -0,0 +1,718 @@
structure Player =
struct
open PlayerPatch
open EntityType
open PlayerType
(* helper functions checking input *)
fun getXAxis (lh, rh) =
case (lh, rh) of
(false, false) => STAY_STILL
| (false, true) => MOVE_RIGHT
| (true, false) => MOVE_LEFT
| (true, true) => STAY_STILL
fun getFacing (facing, xAxis) =
case xAxis of
STAY_STILL => facing
| MOVE_LEFT => FACING_LEFT
| MOVE_RIGHT => FACING_RIGHT
(* function returns default yAxis when neither up/down are pressed
* or both are pressed.
*
* In the case where the user was previously jumping,
* we enter the floating stage, because it's normal for games
* to have a very brief floating/gliding period before applying gravity.
*
* In the case where the user was previously floating, we want the player to
* keep floating at this point (another function will apply gravity if we
* floated enough).
*
* In every other case, we return the FALLING variant,
* which has the same effect as returning the ON_GROUND variant,
* except that it means gravity is applied if we walk off a platform.
* *)
fun defaultYAxis prevAxis =
case prevAxis of
JUMPING _ => FLOATING 0
| FLOATING _ => prevAxis
| DROP_BELOW_PLATFORM => prevAxis
| _ => FALLING
(* We want to prevent a double jump
* or jumping while the player is falling
* so we only switch to the JUMPING case if the player
* is on the ground. *)
fun onJumpPressed (prevAxis, jumpPressed) =
case prevAxis of
ON_GROUND =>
if jumpPressed then (* apply gravity *) FALLING else JUMPING 0
| _ => prevAxis
fun getJumpPatches (player, jumpHeld, downHeld, acc) =
let
val {yAxis, jumpPressed, ...} = player
in
case (jumpHeld, downHeld) of
(false, false) =>
let
val yAxis = defaultYAxis yAxis
val jumpPressed = false
in
W_JUMP_PRESSED jumpPressed :: W_Y_AXIS yAxis :: acc
end
| (true, true) =>
let val yAxis = defaultYAxis yAxis
in W_Y_AXIS yAxis :: acc
end
| (true, false) =>
let
val yAxis = onJumpPressed (yAxis, jumpPressed)
val jumpPressed = true
in
W_Y_AXIS yAxis :: W_JUMP_PRESSED jumpPressed :: acc
end
| (false, true) =>
let
val jumpPressed = false
val yAxis = DROP_BELOW_PLATFORM
in
W_Y_AXIS yAxis :: W_JUMP_PRESSED jumpPressed :: acc
end
end
(* called only when player has no projectiles or was not previously attacking *)
fun helpGetMainAttackPatches (attackHeld, mainAttackPressed, charge, acc) =
let
val attack =
if attackHeld andalso not mainAttackPressed then
MAIN_ATTACKING {length = 3, growing = true}
else
MAIN_NOT_ATTACKING
in
W_MAIN_ATTACK_PRESSED (attackHeld andalso mainAttackPressed)
:: W_MAIN_ATTACK attack :: acc
end
fun degreesToRadians degrees = Real32.fromInt degrees * Constants.projectilePi
fun defeatedEnemiesToProjectiles
(pos, defeteadEnemies, player as {x, y, facing, ...}, acc) =
if pos = Vector.length defeteadEnemies then
Vector.fromList acc
else
let
val halfProjectileSize = Constants.projectileSize / 2.0
val diffX = Constants.halfPlayerWidthReal - halfProjectileSize
val diffY = Constants.halfPlayerHeightReal - halfProjectileSize
val x = Real32.fromInt x + diffX
val y = Real32.fromInt y + diffY
val {angle} = Vector.sub (defeteadEnemies, pos)
val angle = degreesToRadians angle
val x = ((Real32.Math.cos angle) * Constants.projectileDistance) + x
val y = ((Real32.Math.sin angle) * Constants.projectileDistance) + y
val x = Real32.toInt IEEEReal.TO_NEAREST x
val y = Real32.toInt IEEEReal.TO_NEAREST y
val acc = {x = x, y = y, facing = facing} :: acc
in
defeatedEnemiesToProjectiles (pos + 1, defeteadEnemies, player, acc)
end
fun getThrowPatches (defeteadEnemies, projectiles, player, acc) =
let
val newProjectiles =
defeatedEnemiesToProjectiles (0, defeteadEnemies, player, [])
(* concatenate new projectiles with previous projectiles *)
val allProjectiles = Vector.concat [newProjectiles, projectiles]
(* remove defeated enemies from player record *)
val enemies = Vector.fromList []
in
W_MAIN_ATTACK MAIN_THROWING :: W_PROJECTILES allProjectiles
:: W_ENEMIES enemies :: acc
end
fun getMainAttackPatches
( prevAttack
, defeteadEnemies
, projectiles
, attackHeld
, charge
, player
, acc
, mainAttackPressed
) =
case prevAttack of
MAIN_NOT_ATTACKING =>
if
attackHeld andalso not mainAttackPressed
andalso Vector.length defeteadEnemies > 0
then
(* shoot projectiles if player was not attacking previously,
* and there is more than one enemy *)
getThrowPatches (defeteadEnemies, projectiles, player, acc)
else
helpGetMainAttackPatches (attackHeld, mainAttackPressed, charge, acc)
| MAIN_ATTACKING {length, growing} =>
let
val mainAttack =
if growing then
if length < Constants.attackLengthLimit then
let val newLength = length + Constants.moveProjectileBy
in MAIN_ATTACKING {length = newLength, growing = true}
end
else
let
val newLength = length - Constants.moveProjectileBy
in
if newLength <= 0 then MAIN_NOT_ATTACKING
else MAIN_ATTACKING {length = newLength, growing = false}
end
else
let
val newLength = length - Constants.moveProjectileBy
in
if newLength <= 0 then MAIN_NOT_ATTACKING
else MAIN_ATTACKING {length = newLength, growing = false}
end
in
W_MAIN_ATTACK_PRESSED true :: W_MAIN_ATTACK mainAttack :: acc
end
| MAIN_THROWING =>
if attackHeld then
acc
else
helpGetMainAttackPatches (attackHeld, mainAttackPressed, charge, acc)
fun getInputPatches (player: player, input) =
let
val
{ x
, y
, yAxis
, jumpPressed
, facing
, mainAttack
, mainAttackPressed
, charge
, enemies
, projectiles
, ...
} = player
val {leftHeld, rightHeld, upHeld, downHeld, attackHeld, jumpHeld} = input
val xAxis = getXAxis (leftHeld, rightHeld)
val facing = getFacing (facing, xAxis)
val charge = (* todo: rework charge *) charge
val acc = [W_X_AXIS xAxis, W_FACING facing, W_CHARGE charge]
val acc = getMainAttackPatches
( mainAttack
, enemies
, projectiles
, attackHeld
, charge
, player
, acc
, mainAttackPressed
)
val acc = getJumpPatches (player, jumpHeld, downHeld, acc)
in
acc
end
fun getRecoilPatches (player: player, patches) =
case #recoil player of
NO_RECOIL => patches
| 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 = Constants.recoilLimit then
W_RECOIL NO_RECOIL :: patches
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
:: patches
end
| RECOIL_RIGHT recoiled =>
if recoiled = Constants.recoilLimit then
W_RECOIL NO_RECOIL :: patches
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
:: patches
end
fun helpMoveProjectiles (pos, projectiles, acc) =
if pos < 0 then
Vector.fromList acc
else
let
val {x, y, facing} = Vector.sub (projectiles, pos)
in
if x <= 0 orelse x >= Constants.worldWidth then
(* filter out since projectile is not visible *)
helpMoveProjectiles (pos - 1, projectiles, acc)
else
let
val x =
case facing of
FACING_LEFT => x - Constants.moveProjectileBy
| FACING_RIGHT => x + Constants.moveProjectileBy
val newTile = {x = x, y = y, facing = facing}
val acc = newTile :: acc
in
helpMoveProjectiles (pos - 1, projectiles, acc)
end
end
fun getProjectilePatches ({projectiles, ...}: player) =
let
val newProjectiles = helpMoveProjectiles
(Vector.length projectiles - 1, projectiles, [])
in
[W_PROJECTILES newProjectiles]
end
structure FoldEnemies =
MakeQuadTreeFold
(struct
type env = EnemyMap.t * player
type state = PlayerPatch.player_patch list
fun getEnemyRecoilPatches (player, playerOnRight, acc) =
if playerOnRight then
let
val newRecoil = RECOIL_RIGHT 0
val newAttacked = ATTACKED 0
in
W_RECOIL newRecoil :: W_ATTACKED newAttacked
:: W_FACING FACING_LEFT :: W_Y_AXIS FALLING
:: W_X_AXIS STAY_STILL :: acc
end
else
let
val newRecoil = RECOIL_LEFT 0
val newAttacked = ATTACKED 0
in
W_RECOIL newRecoil :: W_ATTACKED newAttacked
:: W_FACING FACING_RIGHT :: W_Y_AXIS FALLING
:: W_X_AXIS STAY_STILL :: acc
end
fun fold (enemyID, (enemies, player: player), patches) =
let
val playerOnRight =
(* 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 + Constants.playerWidth
val pHalfW = Constants.playerWidth div 2
val pCentreX = x + pHalfW
in
case EnemyMap.get (enemyID, enemies) of
SOME {x = ex, y = ey, ...} =>
let
val eFinishX = ex + Constants.enemySize
val eHalfW = Constants.enemySize div 2
val eCentreX = ex + eHalfW
in
eCentreX < pCentreX
end
| NONE => false
end
val patches =
getEnemyRecoilPatches (player, playerOnRight, patches)
in
W_ATTACKED (ATTACKED 0) :: patches
end
end)
structure AttackEnemies =
MakeQuadTreeFold
(struct
type env = unit
type state = defeated_enemies list
fun fold (_, (), defeatedList) = {angle = 1} :: defeatedList
end)
fun runPhysicsAndInput (game: LevelType.level_type, input) =
let
val player = #player game
val patches = getProjectilePatches player
val patches = getRecoilPatches (player, patches)
val player = PlayerPatch.withPatches (player, patches)
val patches =
(* we only accept and handle input if player is not recoiling.
* It's important to apply the recoil patches after handling input
* because we want to act on the latest recoil state straight away. *)
case #recoil player of
NO_RECOIL => getInputPatches (player, input)
| _ => []
val patches =
(* control timer for how long player should be immune to damage
* after being attacked *)
case #attacked player of
ATTACKED amt =>
if amt >= Constants.attackedLimit then
W_ATTACKED NOT_ATTACKED :: patches
else
W_ATTACKED (ATTACKED (amt + 1)) :: patches
| _ => patches
(* animate projectiles *)
val player =
let
val e = #enemies player
val e =
Vector.map
(fn {angle} => {angle = if angle < 360 then angle + 5 else 0}) e
val patches = W_ENEMIES e :: patches
in
PlayerPatch.withPatches (player, patches)
end
val patches = PlayerPhysics.getPhysicsPatches player
val player = PlayerPatch.withPatches (player, patches)
val {walls, wallTree, platforms, platformTree, ...} = game
val patches = PlayerPhysics.getEnvironmentPatches
(player, walls, wallTree, platforms, platformTree)
in
PlayerPatch.withPatches (player, patches)
end
(* player reaction to collisions with enemies.
* We only detect collisions if player is not in invincibility period
* after being previously attacked. *)
fun checkEnemyCollisions (player: PlayerType.player, enemies, enemyTree) =
case #attacked player of
ATTACKED _ => player
| _ =>
let
val {x, y, ...} = player
val ew = Constants.playerWidth
val eh = Constants.playerHeight
val env = (enemies, player)
val state = []
val patches = FoldEnemies.foldRegion
(x, y, ew, eh, env, state, enemyTree)
in
PlayerPatch.withPatches (player, patches)
end
(* todo: check which enemies are being attacked by player,
* updating player's 'defeatedEnemies' field (if enemy's health would reach 0)
* and updating enemy (if enemy's health wouldn't reach 0, decrement health)
val patches =
(* if player is attacking, check if enemies collide with attack *)
case #mainAttack player of
MAIN_ATTACKING {length, ...} =>
let
val height = Constants.playerSize
val {x, y, facing, enemies, ...} = player
val x =
(case facing of
FACING_RIGHT => x + Constants.playerSize
| FACING_LEFT => x - length)
val state = []
(* detect collisions from enemies who are hit by attack *)
val newDefeated = AttackEnemies.foldRegion
(x, y, length, height, (), state, enemyTree)
(* detect collisions from falling enemies too *)
val fallingTree =
FallingEnemies.generateTree (#fallingEnemies game)
val newDefeated = AttackEnemies.foldRegion
(x, y, length, height, (), newDefeated, fallingTree)
val allDefeated =
Vector.concat [Vector.fromList newDefeated, enemies]
in
W_ENEMIES allDefeated :: patches
end
| _ => patches
in
PlayerPatch.withPatches (player, patches)
end
*)
(* todo: add attacked enemies to player's 'enemies' field *)
fun concatAttackedEnemies (player: player, enemyCollisions) =
let
val newDefeated = Vector.map (fn id => {angle = 360}) enemyCollisions
val oldDefeated = #enemies player
val allDefeated = Vector.concat [oldDefeated, newDefeated]
in
PlayerPatch.withPatch (player, W_ENEMIES allDefeated)
end
(*** DRAWING FUNCTIONS ***)
(* block is placeholder asset *)
fun helpGetDrawVec
(x, y, realWidth, realHeight, width, height, attacked, mainAttack) =
let
val (r, g, b) =
case attacked of
NOT_ATTACKED => (1.0, 1.0, 1.0)
| ATTACKED amt =>
if amt mod 5 = 0 then
(1.0, 1.0, 1.0)
else
(1.0, 0.75, 0.75)
in
PlayerSprite.lerp (x, y, realWidth, realHeight, width, height, r, g, b)
end
fun getDrawVec (player: player, width, height) =
let
val {x, y, attacked, mainAttack, ...} = player
val wratio = width / Constants.worldWidthReal
val hratio = height / Constants.worldHeightReal
in
if wratio < hratio then
let
val scale = Constants.worldHeightReal * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
val x = Real32.fromInt x * wratio
val y = Real32.fromInt y * wratio + yOffset
val realWidth = Constants.playerWidthReal * wratio
val realHeight = Constants.playerHeightReal * wratio
in
helpGetDrawVec
(x, y, realWidth, realHeight, width, height, attacked, mainAttack)
end
else
let
val scale = Constants.worldWidthReal * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
val x = Real32.fromInt x * hratio + xOffset
val y = Real32.fromInt y * hratio
val realWidth = Constants.playerWidthReal * hratio
val realHeight = Constants.playerHeightReal * hratio
in
helpGetDrawVec
(x, y, realWidth, realHeight, width, height, attacked, mainAttack)
end
end
fun getFieldVec (player: player, width, height) =
case #mainAttack player of
MAIN_ATTACKING {length, ...} =>
let
val {x, y, facing, ...} = player
val wratio = width / Constants.worldWidthReal
val hratio = height / Constants.worldHeightReal
val x =
case #facing player of
FACING_RIGHT => x + Constants.playerWidth
| FACING_LEFT => x - length
in
if wratio < hratio then
let
val scale = Constants.worldHeightReal * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
val x = Real32.fromInt x * wratio
val y = Real32.fromInt y * wratio + yOffset
val realLength = Real32.fromInt length * wratio
val realHeight = Constants.playerHeightReal * wratio
val {charge, ...} = player
val alpha = Real32.fromInt charge / 60.0
in
case facing of
FACING_RIGHT =>
ChainEdgeRight.lerp
(x, y, realLength, realHeight, width, height, 0.5, 0.5, 0.5)
| FACING_LEFT =>
ChainEdgeLeft.lerp
(x, y, realLength, realHeight, width, height, 0.5, 0.5, 0.5)
end
else
let
val scale = Constants.worldWidthReal * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
val x = Real32.fromInt x * hratio + xOffset
val y = Real32.fromInt y * hratio
val realLength = Real32.fromInt length * hratio
val realHeight = Constants.playerHeightReal * hratio
val {charge, ...} = player
val alpha = Real32.fromInt charge / 60.0
in
case facing of
FACING_RIGHT =>
ChainEdgeRight.lerp
(x, y, realLength, realHeight, width, height, 0.5, 0.5, 0.5)
| FACING_LEFT =>
ChainEdgeLeft.lerp
(x, y, realLength, realHeight, width, height, 0.5, 0.5, 0.5)
end
end
| _ => Vector.fromList []
fun helpGetPelletVec
( playerX
, playerY
, pos
, enemies
, width
, height
, ratio
, xOffset
, yOffset
, acc
) =
if pos = Vector.length enemies then
Vector.concat acc
else
let
val {angle} = Vector.sub (enemies, pos)
(* convert degrees to radians *)
val angle = degreesToRadians angle
(* calculate pellet's x and y *)
val pelletX =
((Real32.Math.cos angle) * Constants.projectileDistance) + playerX
val pelletX = pelletX * ratio + xOffset
val pelletY =
((Real32.Math.sin angle) * Constants.projectileDistance) + playerY
val pelletY = pelletY * ratio + yOffset
val defeatedSize = Constants.projectileSize * ratio
val vec = Field.lerp
( pelletX
, pelletY
, defeatedSize
, defeatedSize
, width
, height
, 0.3
, 0.9
, 0.3
, 1.0
)
val acc = vec :: acc
in
helpGetPelletVec
( playerX
, playerY
, pos + 1
, enemies
, width
, height
, ratio
, xOffset
, yOffset
, acc
)
end
fun getPelletVec (player: player, width, height) =
if Vector.length (#enemies player) = 0 then
Vector.fromList []
else
let
val {x, y, enemies, ...} = player
(* get centre (x, y) coordinates of player *)
val halfProjectileSize = Constants.projectileSize / 2.0
val diffX = Constants.halfPlayerWidthReal - halfProjectileSize
val diffY = Constants.halfPlayerHeightReal - halfProjectileSize
val x = Real32.fromInt x + diffX
val y = Real32.fromInt y + diffY
val wratio = width / Constants.worldWidthReal
val hratio = height / Constants.worldHeightReal
in
if wratio < hratio then
let
val scale = Constants.worldHeightReal * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
in
helpGetPelletVec
(x, y, 0, enemies, width, height, wratio, 0.0, yOffset, [])
end
else
let
val scale = Constants.worldWidthReal * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
in
helpGetPelletVec
(x, y, 0, enemies, width, height, hratio, xOffset, 0.0, [])
end
end
end

58
fcore/level/projectile.sml Normal file
View File

@@ -0,0 +1,58 @@
structure Projectile =
struct
fun helpGetProjectileVec
(pos, projectiles, width, height, ratio, xOffset, yOffset, acc) =
if pos = Vector.length projectiles then
Vector.concat acc
else
let
val {x, y, ...} = Vector.sub (projectiles, pos)
val x = Real32.fromInt x * ratio + xOffset
val y = Real32.fromInt y * ratio + yOffset
val size = Constants.projectileSize * ratio
val vec = Field.lerp
(x, y, size, size, width, height, 0.3, 0.9, 0.3, 1.0)
val acc = vec :: acc
in
helpGetProjectileVec
(pos + 1, projectiles, width, height, ratio, xOffset, yOffset, acc)
end
fun getProjectileVec (player: PlayerType.player, width, height) =
let
val {projectiles, ...} = player
val wratio = width / 1920.0
val hratio = height / 1080.0
in
if wratio < hratio then
let
val scale = 1080.0 * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
val xOffset = 0.0
in
helpGetProjectileVec
(0, projectiles, width, height, wratio, xOffset, yOffset, [])
end
else
let
val scale = 1920.0 * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
val yOffset = 0.0
in
helpGetProjectileVec
(0, projectiles, width, height, hratio, xOffset, yOffset, [])
end
end
end

134
fcore/level/quad-tree-fold.sml Normal file
View File

@@ -0,0 +1,134 @@
signature QUAD_FOLDER =
sig
type env
type state
val fold: int * env * state -> state
end
signature MAKE_QUAD_TREE_FOLD =
sig
structure Fn: QUAD_FOLDER
val foldRegion:
int
* int
* int
* int
* Fn.env
* Fn.state
* {tree: QuadTreeType.t, width: int, height: int}
-> Fn.state
end
functor MakeQuadTreeFold(Fn: QUAD_FOLDER): MAKE_QUAD_TREE_FOLD =
struct
structure Fn = Fn
open QuadTreeType
fun foldRegionVec (rx, ry, rw, rh, env, state, pos, elements) =
if pos = Vector.length elements then
state
else
let
val item = Vector.sub (elements, pos)
val state =
if isCollidingItem (rx, ry, rw, rh, ~1, item) then
Fn.fold (#itemID item, env, state)
else
state
in
foldRegionVec (rx, ry, rw, rh, env, state, pos + 1, elements)
end
fun helpFoldRegion (rx, ry, rw, rh, env, state, qx, qy, qw, qh, tree) =
case tree of
NODE nodes =>
let
val vtl = visitTopLeft (rx, ry, rw, rh, qx, qy, qw, qh)
val vtr = visitTopRight (rx, ry, rw, rh, qx, qy, qw, qh)
val vbl = visitBottomLeft (rx, ry, rw, rh, qx, qy, qw, qh)
val vbr = visitBottomRight (rx, ry, rw, rh, qx, qy, qw, qh)
val hw = qw div 2
val hh = qh div 2
val state =
if vtl then
helpFoldRegion
( rx
, ry
, rw
, rh
, env
, state
, qx
, qy
, hw
, hh
, Vector.sub (nodes, tlIdx)
)
else
state
val state =
if vtr then
helpFoldRegion
( rx
, ry
, rw
, rh
, env
, state
, qx + hw
, qy
, hw
, hh
, Vector.sub (nodes, trIdx)
)
else
state
val state =
if vbl then
helpFoldRegion
( rx
, ry
, rw
, rh
, env
, state
, qx
, qy + hh
, hw
, hh
, Vector.sub (nodes, blIdx)
)
else
state
in
if vbr then
helpFoldRegion
( rx
, ry
, rw
, rh
, env
, state
, qw + hw
, qy + hh
, hw
, hh
, Vector.sub (nodes, brIdx)
)
else
state
end
| LEAF items => foldRegionVec (rx, ry, rw, rh, env, state, 0, items)
fun foldRegion (rx, ry, rw, rh, env, state, tree) =
let val {width, height, tree} = tree
in helpFoldRegion (rx, ry, rw, rh, env, state, 0, 0, width, height, tree)
end
end

132
fcore/level/quad-tree-type.sml Normal file
View File

@@ -0,0 +1,132 @@
signature QUAD_TREE_TYPE =
sig
type item = {itemID: int, startX: int, startY: int, width: int, height: int}
datatype t = NODE of t vector | LEAF of item vector
val tlIdx: int
val trIdx: int
val blIdx: int
val brIdx: int
val isColliding: int * int * int * int * int * int * int * int -> bool
val isCollidingPlus: int * int * int * int * int * int * int * int -> bool
val isCollidingItem: int * int * int * int * int * item -> bool
val visitTopLeft: int * int * int * int * int * int * int * int -> bool
val visitTopRight: int * int * int * int * int * int * int * int -> bool
val visitBottomLeft: int * int * int * int * int * int * int * int -> bool
val visitBottomRight: int * int * int * int * int * int * int * int -> bool
end
structure QuadTreeType :> QUAD_TREE_TYPE =
struct
type item = {itemID: int, startX: int, startY: int, width: int, height: int}
datatype t = NODE of t vector | LEAF of item vector
val tlIdx = 0
val trIdx = 1
val blIdx = 2
val brIdx = 3
fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) =
ix < cfx andalso ifx > cx andalso iy < cfy andalso ify > cy
fun isCollidingPlus (ix, iy, iw, ih, cx, cy, cw, ch) =
let
val ifx = ix + iw
val ify = iy + ih
val cfx = cx + cw
val cfy = cy + ch
in
isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy)
end
fun isCollidingItem (iX, iY, iW, iH, itemID, checkWith: item) =
let
val
{ itemID = checkID
, startX = cX
, startY = cY
, width = cW
, height = cH
, ...
} = checkWith
in
isCollidingPlus (iX, iY, iW, iH, cX, cY, cW, cH) andalso itemID <> checkID
end
fun visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
let
val hw = qW div 2
val hh = qH div 2
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
val qfx = qX + qW
val qfy = qY + qH
in
isColliding (iX, iY, ifx, ify, qX, qY, qmx, qmy)
end
fun visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH) =
let
val hw = qW div 2
val hh = qH div 2
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
val qfx = qX + qW
val qfy = qY + qH
in
isColliding (iX, iY, ifx, ify, qmx, qY, qfx, qmy)
end
fun visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH) =
let
val hw = qW div 2
val hh = qH div 2
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
val qfx = qX + qW
val qfy = qY + qH
in
isColliding (iX, iY, ifx, ify, qX, qmy, qmx, qfy)
end
fun visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH) =
let
val hw = qW div 2
val hh = qH div 2
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
val qfx = qX + qW
val qfy = qY + qH
in
isColliding (iX, iY, ifx, ify, qmx, qmy, qfx, qfy)
end
end

196
fcore/level/quad-tree.sml Normal file
View File

@@ -0,0 +1,196 @@
signature QUAD_TREE =
sig
type t = {tree: QuadTreeType.t, width: int, height: int}
val insert: int * int * int * int * int * t -> t
val getCollisions: int * int * int * int * int * t -> int list
val hasCollisionAt: int * int * int * int * int * t -> bool
val getItemID: int * int * int * int * t -> int
val create: int * int -> t
end
structure QuadTree: QUAD_TREE =
struct
open QuadTreeType
type item = QuadTreeType.item
type t = {tree: QuadTreeType.t, width: int, height: int}
fun create (width, height) =
let
val vec = Vector.fromList []
val tree = LEAF vec
in
{tree = tree, width = width, height = height}
end
fun mkItem (id, startX, startY, width, height) : item =
{ itemID = id
, startX = startX
, startY = startY
, width = width
, height = height
}
(* max size of vector before we split it further *)
val maxSize = 16
fun mkLeaf items =
let val items = Vector.fromList items
in LEAF items
end
fun splitLeaf
( x
, y
, w
, h
, tl: item list
, tr: item list
, bl: item list
, br: item list
, elements
, pos
) =
if pos < 0 then
let
val tl = mkLeaf tl
val tr = mkLeaf tr
val bl = mkLeaf bl
val br = mkLeaf br
val nodes = Vector.fromList [tl, tr, bl, br]
in
NODE nodes
end
else
let
val item = Vector.sub (elements, pos)
val {startX = iX, startY = iY, width = iW, height = iH, ...} = item
val vtl = visitTopLeft (iX, iY, iW, iH, x, y, w, h)
val vtr = visitTopRight (iX, iY, iW, iH, x, y, w, h)
val vbl = visitBottomLeft (iX, iY, iW, iH, x, y, w, h)
val vbr = visitBottomRight (iX, iY, iW, iH, x, y, w, h)
val tl = if vtl then item :: tl else tl
val tr = if vtr then item :: tr else tr
val bl = if vbl then item :: bl else bl
val br = if vbr then item :: br else br
in
splitLeaf (x, y, w, h, tl, tr, bl, br, elements, pos - 1)
end
fun helpInsert (ix, iy, iw, ih, itemID, qx, qy, qw, qh, tree) =
case tree of
NODE nodes =>
let
val vtl = visitTopLeft (ix, iy, iw, ih, qx, qy, qw, qh)
val vtr = visitTopRight (ix, iy, iw, ih, qx, qy, qw, qh)
val vbl = visitBottomLeft (ix, iy, iw, ih, qx, qy, qw, qh)
val vbr = visitBottomRight (ix, iy, iw, ih, qx, qy, qw, qh)
val hw = qw div 2
val hh = qh div 2
val tl = Vector.sub (nodes, tlIdx)
val tl =
if vtl then helpInsert (ix, iy, iw, ih, itemID, qw, qy, hw, hh, tl)
else tl
val tr = Vector.sub (nodes, trIdx)
val tr =
if vtr then
helpInsert (ix, iy, iw, ih, itemID, qx + hw, qy, hw, hh, tr)
else
tr
val bl = Vector.sub (nodes, blIdx)
val bl =
if vbl then
helpInsert (ix, iy, iw, ih, itemID, qx, qy + hh, hw, hh, bl)
else
bl
val br = Vector.sub (nodes, brIdx)
val br =
if vbr then
helpInsert (ix, iy, iw, ih, itemID, qx + hw, qy + hh, hw, hh, br)
else
br
val nodes = Vector.fromList [tl, tr, bl, br]
in
NODE nodes
end
| LEAF items =>
if Vector.length items + 1 > maxSize then
let
val vtl = visitTopLeft (ix, iy, iw, ih, qx, qy, qw, qh)
val vtr = visitTopRight (ix, iy, iw, ih, qx, qy, qw, qh)
val vbl = visitBottomLeft (ix, iy, iw, ih, qx, qy, qw, qh)
val vbr = visitBottomRight (ix, iy, iw, ih, qx, qy, qw, qh)
val newItem = mkItem (itemID, ix, iy, iw, ih)
val tl = if vtl then [newItem] else []
val tr = if vtr then [newItem] else []
val bl = if vbl then [newItem] else []
val br = if vbr then [newItem] else []
in
splitLeaf
(qx, qy, qw, qh, tl, tr, bl, br, items, Vector.length items - 1)
end
else
let
val newItem = mkItem (itemID, ix, iy, iw, ih)
val newItems = Vector.concat [items, Vector.fromList [newItem]]
in
LEAF newItems
end
fun insert (iX, iY, iW, iH, itemID, tree: t) =
let
val {width, height, tree} = tree
val tree = helpInsert (iX, iY, iW, iH, itemID, 0, 0, width, height, tree)
in
{width = width, height = height, tree = tree}
end
structure GetCollisions =
MakeQuadTreeFold
(struct
type env = unit
type state = int list
fun fold (itemID, (), lst) = itemID :: lst
end)
fun getCollisions (itemX, itemY, itemWidth, itemHeight, _, tree) =
GetCollisions.foldRegion (itemX, itemY, itemWidth, itemHeight, (), [], tree)
structure HasCollisionAt =
MakeQuadTreeFold
(struct
type env = unit
type state = bool
fun fold _ = true
end)
fun hasCollisionAt (ix, iy, iw, ih, _, tree) =
HasCollisionAt.foldRegion (ix, iy, iw, ih, (), false, tree)
structure GetItemID =
MakeQuadTreeFold
(struct
type env = unit
type state = int
fun fold (itemID, (), curID) = Int.max (itemID, curID)
end)
fun getItemID (ix, iy, iw, ih, tree) =
GetItemID.foldRegion (ix, iy, iw, ih, (), ~1, tree)
end

141
fcore/level/trace-jump.sml Normal file
View File

@@ -0,0 +1,141 @@
structure TraceJump =
struct
structure Trace =
MakeQuadTreeFold
(struct
type env = int
type state = bool
fun fold (foldPlatID, nextPlatID, hasFoundNextPlatID) =
hasFoundNextPlatID orelse foldPlatID = nextPlatID
end)
fun traceRightDescent (x, y, nextPlatID, platTree) =
if x >= Constants.worldWidth orelse y >= Constants.worldHeight then
(* we hit bounds of screen and saw that there was
* no way to jump to next nextPlatID *)
false
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val shouldJumpRight = Trace.foldRegion
(x, y, width, height, nextPlatID, false, platTree)
val nextX = x + Constants.moveEnemyBy
val nextY = y + Constants.moveEnemyBy
in
shouldJumpRight
orelse traceRightDescent (nextX, nextY, nextPlatID, platTree)
end
fun traceRightDrop (enemy: EnemyType.enemy, nextPlatID, platTree) =
let
val {x, y, ...} = enemy
val x = x - Constants.enemySize
in
traceRightDescent (x, y, nextPlatID, platTree)
end
fun traceRightJumpAscent (x, y, remainingJump, nextPlatID, platTree) =
(* because value of y parameter is at the top,
* we subtract the jump limit by the enemy's size,
* so we only check for places enemy can jump to. *)
if remainingJump >= Constants.jumpLimit - Constants.enemySize then
traceRightDescent (x, y, nextPlatID, platTree)
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val shouldJumpRight = Trace.foldRegion
(x, y, width, height, nextPlatID, false, platTree)
val nextX = x + Constants.moveEnemyBy
val nextY = y - Constants.moveEnemyBy
val nextJump = remainingJump + Constants.moveEnemyBy
in
shouldJumpRight
orelse
traceRightJumpAscent (nextX, nextY, nextJump, nextPlatID, platTree)
end
fun traceRightJump (enemy: EnemyType.enemy, nextPlatID, platTree) =
let
val {x, y, ...} = enemy
val x = x - Constants.enemySize
open EntityType
in
if EnemyPhysics.standingOnArea (x, y, platTree) then
traceRightJumpAscent (x, y, 0, nextPlatID, platTree)
else
case #yAxis enemy of
JUMPING amt => traceRightJumpAscent (x, y, amt, nextPlatID, platTree)
| ON_GROUND => traceRightJumpAscent (x, y, 0, nextPlatID, platTree)
| FALLING => traceRightDescent (x, y, nextPlatID, platTree)
| DROP_BELOW_PLATFORM => traceRightDescent (x, y, nextPlatID, platTree)
| FLOATING _ => traceRightDescent (x, y, nextPlatID, platTree)
end
fun traceLeftDescent (x, y, nextPlatID, platTree) =
if x <= 0 orelse y >= Constants.worldHeight then
false
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val shouldJumpLeft = Trace.foldRegion
(x, y, width, height, nextPlatID, false, platTree)
val nextX = x - Constants.moveEnemyBy
val nextY = y + Constants.moveEnemyBy
in
shouldJumpLeft
orelse traceLeftDescent (nextX, nextY, nextPlatID, platTree)
end
fun traceLeftDrop (enemy: EnemyType.enemy, nextPlatID, platTree) =
let
val {x, y, ...} = enemy
val x = x + Constants.enemySize
in
traceLeftDescent (x, y, nextPlatID, platTree)
end
fun traceLeftJumpAscent (x, y, remainingJump, nextPlatID, platTree) =
if x <= 0 orelse remainingJump >= Constants.jumpLimit - Constants.enemySize then
traceLeftDescent (x, y, nextPlatID, platTree)
else
let
val width = Constants.moveEnemyBy
val height = Constants.worldHeight - y
val shouldJumpLeft = Trace.foldRegion
(x, y, width, height, nextPlatID, false, platTree)
val nextX = x - Constants.moveEnemyBy
val nextY = y - Constants.moveEnemyBy
val nextJump = remainingJump + Constants.moveEnemyBy
in
shouldJumpLeft
orelse
traceLeftJumpAscent (nextX, nextY, nextJump, nextPlatID, platTree)
end
fun traceLeftJump (enemy: EnemyType.enemy, nextPlatID, platTree) =
let
val {x, y, ...} = enemy
val x = x + 75
open EntityType
in
if EnemyPhysics.standingOnArea (x, y, platTree) then
traceLeftJumpAscent (x, y, 0, nextPlatID, platTree)
else
case #yAxis enemy of
JUMPING amt => traceLeftJumpAscent (x, y, amt, nextPlatID, platTree)
| ON_GROUND => traceLeftJumpAscent (x, y, 0, nextPlatID, platTree)
| FALLING => traceLeftDescent (x, y, nextPlatID, platTree)
| DROP_BELOW_PLATFORM => traceLeftDescent (x, y, nextPlatID, platTree)
| FLOATING _ => traceLeftDescent (x, y, nextPlatID, platTree)
end
end

95
fcore/level/wall.sml Normal file
View File

@@ -0,0 +1,95 @@
structure Wall =
struct
type t = {id: int, x: int, y: int, width: int, height: int}
fun helpGenerateTree (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, id, acc)
in
helpGenerateTree (pos + 1, wallVec, acc)
end
fun generateTree wallVec =
helpGenerateTree
( 0
, wallVec
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
fun helpGetDrawVecWider
(pos, wallVec, acc, winWidth, winHeight, ratio, yOffset) =
if pos = Vector.length wallVec then
Vector.concat acc
else
let
val wall = Vector.sub (wallVec, pos)
val {x, y, width, height, id = _} = wall
val x = Real32.fromInt x * ratio
val y = Real32.fromInt y * ratio + yOffset
val width = Real32.fromInt width * ratio
val height = Real32.fromInt height * ratio
val block = Block.lerp
(x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0)
val acc = block :: acc
in
helpGetDrawVecWider
(pos + 1, wallVec, acc, winWidth, winHeight, ratio, yOffset)
end
fun helpGetDrawVecTaller
(pos, wallVec, acc, winWidth, winHeight, ratio, xOffset) =
if pos = Vector.length wallVec then
Vector.concat acc
else
let
val wall = Vector.sub (wallVec, pos)
val {x, y, width, height, id = _} = wall
val x = Real32.fromInt x * ratio + xOffset
val y = Real32.fromInt y * ratio
val width = Real32.fromInt width * ratio
val height = Real32.fromInt height * ratio
val block = Block.lerp
(x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0)
val acc = block :: acc
in
helpGetDrawVecTaller
(pos + 1, wallVec, acc, winWidth, winHeight, ratio, xOffset)
end
fun getDrawVec (wallVec, width, height) =
let
val wratio = width / 1920.0
val hratio = height / 1080.0
in
if wratio < hratio then
let
val scale = 1080.0 * wratio
val yOffset =
if height > scale then (height - scale) / 2.0
else if height < scale then (scale - height) / 2.0
else 0.0
in
helpGetDrawVecWider (0, wallVec, [], width, height, wratio, yOffset)
end
else
let
val scale = 1920.0 * hratio
val xOffset =
if width > scale then (width - scale) / 2.0
else if width < scale then (scale - width) / 2.0
else 0.0
in
helpGetDrawVecTaller (0, wallVec, [], width, height, hratio, xOffset)
end
end
end