functorise physics for player

fcore/physics.sml

@@ -23,7 +23,7 @@ functor MakePhysics(Fn: PHYSICS_INPUT) =
 struct
   open GameType
 
-  fun run input =
+  fun getPatches input =
     let
       val x = Fn.getX input
       val y = Fn.getY input
@@ -71,3 +71,26 @@ struct
             end
     end
 end
+
+structure PlayerPhysics =
+  MakePhysics
+    (struct
+       type t = GameType.player
+       type patch = GameType.player_patch
+
+       (* 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 = GameType.W_X
+       val W_Y = GameType.W_Y
+       val W_Y_AXIS = GameType.W_Y_AXIS
+     end)

fcore/player.sml

@@ -417,51 +417,6 @@ struct
       checkWalls (player, walls, wallCollisions, acc)
     end
 
-  fun getMovePatches player =
-    let
-      val {xAxis, yAxis, x, y, ...} = player
-
-      val desiredX =
-        case xAxis of
-          STAY_STILL => x
-        | MOVE_LEFT => x - Constants.movePlayerBy
-        | MOVE_RIGHT => x + Constants.movePlayerBy
-    in
-      case yAxis of
-        ON_GROUND => [W_X desiredX]
-      | FLOATING floated =>
-          let
-            val yAxis =
-              if floated = Constants.floatLimit then FALLING
-              else FLOATING (floated + 1)
-          in
-            [W_X desiredX, W_Y_AXIS yAxis]
-          end
-      | FALLING =>
-          let val desiredY = y + Constants.movePlayerBy
-          in [W_X desiredX, W_Y desiredY]
-          end
-      | DROP_BELOW_PLATFORM =>
-          let val desiredY = y + Constants.movePlayerBy
-          in [W_X desiredX, W_Y desiredY]
-          end
-      | JUMPING jumped =>
-          if jumped + Constants.movePlayerBy > Constants.jumpLimit then
-            (* if we are above the jump limit, trigger a fall *)
-            let val newYAxis = FLOATING 0
-            in [W_X desiredX, W_Y_AXIS newYAxis]
-            end
-          else
-            (* jump *)
-            let
-              val newJumped = jumped + Constants.movePlayerBy
-              val newYAxis = JUMPING newJumped
-              val desiredY = y - Constants.movePlayerBy
-            in
-              [W_X desiredX, W_Y desiredY, W_Y_AXIS newYAxis]
-            end
-    end
-
   fun getJumpPatches (player, upHeld, downHeld, acc) =
     let
       val {yAxis, jumpPressed, ...} = player
@@ -759,7 +714,7 @@ struct
           withPatches (player, patches)
         end
 
-      val patches = getMovePatches player
+      val patches = PlayerPhysics.getPatches player
       val player = withPatches (player, patches)
 
       val patches = getEnvironmentPatches (player, game)

oms.mlb

@@ -17,6 +17,7 @@ fcore/platform.sml
 fcore/enemy.sml
 fcore/game-type.sml
 
+fcore/physics.sml
 fcore/player.sml
 fcore/projectile.sml
 
@@ -38,5 +39,3 @@ shell/input-state.sml
 shell/gl-shaders.sml
 shell/gl-draw.sml
 shell/shell.sml
-
-fcore/physics.sml