From 4484eb0ef0f5d81d0aa081313641e2a9677c87aa Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Mon, 13 Jan 2025 09:42:32 +0000 Subject: [PATCH] functorise environment collision patches --- fcore/enemy.sml | 4 +- fcore/physics.sml | 96 ++++++++++++++++++++++++++++++++++++++++++++++- fcore/player.sml | 92 ++------------------------------------------- 3 files changed, 101 insertions(+), 91 deletions(-) diff --git a/fcore/enemy.sml b/fcore/enemy.sml index 8a4e0bb..10d6521 100644 --- a/fcore/enemy.sml +++ b/fcore/enemy.sml @@ -29,7 +29,7 @@ struct acc else let - val patches = EnemyPhysics.getPatches enemy + val patches = EnemyPhysics.getPhysicsPatches enemy val patches = EnemyPatch.W_HEALTH (health - 1) :: patches val enemy = EnemyPatch.withPatches (enemy, patches) in @@ -37,7 +37,7 @@ struct end else let - val patches = EnemyPhysics.getPatches enemy + val patches = EnemyPhysics.getPhysicsPatches enemy val enemy = EnemyPatch.withPatches (enemy, patches) in enemy :: acc diff --git a/fcore/physics.sml b/fcore/physics.sml index aae71a4..7e5b74e 100644 --- a/fcore/physics.sml +++ b/fcore/physics.sml @@ -3,6 +3,8 @@ sig type t type patch + val entitySize: int + (* constants for physics *) val moveBy: int val floatLimit: int @@ -23,7 +25,7 @@ functor MakePhysics(Fn: PHYSICS_INPUT) = struct open GameType - fun getPatches input = + fun getPhysicsPatches input = let val x = Fn.getX input val y = Fn.getY input @@ -70,6 +72,94 @@ struct [Fn.W_X desiredX, Fn.W_Y desiredY, Fn.W_Y_AXIS newYAxis] end end + + fun getPlatformPatches (yAxis, platforms: platform vector, lst, acc) = + let + open QuadTree + in + case lst of + platID :: tl => + (case yAxis of + DROP_BELOW_PLATFORM => + (* pass through, allowing player to drop below the platform *) + getPlatformPatches (yAxis, platforms, tl, acc) + | JUMPING _ => + (* pass through, allowing player to jump above the platform *) + getPlatformPatches (yAxis, platforms, tl, acc) + | _ => + let + (* default case: + * player will land on platform and stay on the ground there. *) + val {y = platY, ...} = Vector.sub (platforms, platID - 1) + + val newY = platY - Fn.entitySize + val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc + in + getPlatformPatches (yAxis, platforms, tl, acc) + end) + | [] => acc + end + + fun getWallPatches (walls: wall vector, lst, acc) = + let + open QuadTree + in + case lst of + (QUERY_ON_LEFT_SIDE, wallID) :: tl => + let + val {x = wallX, width = wallWidth, ...} = + Vector.sub (walls, wallID - 1) + + val newX = wallX + wallWidth + val acc = Fn.W_X newX :: acc + in + getWallPatches (walls, tl, acc) + end + | (QUERY_ON_RIGHT_SIDE, wallID) :: tl => + let + val {x = wallX, width = wallWidth, ...} = + Vector.sub (walls, wallID - 1) + + val newX = wallX - Fn.entitySize + val acc = Fn.W_X newX :: acc + in + getWallPatches (walls, tl, acc) + end + | (QUERY_ON_BOTTOM_SIDE, wallID) :: tl => + let + val {y = wallY, ...} = Vector.sub (walls, wallID - 1) + + val newY = wallY - Fn.entitySize + val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc + in + getWallPatches (walls, tl, acc) + end + | (QUERY_ON_TOP_SIDE, wallID) :: tl => getWallPatches (walls, tl, acc) + | [] => acc + end + + fun getEnvironmentPatches (input, walls, wallTree, platforms, platformTree) = + let + (* first apply physics *) + + (* then react to platform and environment collisions *) + val x = Fn.getX input + val y = Fn.getY input + val yAxis = Fn.getYAxis input + + val size = Fn.entitySize + val ww = Constants.worldWidth + val wh = Constants.worldHeight + + val platCollisions = QuadTree.getCollisionsBelow + (x, y, size, size, 0, 0, ww, wh, 0, platformTree) + val acc = getPlatformPatches (yAxis, platforms, platCollisions, []) + + val wallCollisions = QuadTree.getCollisionSides + (x, y, size, size, 0, 0, ww, wh, 0, wallTree) + in + getWallPatches (walls, wallCollisions, acc) + end end structure PlayerPhysics = @@ -78,6 +168,8 @@ structure PlayerPhysics = type t = GameType.player type patch = PlayerPatch.player_patch + val entitySize = Constants.playerSize + (* constants for physics *) val moveBy = Constants.movePlayerBy val floatLimit = Constants.floatLimit @@ -101,6 +193,8 @@ structure EnemyPhysics = type t = GameType.enemy type patch = EnemyPatch.enemy_patch + val entitySize = Constants.enemySize + (* constants for physics *) val moveBy = Constants.moveEnemyBy val floatLimit = Constants.floatLimit diff --git a/fcore/player.sml b/fcore/player.sml index 9a997eb..4f23ab9 100644 --- a/fcore/player.sml +++ b/fcore/player.sml @@ -49,92 +49,6 @@ struct if jumpPressed then (* apply gravity *) FALLING else JUMPING 0 | _ => prevAxis - fun checkWalls (player, walls, lst, acc) = - let - open QuadTree - in - case lst of - (QUERY_ON_LEFT_SIDE, wallID) :: tl => - let - val {x = wallX, width = wallWidth, ...} = - Vector.sub (walls, wallID - 1) - - val newX = wallX + wallWidth - val acc = W_X newX :: acc - in - checkWalls (player, walls, tl, acc) - end - | (QUERY_ON_RIGHT_SIDE, wallID) :: tl => - let - val {x = wallX, width = wallWidth, ...} = - Vector.sub (walls, wallID - 1) - - val newX = wallX - Constants.playerSize - val acc = W_X newX :: acc - in - checkWalls (player, walls, tl, acc) - end - | (QUERY_ON_BOTTOM_SIDE, wallID) :: tl => - let - val {y = wallY, ...} = Vector.sub (walls, wallID - 1) - - val newY = wallY - Constants.playerSize - val acc = W_Y_AXIS ON_GROUND :: W_Y newY :: acc - in - checkWalls (player, walls, tl, acc) - end - | (QUERY_ON_TOP_SIDE, wallID) :: tl => checkWalls (player, walls, tl, acc) - | [] => acc - end - - fun checkPlatforms (player, platforms, lst, acc) = - let - open QuadTree - in - case lst of - platID :: tl => - (case #yAxis player of - DROP_BELOW_PLATFORM => - (* pass through, allowing player to drop below the platform *) - checkPlatforms (player, platforms, tl, acc) - | JUMPING _ => - (* pass through, allowing player to jump above the platform *) - checkPlatforms (player, platforms, tl, acc) - | _ => - let - (* default case: - * player will land on platform and stay on the ground there. *) - val {y = platY, ...} = Vector.sub (platforms, platID - 1) - - val newY = platY - Constants.playerSize - val acc = W_Y_AXIS ON_GROUND :: W_Y newY :: acc - in - checkPlatforms (player, platforms, tl, acc) - end) - | [] => acc - end - - (* only checks for collisions with environment (walls and platforms) *) - fun getEnvironmentPatches (player, game) = - let - val {walls, wallTree, platformTree, platforms, ...} = game - - val {x, y, ...} = player - - val size = Constants.playerSize - val ww = Constants.worldWidth - val wh = Constants.worldHeight - - val platCollisions = QuadTree.getCollisionsBelow - (x, y, size, size, 0, 0, ww, wh, 0, platformTree) - val acc = checkPlatforms (player, platforms, platCollisions, []) - - val wallCollisions = QuadTree.getCollisionSides - (x, y, size, size, 0, 0, ww, wh, 0, wallTree) - in - checkWalls (player, walls, wallCollisions, acc) - end - fun getJumpPatches (player, upHeld, downHeld, acc) = let val {yAxis, jumpPressed, ...} = player @@ -432,10 +346,12 @@ struct PlayerPatch.withPatches (player, patches) end - val patches = PlayerPhysics.getPatches player + val patches = PlayerPhysics.getPhysicsPatches player val player = PlayerPatch.withPatches (player, patches) - val patches = getEnvironmentPatches (player, game) + val {walls, wallTree, platforms, platformTree, ...} = game + val patches = PlayerPhysics.getEnvironmentPatches + (player, walls, wallTree, platforms, platformTree) in PlayerPatch.withPatches (player, patches) end