add functionality to move player by using arrow keys

shell/gl-draw.sml

@@ -1,10 +1,7 @@
 structure GlDraw =
 struct
-  open CML
-
   type t =
     { window: MLton.Pointer.t
-    , mbox: InputMsg.t Mailbox.mbox
     , wallVertexBuffer: Word32.word
     , wallProgram: Word32.word
     , wallLength: int
@@ -34,7 +31,6 @@ struct
 
   fun create window =
     let
-      val mbox = Mailbox.mailbox ()
       (* create vertex buffer, program, etc. *)
       val xyrgbVertexShader = createShader
         (Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString)
@@ -50,7 +46,6 @@ struct
       val playerProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
     in
       { window = window
-      , mbox = mbox
       , wallVertexBuffer = wallVertexBuffer
       , wallProgram = wallProgram
       , wallLength = 0
@@ -64,7 +59,6 @@ struct
     let
       val
         { window
-        , mbox
         , playerVertexBuffer
         , playerProgram
         , playerLength
@@ -78,7 +72,6 @@ struct
       val newWallLength = Vector.length vec div 5
     in
       { window = window
-      , mbox = mbox
       , playerVertexBuffer = playerVertexBuffer
       , playerProgram = playerProgram
       , playerLength = playerLength
@@ -92,7 +85,6 @@ struct
     let
       val
         { window
-        , mbox
         , wallVertexBuffer
         , wallProgram
         , wallLength
@@ -106,7 +98,6 @@ struct
       val newPlayerLength = Vector.length vec div 5
     in
       { window = window
-      , mbox = mbox
       , wallVertexBuffer = wallVertexBuffer
       , wallProgram = wallProgram
       , wallLength = wallLength
@@ -163,10 +154,11 @@ struct
            * *)
 
           val wallVec = Wall.generateWalls ()
-          val shellState = uploadWall (shellState, wallVec)
 
-          val player = Player.move player
+          val input = InputState.getSnapshot ()
+          val player = Player.move (player, input)
           val playerVec = Player.getVec player
+
           val shellState = uploadWall (shellState, wallVec)
           val shellState = uploadPlayer (shellState, playerVec)
 

shell/input-state.sml

@@ -0,0 +1,66 @@
+structure InputState =
+struct
+  (* global state detecting button inputs *)
+  val state =
+    { leftHeld = ref false
+    , rightHeld = ref false
+    , upHeld = ref false
+    , downHeld = ref false
+    }
+
+  fun getSnapshot () =
+    { leftHeld = !(#leftHeld state)
+    , rightHeld = !(#rightHeld state)
+    , upHeld = !(#upHeld state)
+    , downHeld = !(#downHeld state)
+    }
+
+  fun getPlayerXAxis () =
+    let
+      val lh = #leftHeld state
+      val rh = #rightHeld state
+
+      open Player
+    in
+      case (!lh, !rh) of
+        (false, false) => STAY_STILL
+      | (false, true) => MOVE_RIGHT
+      | (true, false) => MOVE_LEFT
+      | (true, true) => STAY_STILL
+    end
+
+  open Input
+
+  fun handleKey (key, action) =
+    if key = ARROW_UP then
+      if action = PRESS then (#upHeld state) := true
+      else if action = RELEASE then (#upHeld state) := false
+      else ()
+    else if key = ARROW_DOWN then
+      if action = PRESS then (#downHeld state) := true
+      else if action = RELEASE then (#downHeld state) := false
+      else ()
+    else if key = ARROW_LEFT then
+      if action = PRESS then (#leftHeld state) := true
+      else if action = RELEASE then (#leftHeld state) := false
+      else ()
+    else if key = ARROW_RIGHT then
+      if action = PRESS then (#rightHeld state) := true
+      else if action = RELEASE then (#rightHeld state) := false
+      else ()
+    else
+      ()
+
+  fun keyCallback (key, scancode, action, mods) =
+    let open Input
+    in if mods = 0 then handleKey (key, action) else ()
+    end
+
+  fun registerCallbacks window =
+    let
+      val () = Input.exportKeyCallback keyCallback
+      val () = Input.setKeyCallback window
+    in
+      ()
+    end
+end

shell/shell.sml

@@ -1,7 +1,5 @@
 structure Shell =
 struct
-  open CML
-
   fun main () =
     let
       (* Set up GLFW. *)
@@ -13,6 +11,8 @@ struct
       val window = Glfw.createWindow (1920, 1080, "shf")
       val _ = Glfw.makeContextCurrent window
       val _ = Gles3.loadGlad ()
+
+      val _ = InputState.registerCallbacks window
     in
       GlDraw.loop window
     end