get player to react to wall quad tree

fcore/player.sml

@@ -5,53 +5,100 @@ struct
 
   (* width/height *)
   val size = 35
+  val realSize = 35.0
 
   val moveBy = 5
-  val jumpLimit = 55
+  val jumpLimit = 150
 
   type t = {yAxis: y_axis, xAxis: x_axis, health: int, x: int, y: int}
 
+  (* placeholder *)
+  val initial: t =
+    {yAxis = JUMPING 0, xAxis = STAY_STILL, health = 3, x = 500, y = 500}
+
+  (* 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) =
     {yAxis = yAxis, xAxis = xAxis, health = health, x = x, y = y}
 
-  fun move (player: t) =
+  fun checkWalls (yAxis, xAxis, x, y, health, lst) =
     let
-      val {yAxis, xAxis, x, y, health} = player
+      open QuadTree
+    in
+      case lst of
+        (QUERY_ON_LEFT_SIDE, wallID) :: tl =>
+          let
+            val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
+            val newX = wallX + wallWidth
+          in
+            checkWalls (yAxis, xAxis, newX, y, health, tl)
+          end
+      | (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
+          let
+            val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
+            val newX = wallX - size
+          in
+            checkWalls (yAxis, xAxis, newX, y, health, tl)
+          end
+      | (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
+          let
+            val {y = wallY, ...} = Wall.getID wallID
+            val newY = wallY - size
+          in
+            checkWalls (yAxis, xAxis, x, newY, health, tl)
+          end
+      | (QUERY_ON_TOP_SIDE, wallID) :: tl =>
+          checkWalls (yAxis, xAxis, x, y, health, tl)
+      | [] => mkPlayer (health, xAxis, yAxis, x, y)
+    end
 
-      (* todo: check for wall and platform collisions 
+  fun move ({x, y, xAxis, yAxis, health}: t) =
-       * in case analysis for both axis
+    let
-       * *)
+      (* check against wall quad tree *)
-      val x =
+      val desiredX =
         case xAxis of
-          MOVE_LEFT =>
+          STAY_STILL => x
-            (* todo: check if we are trying to move left 
+        | MOVE_LEFT => x - moveBy
-             * even though player is against wall.
+        | MOVE_RIGHT => x + moveBy
-             * In that case, keep same action (it is a sign for us to animate),
-             * but don't actually move leftwards. *)
-            x - moveBy
-        | MOVE_RIGHT => (* todo: check against wall *) x + moveBy
-        | STAY_STILL => x
     in
       case yAxis of
-        JUMPING jumped =>
+        ON_GROUND =>
-          (* check if we hit jump limit; 
+          let
-           * if we did, change to falling case. 
+            val collisions = QuadTree.getCollisionSides
-           * *)
+              (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
-          if jumped + moveBy <= jumpLimit then
+          in
+            checkWalls (yAxis, xAxis, desiredX, y, health, collisions)
+          end
+      | FALLING =>
+          let
+            val desiredY = y + moveBy
+            val collisions = QuadTree.getCollisionSides
+              (desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+          in
+            checkWalls (yAxis, xAxis, desiredX, desiredY, health, collisions)
+          end
+      | JUMPING jumped =>
+          if jumped + moveBy > jumpLimit then
+            (* if we are above the jump limit, trigger a fall *)
             let
-              val jumped = jumped + moveBy
+              val collisions = QuadTree.getCollisionSides
-              val yAxis = JUMPING jumped
+                (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
-              val y = y + moveBy
             in
-              mkPlayer (health, xAxis, yAxis, x, y)
+              checkWalls (FALLING, xAxis, desiredX, y, health, collisions)
             end
           else
-            mkPlayer (health, xAxis, FALLING, x, y)
+            (* jump *)
-      | FALLING =>
+            let
-          (* todo: keep decrementing and falling down 
+              val newJumped = jumped + moveBy
-           * until we hit ground or platform 
+              val yAxis = JUMPING newJumped
-           * *)
+              val desiredY = y - moveBy
-          mkPlayer (health, xAxis, yAxis, x, y - moveBy)
+
-      | ON_GROUND => mkPlayer (health, xAxis, yAxis, x, y)
+              val collisions = QuadTree.getCollisionSides
+                (desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
+            in
+              checkWalls (yAxis, xAxis, desiredX, desiredY, health, collisions)
+            end
     end
 end

fcore/quad-tree.sml

@@ -8,20 +8,18 @@ sig
   | QUERY_ON_RIGHT_SIDE
   | QUERY_ON_BOTTOM_SIDE
 
-  val insert : int * int * int * int *
+  val insert: int * int * int * int * int * int * int * int * int * t -> t
-               int * int * int * int *
-               int * t -> t
 
-  val getCollisions : int * int * int * int *
+  val fromItem: int * int * int * int * int -> t
-                      int * int * int * int *
-                      int * t -> int list
 
-  val getCollisionSides : int * int * int * int *
+  val getCollisions: int * int * int * int * int * int * int * int * int * t
-                          int * int * int * int *
+                     -> int list
-                          int * t -> (collision_side * int) list
+
+  val getCollisionSides: int * int * int * int * int * int * int * int * int * t
+                         -> (collision_side * int) list
 end
 
-structure QuadTree : QUAD_TREE =
+structure QuadTree: QUAD_TREE =
 struct
   type item = {itemID: int, startX: int, startY: int, width: int, height: int}
 
@@ -43,6 +41,14 @@ struct
       }
   | LEAF of item vector
 
+  fun fromItem (itemID, startX, startY, width, height) =
+    let
+      val item = mkItem (itemID, startX, startY, width, height)
+      val elements = Vector.fromList [item]
+    in
+      LEAF elements
+    end
+
   (* max size of vector before we split it further *)
   val maxSize = 3
 
@@ -68,23 +74,47 @@ struct
       val middleY = quadY + halfHeight
 
       val isInTopLeft = isItemInQuad
-        ( itemX, itemY, itemWidth, itemHeight
+        ( itemX
-        , quadX, quadY, halfWidth, halfHeight
+        , itemY
+        , itemWidth
+        , itemHeight
+        , quadX
+        , quadY
+        , halfWidth
+        , halfHeight
         )
 
       val isInTopRight = isItemInQuad
-        ( itemX, itemY, itemWidth, itemHeight
+        ( itemX
-        , middleX, quadY, halfWidth, halfHeight
+        , itemY
+        , itemWidth
+        , itemHeight
+        , middleX
+        , quadY
+        , halfWidth
+        , halfHeight
         )
 
       val isInBottomLeft = isItemInQuad
-        ( itemX, itemY, itemWidth, itemHeight
+        ( itemX
-        , quadX, middleY, halfWidth, halfHeight
+        , itemY
+        , itemWidth
+        , itemHeight
+        , quadX
+        , middleY
+        , halfWidth
+        , halfHeight
         )
 
       val isInBottomRight = isItemInQuad
-        ( itemX, itemY, itemWidth, itemHeight
+        ( itemX
-        , middleX, middleY, halfWidth, halfHeight
+        , itemY
+        , itemWidth
+        , itemHeight
+        , middleX
+        , middleY
+        , halfWidth
+        , halfHeight
         )
     in
       if isInTopLeft then TOP_LEFT
@@ -135,9 +165,16 @@ struct
       end
 
   fun insert
-    ( itemX, itemY, itemWidth, itemHeight
+    ( itemX
-    , quadX, quadY, quadWidth, quadHeight
+    , itemY
-    , itemID, tree: t
+    , itemWidth
+    , itemHeight
+    , quadX
+    , quadY
+    , quadWidth
+    , quadHeight
+    , itemID
+    , tree: t
     ) =
     case tree of
       NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
@@ -146,8 +183,14 @@ struct
          * Else, add to elements vector in current node. *)
         (case
            whichQuadrant
-             ( itemX, itemY, itemWidth, itemHeight
+             ( itemX
-             , quadX, quadY, quadWidth, quadHeight
+             , itemY
+             , itemWidth
+             , itemHeight
+             , quadX
+             , quadY
+             , quadWidth
+             , quadHeight
              )
          of
            TOP_LEFT =>
@@ -160,9 +203,16 @@ struct
                val halfHeight = quadHeight div 2
 
                val newTopLeft = insert
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, quadY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, topLeft
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , quadY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , topLeft
                  )
              in
                NODE
@@ -180,9 +230,16 @@ struct
                val middleX = quadX + halfWidth
 
                val newTopRight = insert
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , middleX, quadY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, topRight
+                 , itemWidth
+                 , itemHeight
+                 , middleX
+                 , quadY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , topRight
                  )
              in
                NODE
@@ -200,9 +257,16 @@ struct
                val middleY = quadY + halfHeight
 
                val newBottomLeft = insert
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, middleY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, bottomLeft
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , middleY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , bottomLeft
                  )
              in
                NODE
@@ -221,9 +285,16 @@ struct
                val middleY = quadY + halfHeight
 
                val newBottomRight = insert
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , middleX, middleY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, bottomRight
+                 , itemWidth
+                 , itemHeight
+                 , middleX
+                 , middleY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , bottomRight
                  )
              in
                NODE
@@ -258,39 +329,85 @@ struct
           in
             (case
                whichQuadrant
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, quadY, quadWidth, quadHeight
+                 , itemY
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , quadY
+                 , quadWidth
+                 , quadHeight
                  )
              of
                TOP_LEFT =>
                  splitLeaf
-                   ( quadX, quadY, quadWidth, quadHeight
+                   ( quadX
-                   , [item], [], [], [], []
+                   , quadY
-                   , elements, pos
+                   , quadWidth
+                   , quadHeight
+                   , [item]
+                   , []
+                   , []
+                   , []
+                   , []
+                   , elements
+                   , pos
                    )
              | TOP_RIGHT =>
                  splitLeaf
-                   ( quadX, quadY, quadWidth, quadHeight
+                   ( quadX
-                   , [], [item], [], [], []
+                   , quadY
-                   , elements, pos
+                   , quadWidth
+                   , quadHeight
+                   , []
+                   , [item]
+                   , []
+                   , []
+                   , []
+                   , elements
+                   , pos
                    )
              | BOTTOM_LEFT =>
                  splitLeaf
-                   ( quadX, quadY, quadWidth, quadHeight
+                   ( quadX
-                   , [], [], [item], [], []
+                   , quadY
-                   , elements, pos
+                   , quadWidth
+                   , quadHeight
+                   , []
+                   , []
+                   , [item]
+                   , []
+                   , []
+                   , elements
+                   , pos
                    )
              | BOTTOM_RIGHT =>
                  splitLeaf
-                   ( quadX, quadY, quadWidth, quadHeight
+                   ( quadX
-                   , [], [], [], [item], []
+                   , quadY
-                   , elements, pos
+                   , quadWidth
+                   , quadHeight
+                   , []
+                   , []
+                   , []
+                   , [item]
+                   , []
+                   , elements
+                   , pos
                    )
              | PARENT_QUADRANT =>
                  splitLeaf
-                   ( quadX, quadY, quadWidth, quadHeight
+                   ( quadX
-                   , [], [], [], [], [item]
+                   , quadY
-                   , elements, pos
+                   , quadWidth
+                   , quadHeight
+                   , []
+                   , []
+                   , []
+                   , []
+                   , [item]
+                   , elements
+                   , pos
                    ))
           end
         else
@@ -310,11 +427,8 @@ struct
       val endX = startX + width
       val endY = startY + height
     in
-      iX < endX 
+      iX < endX andalso itemEndX > startX andalso iY < endY
-      andalso itemEndX > startX
+      andalso itemEndY > startY andalso itemID <> checkID
-      andalso iY < endY 
-      andalso itemEndY > startY
-      andalso itemID <> checkID
     end
 
   fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
@@ -324,97 +438,124 @@ struct
       let
         val item = Vector.sub (elements, pos)
         val acc =
-          if isColliding (iX, iY, iW, iH, itemID, item)
+          if isColliding (iX, iY, iW, iH, itemID, item) then #itemID item :: acc
-          then #itemID item :: acc
           else acc
       in
         getCollisionsVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
       end
 
-  fun getCollisionsAll 
+  fun getCollisionsAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
-    ( iX, iY, iW, iH, qW, qH
-    , itemID, acc, tree
-    ) =
     case tree of
       NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
         let
-          val acc = 
+          val acc = getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)
-            getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)
           val halfWidth = qW div 2
           val halfHeight = qH div 2
 
-          val acc = 
+          val acc = getCollisionsAll
-            getCollisionsAll
+            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)
-              ( iX, iY, iW, iH, halfWidth, halfHeight
-              , itemID, acc, topLeft
-              )
 
-          val acc = 
+          val acc = getCollisionsAll
-            getCollisionsAll
+            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)
-              ( iX, iY, iW, iH, halfWidth, halfHeight
-              , itemID, acc, topRight
-              )
 
-          val acc = 
+          val acc = getCollisionsAll
-            getCollisionsAll
+            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
-              ( iX, iY, iW, iH, halfWidth, halfHeight
-              , itemID, acc, bottomLeft
-              )
         in
           getCollisionsAll
-            ( iX, iY, iW, iH, halfWidth, halfWidth
+            (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
-            , itemID, acc, bottomRight
-            )
         end
     | LEAF elements =>
         getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc)
 
   fun helpGetCollisions
-    ( itemX, itemY, itemWidth, itemHeight
+    ( itemX
-    , quadX, quadY, quadWidth, quadHeight
+    , itemY
-    , itemID, acc, tree: t
+    , itemWidth
+    , itemHeight
+    , quadX
+    , quadY
+    , quadWidth
+    , quadHeight
+    , itemID
+    , acc
+    , tree: t
     ) =
     case tree of
       NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
         let
           (* get colliding elements in this node first *)
-          val acc = 
+          val acc = getCollisionsVec
-            getCollisionsVec 
+            (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
-              ( itemX, itemY, itemWidth, itemHeight
-              , itemID, 0, elements, acc
-              )
           val halfWidth = quadWidth div 2
           val halfHeight = quadHeight div 2
         in
-          (case whichQuadrant 
+          (case
-            ( itemX, itemY, itemWidth, itemHeight
+             whichQuadrant
-            , quadX, quadY, quadWidth, quadHeight
+               ( itemX
-            ) 
+               , itemY
+               , itemWidth
+               , itemHeight
+               , quadX
+               , quadY
+               , quadWidth
+               , quadHeight
+               )
            of
              TOP_LEFT =>
                helpGetCollisions
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, quadY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, acc, topLeft
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , quadY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , topLeft
                  )
            | TOP_RIGHT =>
                helpGetCollisions
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX + halfWidth, quadY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, acc, topRight
+                 , itemWidth
+                 , itemHeight
+                 , quadX + halfWidth
+                 , quadY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , topRight
                  )
            | BOTTOM_LEFT =>
                helpGetCollisions
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, quadY + halfHeight, halfWidth, halfHeight
+                 , itemY
-                 , itemID, acc, bottomLeft
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , quadY + halfHeight
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , bottomLeft
                  )
            | BOTTOM_RIGHT =>
                helpGetCollisions
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX + halfWidth, quadY + halfHeight
+                 , itemY
-                 , halfWidth, halfHeight
+                 , itemWidth
-                 , itemID, acc, bottomRight
+                 , itemHeight
+                 , quadX + halfWidth
+                 , quadY + halfHeight
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , bottomRight
                  )
            | PARENT_QUADRANT =>
                (* In this function, PARENT_QUADRANT means 
@@ -423,50 +564,84 @@ struct
                 * it may be in any of the child quadrants. 
                 * So descend down on all the children, accumulating acc. 
                 * *)
-                let
+               let
-                  val acc = 
+                 val acc = getCollisionsAll
-                    getCollisionsAll
+                   ( itemX
-                      ( itemX, itemY, itemWidth, itemHeight
+                   , itemY
-                      , halfWidth, halfHeight
+                   , itemWidth
-                      , itemID, acc, topLeft
+                   , itemHeight
-                      )
+                   , halfWidth
+                   , halfHeight
+                   , itemID
+                   , acc
+                   , topLeft
+                   )
 
-                  val acc = 
+                 val acc = getCollisionsAll
-                    getCollisionsAll
+                   ( itemX
-                      ( itemX, itemY, itemWidth, itemHeight
+                   , itemY
-                      , halfWidth, halfHeight
+                   , itemWidth
-                      , itemID, acc, topRight
+                   , itemHeight
-                      )
+                   , halfWidth
+                   , halfHeight
+                   , itemID
+                   , acc
+                   , topRight
+                   )
 
-                  val acc = 
+                 val acc = getCollisionsAll
-                    getCollisionsAll
+                   ( itemX
-                      ( itemX, itemY, itemWidth, itemHeight
+                   , itemY
-                      , halfWidth, halfHeight
+                   , itemWidth
-                      , itemID, acc, bottomLeft
+                   , itemHeight
-                      )
+                   , halfWidth
-                in
+                   , halfHeight
-                  getCollisionsAll
+                   , itemID
-                    ( itemX, itemY, itemWidth, itemHeight
+                   , acc
-                    , halfWidth, halfHeight
+                   , bottomLeft
-                    , itemID, acc, bottomRight
+                   )
-                    )
+               in
-                end)
+                 getCollisionsAll
+                   ( itemX
+                   , itemY
+                   , itemWidth
+                   , itemHeight
+                   , halfWidth
+                   , halfHeight
+                   , itemID
+                   , acc
+                   , bottomRight
+                   )
+               end)
         end
     | LEAF elements =>
         getCollisionsVec
-          ( itemX, itemY, itemWidth, itemHeight
+          (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
-          , itemID, 0, elements, acc
-          )
 
   fun getCollisions
-    ( itemX, itemY, itemWidth, itemHeight
+    ( itemX
-    , quadX, quadY, quadWidth, quadHeight
+    , itemY
-    , itemID, tree
+    , itemWidth
+    , itemHeight
+    , quadX
+    , quadY
+    , quadWidth
+    , quadHeight
+    , itemID
+    , tree
     ) =
     helpGetCollisions
-      ( itemX, itemY, itemWidth, itemHeight
+      ( itemX
-      , quadX, quadY, quadWidth, quadHeight
+      , itemY
-      , itemID, [], tree
+      , itemWidth
+      , itemHeight
+      , quadX
+      , quadY
+      , quadWidth
+      , quadHeight
+      , itemID
+      , []
+      , tree
       )
 
   (* no variant to represent 'no collision' case
@@ -505,26 +680,16 @@ struct
       val minXDist = iHalfW + cHalfW
       val minYDist = iHalfH + cHalfH
 
-      val depthX = 
+      val depthX = if diffX > 0 then minXDist - diffX else (~minXDist) - diffX
-        if diffX > 0
-        then minXDist - diffX
-        else (~minXDist) - diffX
 
-      val depthY =
+      val depthY = if diffY > 0 then minYDist - diffY else (~minYDist) - diffY
-        if diffY > 0 
-        then minYDist - diffY
-        else (~minYDist) - diffY
     in
       if abs depthX < abs depthY then
-        if depthX > 0 then
+        if depthX > 0 then QUERY_ON_LEFT_SIDE else QUERY_ON_RIGHT_SIDE
-          QUERY_ON_LEFT_SIDE
+      else if depthY > 0 then
-        else
+        QUERY_ON_TOP_SIDE
-          QUERY_ON_RIGHT_SIDE
       else
-        if depthY > 0 then
+        QUERY_ON_BOTTOM_SIDE
-          QUERY_ON_TOP_SIDE
-        else
-          QUERY_ON_BOTTOM_SIDE
     end
 
   (* like getCollisionsVec, but instead of consing just the itemID, 
@@ -538,100 +703,128 @@ struct
         val item = Vector.sub (elements, pos)
         val acc =
           if isColliding (iX, iY, iW, iH, itemID, item) then
-            let
+            let val side = getCollisionSide (iX, iY, iW, iH, item)
-              val side = getCollisionSide (iX, iY, iW, iH, item)
+            in (side, #itemID item) :: acc
-            in
-              (side, #itemID item) :: acc
             end
-          else acc
+          else
+            acc
       in
         getCollisionSideVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc)
       end
 
-  fun getCollisionSidesAll 
+  fun getCollisionSidesAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) =
-    ( iX, iY, iW, iH, qW, qH
-    , itemID, acc, tree
-    ) =
     case tree of
       NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
         let
-          val acc = 
+          val acc = getCollisionSideVec
-            getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc)
+            (iX, iY, iW, iH, itemID, 0, elements, acc)
           val halfWidth = qW div 2
           val halfHeight = qH div 2
 
-          val acc = 
+          val acc = getCollisionSidesAll
-            getCollisionSidesAll
+            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft)
-              ( iX, iY, iW, iH, halfWidth, halfHeight
-              , itemID, acc, topLeft
-              )
 
-          val acc = 
+          val acc = getCollisionSidesAll
-            getCollisionSidesAll
+            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight)
-              ( iX, iY, iW, iH, halfWidth, halfHeight
-              , itemID, acc, topRight
-              )
 
-          val acc = 
+          val acc = getCollisionSidesAll
-            getCollisionSidesAll
+            (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft)
-              ( iX, iY, iW, iH, halfWidth, halfHeight
-              , itemID, acc, bottomLeft
-              )
         in
           getCollisionSidesAll
-            ( iX, iY, iW, iH, halfWidth, halfWidth
+            (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight)
-            , itemID, acc, bottomRight
-            )
         end
     | LEAF elements =>
         getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc)
 
   fun helpGetCollisionSides
-    ( itemX, itemY, itemWidth, itemHeight
+    ( itemX
-    , quadX, quadY, quadWidth, quadHeight
+    , itemY
-    , itemID, acc, tree: t
+    , itemWidth
+    , itemHeight
+    , quadX
+    , quadY
+    , quadWidth
+    , quadHeight
+    , itemID
+    , acc
+    , tree: t
     ) =
     case tree of
       NODE {topLeft, topRight, bottomLeft, bottomRight, elements} =>
         let
           (* get colliding elements in this node first *)
-          val acc = 
+          val acc = getCollisionSideVec
-            getCollisionSideVec 
+            (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
-              ( itemX, itemY, itemWidth, itemHeight
-              , itemID, 0, elements, acc
-              )
           val halfWidth = quadWidth div 2
           val halfHeight = quadHeight div 2
         in
-          (case whichQuadrant 
+          (case
-            ( itemX, itemY, itemWidth, itemHeight
+             whichQuadrant
-            , quadX, quadY, quadWidth, quadHeight
+               ( itemX
-            ) 
+               , itemY
+               , itemWidth
+               , itemHeight
+               , quadX
+               , quadY
+               , quadWidth
+               , quadHeight
+               )
            of
              TOP_LEFT =>
                helpGetCollisionSides
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, quadY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, acc, topLeft
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , quadY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , topLeft
                  )
            | TOP_RIGHT =>
                helpGetCollisionSides
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX + halfWidth, quadY, halfWidth, halfHeight
+                 , itemY
-                 , itemID, acc, topRight
+                 , itemWidth
+                 , itemHeight
+                 , quadX + halfWidth
+                 , quadY
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , topRight
                  )
            | BOTTOM_LEFT =>
                helpGetCollisionSides
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX, quadY + halfHeight, halfWidth, halfHeight
+                 , itemY
-                 , itemID, acc, bottomLeft
+                 , itemWidth
+                 , itemHeight
+                 , quadX
+                 , quadY + halfHeight
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , bottomLeft
                  )
            | BOTTOM_RIGHT =>
                helpGetCollisionSides
-                 ( itemX, itemY, itemWidth, itemHeight
+                 ( itemX
-                 , quadX + halfWidth, quadY + halfHeight
+                 , itemY
-                 , halfWidth, halfHeight
+                 , itemWidth
-                 , itemID, acc, bottomRight
+                 , itemHeight
+                 , quadX + halfWidth
+                 , quadY + halfHeight
+                 , halfWidth
+                 , halfHeight
+                 , itemID
+                 , acc
+                 , bottomRight
                  )
            | PARENT_QUADRANT =>
                (* In this function, PARENT_QUADRANT means 
@@ -640,49 +833,83 @@ struct
                 * it may be in any of the child quadrants. 
                 * So descend down on all the children, accumulating acc. 
                 * *)
-                let
+               let
-                  val acc = 
+                 val acc = getCollisionSidesAll
-                    getCollisionSidesAll
+                   ( itemX
-                      ( itemX, itemY, itemWidth, itemHeight
+                   , itemY
-                      , halfWidth, halfHeight
+                   , itemWidth
-                      , itemID, acc, topLeft
+                   , itemHeight
-                      )
+                   , halfWidth
+                   , halfHeight
+                   , itemID
+                   , acc
+                   , topLeft
+                   )
 
-                  val acc = 
+                 val acc = getCollisionSidesAll
-                    getCollisionSidesAll
+                   ( itemX
-                      ( itemX, itemY, itemWidth, itemHeight
+                   , itemY
-                      , halfWidth, halfHeight
+                   , itemWidth
-                      , itemID, acc, topRight
+                   , itemHeight
-                      )
+                   , halfWidth
+                   , halfHeight
+                   , itemID
+                   , acc
+                   , topRight
+                   )
 
-                  val acc = 
+                 val acc = getCollisionSidesAll
-                    getCollisionSidesAll
+                   ( itemX
-                      ( itemX, itemY, itemWidth, itemHeight
+                   , itemY
-                      , halfWidth, halfHeight
+                   , itemWidth
-                      , itemID, acc, bottomLeft
+                   , itemHeight
-                      )
+                   , halfWidth
-                in
+                   , halfHeight
-                  getCollisionSidesAll
+                   , itemID
-                    ( itemX, itemY, itemWidth, itemHeight
+                   , acc
-                    , halfWidth, halfHeight
+                   , bottomLeft
-                    , itemID, acc, bottomRight
+                   )
-                    )
+               in
-                end)
+                 getCollisionSidesAll
+                   ( itemX
+                   , itemY
+                   , itemWidth
+                   , itemHeight
+                   , halfWidth
+                   , halfHeight
+                   , itemID
+                   , acc
+                   , bottomRight
+                   )
+               end)
         end
     | LEAF elements =>
         getCollisionSideVec
-          ( itemX, itemY, itemWidth, itemHeight
+          (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc)
-          , itemID, 0, elements, acc
-          )
 
   fun getCollisionSides
-    ( itemX, itemY, itemWidth, itemHeight
+    ( itemX
-    , quadX, quadY, quadWidth, quadHeight
+    , itemY
-    , itemID, tree
+    , itemWidth
+    , itemHeight
+    , quadX
+    , quadY
+    , quadWidth
+    , quadHeight
+    , itemID
+    , tree
     ) =
     helpGetCollisionSides
-      ( itemX, itemY, itemWidth, itemHeight
+      ( itemX
-      , quadX, quadY, quadWidth, quadHeight
+      , itemY
-      , itemID, [], tree
+      , itemWidth
+      , itemHeight
+      , quadX
+      , quadY
+      , quadWidth
+      , quadHeight
+      , itemID
+      , []
+      , tree
       )
 end

fcore/wall.sml

@@ -1,9 +1,52 @@
 structure Wall =
 struct
-  (* Wall or platform, where player can land after falling. 
+  type t = {id: int, x: int, y: int, width: int, height: int}
-   * Difference between wall and platform is that one can jump to a platform 
-   * and go below it, but wall is completely opaque. *)
-  datatype wall_type = WALL | PLATFORM
 
+  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 wallVec = Vector.fromList [wall1, wall2, wall3]
+
+  fun getID n =
+    Vector.sub (wallVec, n - 1)
+
+  fun generateTree (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, 0, 0, 1920, 1080, id, acc)
+      in
+        generateTree (pos + 1, wallVec, acc)
+      end
+
+  val tree =
+    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) =
+    if pos = Vector.length wallVec then
+      Vector.concat acc
+    else
+      let
+        val wall = Vector.sub (wallVec, pos)
+        val {x, y, width, height, ...} = 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)
+      end
+
+  fun generateWalls () =
+    helpGenerateWalls (0, wallVec, [], 1920.0, 1080.0)
 end

message-types/input-msg.sml

@@ -0,0 +1,11 @@
+signature INPUT_MSG =
+sig
+  datatype t =
+    RESIZE_WINDOW of {width: int, height: int}
+end
+
+structure InputMsg =
+struct
+  datatype t =
+    RESIZE_WINDOW of {width: int, height: int}
+end

oms.mlb

@@ -1,6 +1,8 @@
 $(SML_LIB)/basis/basis.mlb
 
 (* fcore *)
+message-types/input-msg.sml
+
 ann
   "allowVectorExps true"
 in
@@ -8,8 +10,8 @@ in
 end
 
 fcore/quad-tree.sml
-fcore/player.sml
 fcore/wall.sml
+fcore/player.sml
 
 (* shell *)
 $(SML_LIB)/basis/mlton.mlb

shell/gl-draw.sml

@@ -2,7 +2,16 @@ structure GlDraw =
 struct
   open CML
 
-  type t = { window: MLton.Pointer.t }
+  type t =
+    { window: MLton.Pointer.t
+    , mbox: InputMsg.t Mailbox.mbox
+    , wallVertexBuffer: Word32.word
+    , wallProgram: Word32.word
+    , wallLength: int
+    , playerVertexBuffer: Word32.word
+    , playerProgram: Word32.word
+    , playerLength: int
+    }
 
   fun createShader (shaderType, shaderString) =
     let
@@ -25,17 +34,86 @@ struct
 
   fun create window =
     let
+      val mbox = Mailbox.mailbox ()
       (* create vertex buffer, program, etc. *)
-      val textVertexBuffer = Gles3.createBuffer ()
       val xyrgbVertexShader = createShader
         (Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString)
 
       val rgbFragmentShader = createShader
         (Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString)
 
-      val placeholderProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
+      (* wall here includes both walls and platforms *)
+      val wallVertexBuffer = Gles3.createBuffer ()
+      val wallProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
+
+      val playerVertexBuffer = Gles3.createBuffer ()
+      val playerProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
     in
-      {window = window}
+      { window = window
+      , mbox = mbox
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = 0
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = 0
+      }
+    end
+
+  fun uploadWall (shellState: t, vec) =
+    let
+      val
+        { window
+        , mbox
+        , playerVertexBuffer
+        , playerProgram
+        , playerLength
+        , wallVertexBuffer
+        , wallProgram
+        , wallLength = _
+        } = shellState
+
+      val _ = Gles3.bindBuffer wallVertexBuffer
+      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
+      val newWallLength = Vector.length vec div 5
+    in
+      { window = window
+      , mbox = mbox
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = playerLength
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = newWallLength
+      }
+    end
+
+  fun uploadPlayer (shellState: t, vec) =
+    let
+      val
+        { window
+        , mbox
+        , wallVertexBuffer
+        , wallProgram
+        , wallLength
+        , playerVertexBuffer
+        , playerProgram
+        , playerLength = _
+        } = shellState
+
+      val _ = Gles3.bindBuffer playerVertexBuffer
+      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
+      val newPlayerLength = Vector.length vec div 5
+    in
+      { window = window
+      , mbox = mbox
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = wallLength
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = newPlayerLength
+      }
     end
 
   fun drawXyrgb (vertexBuffer, program, drawLength) =
@@ -57,7 +135,21 @@ struct
     else
       ()
 
-  fun helpLoop (shellState as {window, ...}: t) =
+  fun drawWall ({wallVertexBuffer, wallProgram, wallLength, ...}: t) =
+    drawXyrgb (wallVertexBuffer, wallProgram, wallLength)
+
+  fun drawPlayer ({playerVertexBuffer, playerProgram, playerLength, ...}: t) =
+    drawXyrgb (playerVertexBuffer, playerProgram, playerLength)
+
+  fun draw (shellState: t) =
+    let
+      val _ = drawWall shellState
+      val _ = drawPlayer shellState
+    in
+      ()
+    end
+
+  fun helpLoop (shellState as {window, ...}: t, player) =
     case Glfw.windowShouldClose window of
       false =>
         let
@@ -69,15 +161,26 @@ struct
            * - consume draw messages 
            * - finally, draw 
            * *)
+
+          val wallVec = Wall.generateWalls ()
+          val shellState = uploadWall (shellState, wallVec)
+
+          val player = Player.move player
+          val playerVec = Player.getVec player
+          val shellState = uploadWall (shellState, wallVec)
+          val shellState = uploadPlayer (shellState, playerVec)
+
+          val _ = draw shellState
+
           val _ = Glfw.swapBuffers window
           val _ = Glfw.waitEvents ()
         in
-          helpLoop shellState
+          helpLoop (shellState, player)
         end
     | true => Glfw.terminate ()
 
   fun loop window =
     let val shellState = create window
-    in helpLoop shellState
+    in helpLoop (shellState, Player.initial)
     end
 end