add GameType.game_type which stores player and wall types, add GameUpdate.update function which takes a game type and returns a new game type, and refactor player/wall files, and gl-draw file, in light of these changes

fcore/game-type.sml

@@ -1,4 +1,70 @@
-structure GameTyoe =
+signature GAME_TYPE =
-struct
+sig
+  type wall = {id: int, x: int, y: int, width: int, height: int}
 
+  datatype player_y_axis =
+    ON_GROUND
+  | FALLING
+  | JUMPING of int
+  | FLOATING of int
+
+  datatype player_x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
+
+  type player =
+    { yAxis: player_y_axis
+    , xAxis: player_x_axis
+    , health: int
+    , x: int
+    , y: int
+    , jumpPressed: bool
+    }
+
+  type game_type = {player: player, walls: wall vector, wallTree: QuadTree.t}
+
+  val initial: game_type
+end
+
+structure GameType :> GAME_TYPE =
+struct
+  type wall = {id: int, x: int, y: int, width: int, height: int}
+
+  datatype player_y_axis =
+    ON_GROUND
+  | FALLING
+  | JUMPING of int
+  | FLOATING of int
+
+  datatype player_x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
+
+  type player =
+    { yAxis: player_y_axis
+    , xAxis: player_x_axis
+    , health: int
+    , x: int
+    , y: int
+    , jumpPressed: bool
+    }
+
+  type game_type = {player: player, walls: wall vector, wallTree: QuadTree.t}
+
+  val initial: game_type =
+    let
+      val player =
+        { yAxis = JUMPING 0
+        , xAxis = STAY_STILL
+        , health = 3
+        , x = 500
+        , y = 500
+        , jumpPressed = false
+        }
+
+      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 wall4 = {id = 4, x = 155, y = 911, width = 155, height = 55}
+      val walls = Vector.fromList [wall1, wall2, wall3, wall4]
+      val wallTree = Wall.generateTree walls
+    in
+      {player = player, walls = walls, wallTree = wallTree}
+    end
 end

fcore/game-update.sml

@@ -0,0 +1,10 @@
+structure GameUpdate =
+struct
+  fun update (game, input) =
+    let
+      val {player, walls, wallTree} = game
+      val player = Player.move (game, input)
+    in
+      {player = player, walls = walls, wallTree = wallTree}
+    end
+end

fcore/player.sml

@@ -1,7 +1,6 @@
 structure Player =
 struct
-  datatype y_axis = ON_GROUND | FALLING | JUMPING of int | FLOATING of int
+  open GameType
-  datatype x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
 
   (* width/height *)
   val size = 35
@@ -11,29 +10,6 @@ struct
   val jumpLimit = 150
   val floatLimit = 3
 
-  type t =
-    { yAxis: y_axis
-    , xAxis: x_axis
-    , health: int
-    , x: int
-    , y: int
-    , jumpPressed: bool
-    }
-
-  (* placeholder *)
-  val initial: t =
-    { yAxis = JUMPING 0
-    , xAxis = STAY_STILL
-    , health = 3
-    , x = 500
-    , y = 500
-    , jumpPressed = false
-    }
-
-  (* placeholder *)
-  fun getVec ({x, y, ...}: t) =
-    Block.lerp (x, y, realSize, realSize, 1920.0, 1080.0, 0.5, 0.5, 0.5)
-
   fun mkPlayer (health, xAxis, yAxis, x, y, jumpPressed) =
     { yAxis = yAxis
     , xAxis = xAxis
@@ -43,38 +19,47 @@ struct
     , jumpPressed = jumpPressed
     }
 
-  fun checkWalls (yAxis, xAxis, x, y, health, jumpPressed, lst) =
+  fun checkWalls (yAxis, xAxis, x, y, health, jumpPressed, lst, game: game_type) =
     let
       open QuadTree
     in
       case lst of
         (QUERY_ON_LEFT_SIDE, wallID) :: tl =>
           let
-            val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
+            val {walls, ...} = game
+            val {x = wallX, width = wallWidth, ...} =
+              Vector.sub (walls, wallID - 1)
+
             val newX = wallX + wallWidth
           in
-            checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl)
+            checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl, game)
           end
       | (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
           let
-            val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
+            val {walls, ...} = game
+            val {x = wallX, width = wallWidth, ...} =
+              Vector.sub (walls, wallID - 1)
+
             val newX = wallX - size
           in
-            checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl)
+            checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl, game)
           end
       | (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
           let
-            val {y = wallY, ...} = Wall.getID wallID
+            val {walls, ...} = game
+            val {y = wallY, ...} = Vector.sub (walls, wallID - 1)
+
             val newY = wallY - size
           in
-            checkWalls (ON_GROUND, xAxis, x, newY, health, jumpPressed, tl)
+            checkWalls
+              (ON_GROUND, xAxis, x, newY, health, jumpPressed, tl, game)
           end
       | (QUERY_ON_TOP_SIDE, wallID) :: tl =>
-          checkWalls (yAxis, xAxis, x, y, health, jumpPressed, tl)
+          checkWalls (yAxis, xAxis, x, y, health, jumpPressed, tl, game)
       | [] => mkPlayer (health, xAxis, yAxis, x, y, jumpPressed)
     end
 
-  fun helpMove (x, y, xAxis, yAxis, health, jumpPressed) =
+  fun helpMove (x, y, xAxis, yAxis, health, jumpPressed, game: game_type) =
     let
       (* check against wall quad tree *)
       val desiredX =
@@ -87,27 +72,37 @@ struct
         ON_GROUND =>
           let
             val collisions = QuadTree.getCollisionSides
-              (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+              (desiredX, y, size, size, 0, 0, 1920, 1080, 0, #wallTree game)
           in
             checkWalls
-              (yAxis, xAxis, desiredX, y, health, jumpPressed, collisions)
+              (yAxis, xAxis, desiredX, y, health, jumpPressed, collisions, game)
           end
       | FLOATING floated =>
           let
             val collisions = QuadTree.getCollisionSides
-              (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+              (desiredX, y, size, size, 0, 0, 1920, 1080, 0, #wallTree game)
 
             val yAxis =
               if floated = floatLimit then FALLING else FLOATING (floated + 1)
           in
             checkWalls
-              (yAxis, xAxis, desiredX, y, health, jumpPressed, collisions)
+              (yAxis, xAxis, desiredX, y, health, jumpPressed, collisions, game)
           end
       | FALLING =>
           let
             val desiredY = y + moveBy
             val collisions = QuadTree.getCollisionSides
-              (desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+              ( desiredX
+              , desiredY
+              , size
+              , size
+              , 0
+              , 0
+              , 1920
+              , 1080
+              , 0
+              , #wallTree game
+              )
           in
             checkWalls
               ( yAxis
@@ -117,6 +112,7 @@ struct
               , health
               , jumpPressed
               , collisions
+              , game
               )
           end
       | JUMPING jumped =>
@@ -124,7 +120,7 @@ struct
             (* if we are above the jump limit, trigger a fall *)
             let
               val collisions = QuadTree.getCollisionSides
-                (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+                (desiredX, y, size, size, 0, 0, 1920, 1080, 0, #wallTree game)
             in
               checkWalls
                 ( FLOATING 0
@@ -134,6 +130,7 @@ struct
                 , health
                 , jumpPressed
                 , collisions
+                , game
                 )
             end
           else
@@ -144,7 +141,17 @@ struct
               val desiredY = y - moveBy
 
               val collisions = QuadTree.getCollisionSides
-                (desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+                ( desiredX
+                , desiredY
+                , size
+                , size
+                , 0
+                , 0
+                , 1920
+                , 1080
+                , 0
+                , #wallTree game
+                )
             in
               checkWalls
                 ( yAxis
@@ -154,6 +161,7 @@ struct
                 , health
                 , jumpPressed
                 , collisions
+                , game
                 )
             end
     end
@@ -195,9 +203,11 @@ struct
       ON_GROUND => if jumpPressed then prevAxis else JUMPING 0
     | _ => prevAxis
 
-  fun move ({x, y, yAxis, health, jumpPressed, ...}: t, input) =
+  fun move (game: game_type, input) =
     let
+      val {x, y, yAxis, health, jumpPressed, ...} = #player game
       val {leftHeld, rightHeld, upHeld, downHeld} = input
+
       val xAxis = getXAxis (leftHeld, rightHeld)
     in
       case (upHeld, downHeld) of
@@ -206,27 +216,27 @@ struct
             val yAxis = defaultYAxis yAxis
             val jumpPressed = false
           in
-            helpMove (x, y, xAxis, yAxis, health, jumpPressed)
+            helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
           end
       | (true, true) =>
-          let
+          let val yAxis = defaultYAxis yAxis
-            val yAxis = defaultYAxis yAxis
+          in helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
-          in
-            helpMove (x, y, xAxis, yAxis, health, jumpPressed)
           end
       | (true, false) =>
           let
             val yAxis = onJumpPressed (yAxis, jumpPressed)
             val jumpPressed = true
           in
-            helpMove (x, y, xAxis, yAxis, health, jumpPressed)
+            helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
           end
       | (false, true) =>
           (* todo: should move down if on platform *)
-          let
+          let val jumpPressed = false
-            val jumpPressed = false
+          in helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
-          in
-            helpMove (x, y, xAxis, yAxis, health, jumpPressed)
           end
     end
+
+  (* placeholder *)
+  fun getDrawVec ({x, y, ...}: player) =
+    Block.lerp (x, y, realSize, realSize, 1920.0, 1080.0, 0.5, 0.5, 0.5)
 end

fcore/quad-tree.sml

@@ -2,6 +2,8 @@ signature QUAD_TREE =
 sig
   type t
 
+  val empty: t
+
   datatype collision_side =
     QUERY_ON_LEFT_SIDE
   | QUERY_ON_TOP_SIDE
@@ -41,6 +43,8 @@ struct
       }
   | LEAF of item vector
 
+  val empty = LEAF (Vector.fromList [])
+
   fun fromItem (itemID, startX, startY, width, height) =
     let
       val item = mkItem (itemID, startX, startY, width, height)

fcore/wall.sml

@@ -1,18 +1,6 @@
 structure Wall =
 struct
-  type t = {id: int, x: int, y: int, width: int, height: int}
+  fun helpGenerateTree (pos, wallVec, acc) =
-
-  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 wall4 = {id = 4, x = 155, y = 911, width = 155, height = 55}
-
-  val wallVec = Vector.fromList [wall1, wall2, wall3, wall4]
-
-  fun getID n =
-    Vector.sub (wallVec, n - 1)
-
-  fun generateTree (pos, wallVec, acc) =
     if pos = Vector.length wallVec then
       acc
     else
@@ -21,33 +9,27 @@ struct
         val acc = QuadTree.insert
           (x, y, width, height, 0, 0, 1920, 1080, id, acc)
       in
-        generateTree (pos + 1, wallVec, acc)
+        helpGenerateTree (pos + 1, wallVec, acc)
       end
 
-  val tree =
+  fun generateTree wallVec = helpGenerateTree (0, wallVec, QuadTree.empty)
-    let
-      val {id, x, y, width, height} = Vector.sub (wallVec, 0)
-      val acc = QuadTree.fromItem (id, x, y, width, height)
-    in
-      generateTree (1, wallVec, acc)
-    end
 
-  fun helpGenerateWalls (pos, wallVec, acc, winWidth, winHeight) =
+  fun helpGetDrawVec (pos, wallVec, acc, winWidth, winHeight) =
     if pos = Vector.length wallVec then
       Vector.concat acc
     else
       let
         val wall = Vector.sub (wallVec, pos)
-        val {x, y, width, height, ...} = wall
+        val {x, y, width, height, id = _} = wall
         val width = Real32.fromInt width
         val height = Real32.fromInt height
         val block = Block.lerp
           (x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0)
         val acc = block :: acc
       in
-        helpGenerateWalls (pos + 1, wallVec, acc, winWidth, winHeight)
+        helpGetDrawVec (pos + 1, wallVec, acc, winWidth, winHeight)
       end
 
-  fun generateWalls () =
+  fun getDrawVec wallVec =
-    helpGenerateWalls (0, wallVec, [], 1920.0, 1080.0)
+    helpGetDrawVec (0, wallVec, [], 1920.0, 1080.0)
 end

oms.mlb

@@ -1,16 +1,21 @@
 $(SML_LIB)/basis/basis.mlb
 
 (* fcore *)
+fcore/quad-tree.sml
+
 ann
   "allowVectorExps true"
 in
   fcore/block.sml
 end
 
-fcore/quad-tree.sml
 fcore/wall.sml
+fcore/game-type.sml
+
 fcore/player.sml
 
+fcore/game-update.sml
+
 (* shell *)
 $(SML_LIB)/basis/mlton.mlb
 

shell/gl-draw.sml

@@ -140,7 +140,7 @@ struct
       ()
     end
 
-  fun helpLoop (shellState as {window, ...}: t, player) =
+  fun helpLoop (shellState as {window, ...}: t, game) =
     case Glfw.windowShouldClose window of
       false =>
         let
@@ -153,11 +153,11 @@ struct
            * - finally, draw 
            * *)
 
-          val wallVec = Wall.generateWalls ()
-
           val input = InputState.getSnapshot ()
-          val player = Player.move (player, input)
+          val game = GameUpdate.update (game, input)
-          val playerVec = Player.getVec player
+
+          val wallVec = Wall.getDrawVec (#walls game)
+          val playerVec = Player.getDrawVec (#player game)
 
           val shellState = uploadWall (shellState, wallVec)
           val shellState = uploadPlayer (shellState, playerVec)
@@ -167,12 +167,12 @@ struct
           val _ = Glfw.swapBuffers window
           val _ = Glfw.waitEvents ()
         in
-          helpLoop (shellState, player)
+          helpLoop (shellState, game)
         end
     | true => Glfw.terminate ()
 
   fun loop window =
     let val shellState = create window
-    in helpLoop (shellState, Player.initial)
+    in helpLoop (shellState, GameType.initial)
     end
 end