Add 'game-sml/' from commit '113c3e67abe635f714f972a1e2ab0e4b24ff10f4'

git-subtree-dir: game-sml
git-subtree-mainline: aa5357714d
git-subtree-split: 113c3e67ab

game-sml/shell/gl-draw.sml

@@ -0,0 +1,340 @@
+structure GlDraw =
+struct
+  type t =
+    { window: MLton.Pointer.t
+    , wallVertexBuffer: Word32.word
+    , wallProgram: Word32.word
+    , wallLength: int
+    , playerVertexBuffer: Word32.word
+    , playerProgram: Word32.word
+    , playerLength: int
+    , fieldVertexBuffer: Word32.word
+    , fieldProgram: Word32.word
+    , fieldLength: int
+    }
+
+  fun createShader (shaderType, shaderString) =
+    let
+      val shader = Gles3.createShader shaderType
+      val _ = Gles3.shaderSource (shader, shaderString)
+      val _ = Gles3.compileShader shader
+    in
+      shader
+    end
+
+  fun createProgram (vertexShader, fragmentShader) =
+    let
+      val program = Gles3.createProgram ()
+      val _ = Gles3.attachShader (program, vertexShader)
+      val _ = Gles3.attachShader (program, fragmentShader)
+      val _ = Gles3.linkProgram program
+    in
+      program
+    end
+
+  fun create window =
+    let
+      (* create vertex buffer, program, etc. *)
+      val xyrgbVertexShader = createShader
+        (Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString)
+
+      val rgbFragmentShader = createShader
+        (Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString)
+
+      val xyrgbaVertexShader = createShader
+        (Gles3.VERTEX_SHADER, GlShaders.xyrgbaVertexShaderString)
+
+      val rgbaFragmentShader = createShader
+        (Gles3.FRAGMENT_SHADER, GlShaders.rgbaFragmentShaderString)
+
+      (* 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)
+
+      val fieldVertexBuffer = Gles3.createBuffer ()
+      val fieldProgram = createProgram (xyrgbaVertexShader, rgbaFragmentShader)
+    in
+      { window = window
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = 0
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = 0
+      , fieldVertexBuffer = fieldVertexBuffer
+      , fieldProgram = fieldProgram
+      , fieldLength = 0
+      }
+    end
+
+  fun uploadWall (shellState: t, vec) =
+    let
+      val
+        { window
+        , playerVertexBuffer
+        , playerProgram
+        , playerLength
+        , fieldVertexBuffer
+        , fieldProgram
+        , fieldLength
+        , 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
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = playerLength
+      , fieldVertexBuffer = fieldVertexBuffer
+      , fieldProgram = fieldProgram
+      , fieldLength = fieldLength
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = newWallLength
+      }
+    end
+
+  fun uploadPlayer (shellState: t, vec) =
+    let
+      val
+        { window
+        , wallVertexBuffer
+        , wallProgram
+        , wallLength
+        , fieldVertexBuffer
+        , fieldProgram
+        , fieldLength
+        , 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
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = wallLength
+      , fieldVertexBuffer = fieldVertexBuffer
+      , fieldProgram = fieldProgram
+      , fieldLength = fieldLength
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = newPlayerLength
+      }
+    end
+
+  fun uploadField (shellState: t, vec) =
+    let
+      val
+        { window
+        , wallVertexBuffer
+        , wallProgram
+        , wallLength
+        , playerVertexBuffer
+        , playerProgram
+        , playerLength
+        , fieldVertexBuffer
+        , fieldProgram
+        , fieldLength = _
+        } = shellState
+
+      val _ = Gles3.bindBuffer fieldVertexBuffer
+      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
+      val newFieldLength = Vector.length vec div 6
+    in
+      { window = window
+      , wallVertexBuffer = wallVertexBuffer
+      , wallProgram = wallProgram
+      , wallLength = wallLength
+      , playerVertexBuffer = playerVertexBuffer
+      , playerProgram = playerProgram
+      , playerLength = playerLength
+      , fieldVertexBuffer = fieldVertexBuffer
+      , fieldProgram = fieldProgram
+      , fieldLength = newFieldLength
+      }
+    end
+
+  fun drawXyrgb (vertexBuffer, program, drawLength) =
+    if drawLength > 0 then
+      let
+        val _ = Gles3.bindBuffer vertexBuffer
+        (* enable xy component from uploaded array *)
+        val _ = Gles3.vertexAttribPointer (0, 2, 5, 0)
+        val _ = Gles3.enableVertexAttribArray 0
+        (* enable rgb component from uploaded array *)
+        val _ = Gles3.vertexAttribPointer (1, 3, 5, 8)
+        val _ = Gles3.enableVertexAttribArray 1
+
+        val _ = Gles3.useProgram program
+        val _ = Gles3.drawArrays (Gles3.TRIANGLES, 0, drawLength)
+      in
+        ()
+      end
+    else
+      ()
+
+  fun drawXyrgba (vertexBuffer, program, drawLength) =
+    if drawLength > 0 then
+      let
+        val _ = Gles3.bindBuffer vertexBuffer
+        (* enable xy component from uploaded array *)
+        val _ = Gles3.vertexAttribPointer (0, 2, 6, 0)
+        val _ = Gles3.enableVertexAttribArray 0
+        (* enable rgb component from uploaded array *)
+        val _ = Gles3.vertexAttribPointer (1, 4, 6, 8)
+        val _ = Gles3.enableVertexAttribArray 1
+
+        val _ = Gles3.useProgram program
+        val _ = Gles3.drawArrays (Gles3.TRIANGLES, 0, drawLength)
+      in
+        ()
+      end
+    else
+      ()
+
+  fun drawWall ({wallVertexBuffer, wallProgram, wallLength, ...}: t) =
+    drawXyrgb (wallVertexBuffer, wallProgram, wallLength)
+
+  fun drawPlayer ({playerVertexBuffer, playerProgram, playerLength, ...}: t) =
+    drawXyrgb (playerVertexBuffer, playerProgram, playerLength)
+
+  fun drawField ({fieldVertexBuffer, fieldProgram, fieldLength, ...}) =
+    drawXyrgba (fieldVertexBuffer, fieldProgram, fieldLength)
+
+  fun helpDrawLevel (shellState: t) =
+    let
+      val _ = drawWall shellState
+      val _ = drawPlayer shellState
+      val _ = drawField shellState
+    in
+      ()
+    end
+
+  fun drawLevel (shellState: t, level) =
+    let
+      val width = InputState.getWidth ()
+      val height = InputState.getHeight ()
+
+      val playerVec = PlayerVec.get (#player level, width, height)
+      val enemyVec = Enemy.getDrawVec (#enemies level, width, height)
+      val playerVec = Vector.concat [playerVec, enemyVec]
+
+      val wallVec = Wall.getDrawVec (#walls level, width, height)
+      val platVec = Platform.getDrawVec (#platforms level, width, height)
+      val fallingVec = FallingEnemies.getDrawVec (level, width, height)
+      val wallVec = Vector.concat [wallVec, platVec, fallingVec]
+
+      val shellState = uploadWall (shellState, wallVec)
+      val shellState = uploadPlayer (shellState, playerVec)
+      val () = helpDrawLevel shellState
+    in
+      shellState
+    end
+
+  fun helpDrawTitle (shellState: t) = drawPlayer shellState
+
+  fun drawTitle (shellState: t, title) =
+    let
+      val width = InputState.getWidth ()
+      val height = InputState.getHeight ()
+      val vec = TitleVec.getDrawVec (title, width, height)
+      val shellState = uploadPlayer (shellState, vec)
+      val () = helpDrawTitle shellState
+    in
+      shellState
+    end
+
+  fun helpDrawOptions shellState = drawPlayer shellState
+
+  fun drawOptions (shellState: t, options) =
+    let
+      val width = InputState.getWidth ()
+      val height = InputState.getHeight ()
+      val vec = OptionsVec.getDrawVec (options, width, height)
+      val shellState = uploadPlayer (shellState, vec)
+      val () = helpDrawOptions shellState
+    in
+      shellState
+    end
+
+  fun drawMode (shellState: t, game: GameType.game_type) =
+    let
+      open GameType
+    in
+      case #mode game of
+        LEVEL level => drawLevel (shellState, level)
+      | TITLE title => drawTitle (shellState, title)
+      | OPTIONS options => drawOptions (shellState, options)
+    end
+
+  fun saveKeys game =
+    let
+      val newKeys = #userKeys game
+      val () = InputState.setControls newKeys
+
+      val io = TextIO.openOut "controls.config"
+      val () = TextIO.output (io, CoreKey.userKeysToString newKeys)
+      val () = TextIO.closeOut io
+    in
+      ()
+    end
+
+  fun runEffects game =
+    let val () = if #saveKeys game then saveKeys game else ()
+    in ()
+    end
+
+  fun helpLoop (shellState as {window, ...}: t, game) =
+    case Glfw.windowShouldClose window of
+      false =>
+        let
+          val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0)
+          val _ = Gles3.clear ()
+
+          val time = Time.now ()
+          val input = InputState.getSnapshot ()
+          val game = GameUpdate.update (game, input, time)
+
+          val shellState = drawMode (shellState, game)
+          val () = runEffects game
+
+          val _ = Glfw.swapBuffers window
+          val _ = Glfw.pollEvents ()
+        in
+          helpLoop (shellState, game)
+        end
+    | true => Glfw.terminate ()
+
+  fun loop window =
+    let
+      val shellState = create window
+      val controls =
+        case ParseControls.parse () of
+          SOME controls => controls
+        | NONE =>
+            { left = CoreKey.KEY_LEFT
+            , right = CoreKey.KEY_RIGHT
+            , up = CoreKey.KEY_UP
+            , down = CoreKey.KEY_DOWN
+            , jump = CoreKey.KEY_Z
+            , attack = CoreKey.KEY_X
+            , escape = CoreKey.KEY_ESCAPE
+            }
+
+      val () = InputState.setControls controls
+    in
+      helpLoop (shellState, GameType.init controls)
+    end
+end

game-sml/shell/gl-shaders.sml

@@ -0,0 +1,45 @@
+structure GlShaders =
+struct
+  val xyrgbVertexShaderString =
+    "#version 300 es\n\
+    \layout (location = 0) in vec2 apos;\n\
+    \layout (location = 1) in vec3 col;\n\
+    \out vec3 frag_col;\n\
+    \void main()\n\
+    \{\n\
+    \   frag_col = col;\n\
+    \   gl_Position = vec4(apos.x, apos.y, 0.0f, 1.0f);\n\
+    \}"
+
+  val rgbFragmentShaderString =
+    "#version 300 es\n\
+    \precision mediump float;\n\
+    \in vec3 frag_col;\n\
+    \out vec4 FragColor;\n\
+    \void main()\n\
+    \{\n\
+    \   FragColor = vec4(frag_col.x, frag_col.y, frag_col.z, 1.0f);\n\
+    \}"
+
+  (* shader strings same as above, except they also define an alpha component *)
+  val xyrgbaVertexShaderString =
+    "#version 300 es\n\
+    \layout (location = 0) in vec2 apos;\n\
+    \layout (location = 1) in vec4 col;\n\
+    \out vec4 frag_col;\n\
+    \void main()\n\
+    \{\n\
+    \   frag_col = col;\n\
+    \   gl_Position = vec4(apos.x, apos.y, 0.0f, 1.0f);\n\
+    \}"
+
+  val rgbaFragmentShaderString =
+    "#version 300 es\n\
+    \precision mediump float;\n\
+    \in vec4 frag_col;\n\
+    \out vec4 FragColor;\n\
+    \void main()\n\
+    \{\n\
+    \   FragColor = frag_col;\n\
+    \}"
+end

game-sml/shell/glfw-key-map.sml

@@ -0,0 +1,161 @@
+structure GlfwKeyMap =
+struct
+  structure KeyMap =
+    MakeGapMap
+      (struct
+         type key = int
+         type value = CoreKey.key_code
+
+         fun l (a: int, b: int) = a < b
+         fun eq (a: int, b: int) = a = b
+         fun g (a: int, b: int) = a > b
+
+         val maxNodeSize = 1024
+       end)
+
+  fun helpInitKeyMap (pos, pairs, acc) =
+    if pos = Vector.length pairs then
+      acc
+    else
+      let
+        val (code, key) = Vector.sub (pairs, pos)
+        val acc = KeyMap.add (code, key, acc)
+      in
+        helpInitKeyMap (pos + 1, pairs, acc)
+      end
+
+  fun initKeyMap () =
+    let
+      open CoreKey
+
+      (* vector of (glfw_key_code, Core.key_code) tuples. *)
+      val pairs =
+       #[ (32, KEY_SPACE)
+        , (39, KEY_APOSTROPHE)
+        , (44, KEY_COMMA)
+        , (45, KEY_MINUS)
+        , (46, KEY_PERIOD)
+        , (47, KEY_SLASH)
+        , (48, KEY_0)
+        , (49, KEY_1)
+        , (50, KEY_2)
+        , (51, KEY_3)
+        , (52, KEY_4)
+        , (53, KEY_5)
+        , (54, KEY_6)
+        , (55, KEY_7)
+        , (56, KEY_8)
+        , (57, KEY_9)
+        , (59, KEY_SEMICOLON)
+        , (61, KEY_EQUAL)
+        , (65, KEY_A)
+        , (66, KEY_B)
+        , (67, KEY_C)
+        , (68, KEY_D)
+        , (69, KEY_E)
+        , (70, KEY_F)
+        , (71, KEY_G)
+        , (72, KEY_H)
+        , (73, KEY_I)
+        , (74, KEY_J)
+        , (75, KEY_K)
+        , (76, KEY_L)
+        , (77, KEY_M)
+        , (78, KEY_N)
+        , (79, KEY_O)
+        , (80, KEY_P)
+        , (81, KEY_Q)
+        , (82, KEY_R)
+        , (83, KEY_S)
+        , (84, KEY_T)
+        , (85, KEY_U)
+        , (86, KEY_V)
+        , (87, KEY_W)
+        , (88, KEY_X)
+        , (89, KEY_Y)
+        , (90, KEY_Z)
+        , (91, KEY_LEFT_BRACKET)
+        , (92, KEY_BACKSLASH)
+        , (93, KEY_RIGHT_BRACKET)
+        , (96, KEY_GRAVE_ACCENT)
+        , (161, KEY_WORLD_1)
+        , (162, KEY_WORLD_2)
+        , (256, KEY_ESCAPE)
+        , (257, KEY_ENTER)
+        , (258, KEY_TAB)
+        , (259, KEY_BACKSPACE)
+        , (260, KEY_INSERT)
+        , (261, KEY_DELETE)
+        , (262, KEY_RIGHT)
+        , (263, KEY_LEFT)
+        , (264, KEY_DOWN)
+        , (265, KEY_UP)
+        , (266, KEY_PAGE_UP)
+        , (267, KEY_PAGE_DOWN)
+        , (268, KEY_HOME)
+        , (269, KEY_END)
+        , (280, KEY_CAPS_LOCK)
+        , (281, KEY_SCROLL_LOCK)
+        , (282, KEY_NUM_LOCK)
+        , (283, KEY_PRINT_SCREEN)
+        , (284, KEY_PAUSE)
+        , (290, KEY_F1)
+        , (291, KEY_F2)
+        , (292, KEY_F3)
+        , (293, KEY_F4)
+        , (294, KEY_F5)
+        , (295, KEY_F6)
+        , (296, KEY_F7)
+        , (297, KEY_F8)
+        , (298, KEY_F9)
+        , (299, KEY_F10)
+        , (300, KEY_F11)
+        , (301, KEY_F12)
+        , (302, KEY_F13)
+        , (303, KEY_F14)
+        , (304, KEY_F15)
+        , (305, KEY_F16)
+        , (306, KEY_F17)
+        , (307, KEY_F18)
+        , (308, KEY_F19)
+        , (309, KEY_F20)
+        , (310, KEY_F21)
+        , (311, KEY_F22)
+        , (312, KEY_F23)
+        , (313, KEY_F24)
+        , (314, KEY_F25)
+        , (320, KEY_KP_0)
+        , (321, KEY_KP_1)
+        , (322, KEY_KP_2)
+        , (323, KEY_KP_3)
+        , (324, KEY_KP_4)
+        , (325, KEY_KP_5)
+        , (326, KEY_KP_6)
+        , (327, KEY_KP_7)
+        , (328, KEY_KP_8)
+        , (329, KEY_KP_9)
+        , (330, KEY_KP_DECIMAL)
+        , (331, KEY_KP_DIVIDE)
+        , (332, KEY_KP_MULTIPLY)
+        , (333, KEY_KP_SUBTRACT)
+        , (334, KEY_KP_ADD)
+        , (335, KEY_KP_ENTER)
+        , (336, KEY_KP_EQUAL)
+        , (340, KEY_LEFT_SHIFT)
+        , (341, KEY_LEFT_CONTROL)
+        , (342, KEY_LEFT_ALT)
+        , (343, KEY_LEFT_SUPER)
+        , (344, KEY_RIGHT_SHIFT)
+        , (345, KEY_RIGHT_CONTROL)
+        , (346, KEY_RIGHT_ALT)
+        , (347, KEY_RIGHT_SUPER)
+        , (348, KEY_MENU)
+        ]
+    in
+      helpInitKeyMap (0, pairs, KeyMap.empty)
+    end
+
+  val map = initKeyMap ()
+
+  fun codeFromKey (key: int) = KeyMap.get (key, map)
+end

game-sml/shell/input-state.sml

@@ -0,0 +1,95 @@
+structure InputState =
+struct
+  val keyMappings = ref
+    { left = CoreKey.KEY_S
+    , right = CoreKey.KEY_F
+    , down = CoreKey.KEY_D
+    , up = CoreKey.KEY_E
+    , attack = CoreKey.KEY_J
+    , jump = CoreKey.KEY_K
+    , escape = CoreKey.KEY_ESCAPE
+    }
+
+  fun setControls controls = keyMappings := controls
+
+  (* global state detecting button inputs *)
+  val state =
+    { leftHeld = ref false
+    , rightHeld = ref false
+    , upHeld = ref false
+    , downHeld = ref false
+    , jumpHeld = ref false
+    , attackHeld = ref false
+    , escapeHeld = ref false
+    , newKeys = ref []
+    , width = ref (1920.0 : Real32.real)
+    , height = ref (1080.0 : Real32.real)
+    }
+
+  fun getSnapshot () =
+    let
+      val input =
+        { leftHeld = !(#leftHeld state)
+        , rightHeld = !(#rightHeld state)
+        , upHeld = !(#upHeld state)
+        , downHeld = !(#downHeld state)
+        , attackHeld = !(#attackHeld state)
+        , jumpHeld = !(#jumpHeld state)
+        , escapeHeld = !(#escapeHeld state)
+        , newKeys = !(#newKeys state)
+        }
+      val () = #newKeys state := []
+    in
+      input
+    end
+
+  (* there are three action states reported by OS: PRESS, REPEAT and RELEASE. 
+   * If input is PRESS or REPEAT, then return true, or else return false. *)
+  fun actionToBool action = action <> Input.RELEASE
+
+  fun handleKey (key, action) =
+    case GlfwKeyMap.codeFromKey key of
+      SOME code =>
+        let
+          val () =
+            if action = Input.PRESS then
+              #newKeys state := code :: !(#newKeys state)
+            else
+              ()
+          val {left, right, down, up, attack, jump, escape} = !keyMappings
+          val action = actionToBool action
+        in
+          if code = left then #leftHeld state := action
+          else if code = up then #upHeld state := action
+          else if code = right then #rightHeld state := action
+          else if code = down then #downHeld state := action
+          else if code = attack then #attackHeld state := action
+          else if code = jump then #jumpHeld state := action
+          else if code = escape then #escapeHeld state := action
+          else ()
+        end
+    | NONE => ()
+
+  fun keyCallback (key, scancode, action, mods) =
+    if mods = 0 then handleKey (key, action) else ()
+
+  fun getWidth () =
+    !(#width state)
+
+  fun getHeight () =
+    !(#height state)
+
+  fun sizeCallback (width, height) =
+    (#width state := width; #height state := height)
+
+  fun registerCallbacks window =
+    let
+      val () = Input.exportKeyCallback keyCallback
+      val () = Input.setKeyCallback window
+
+      val () = Input.exportFramebufferSizeCallback sizeCallback
+      val () = Input.setFramebufferSizeCallback window
+    in
+      ()
+    end
+end

game-sml/shell/parse-controls.sml

@@ -0,0 +1,166 @@
+structure ParseControls =
+struct
+  datatype action =
+    ACTION_LEFT
+  | ACTION_RIGHT
+  | ACTION_UP
+  | ACTION_DOWN
+  | ACTION_JUMP
+  | ACTION_ATTACK
+
+  fun actionFromString str =
+    case str of
+      "ACTION_LEFT" => SOME ACTION_LEFT
+    | "ACTION_RIGHT" => SOME ACTION_RIGHT
+    | "ACTION_UP" => SOME ACTION_UP
+    | "ACTION_DOWN" => SOME ACTION_DOWN
+    | "ACTION_JUMP" => SOME ACTION_JUMP
+    | "ACTION_ATTACK" => SOME ACTION_ATTACK
+    | _ => NONE
+
+  fun findColon (pos, str) =
+    if pos = String.size str then
+      ~1
+    else
+      let val chr = String.sub (str, pos)
+      in if chr = #":" then pos else findColon (pos + 1, str)
+      end
+
+  type parsed_keys =
+    { left: CoreKey.key_code option
+    , right: CoreKey.key_code option
+    , up: CoreKey.key_code option
+    , down: CoreKey.key_code option
+    , jump: CoreKey.key_code option
+    , attack: CoreKey.key_code option
+    }
+
+  fun updateControls (action, key, controls: parsed_keys) =
+    let
+      val {left, right, up, down, jump, attack} = controls
+    in
+      case action of
+        ACTION_LEFT =>
+          { left = SOME key
+          , right = right
+          , up = up
+          , down = down
+          , jump = jump
+          , attack = attack
+          }
+      | ACTION_RIGHT =>
+          { left = left
+          , right = SOME key
+          , up = up
+          , down = down
+          , jump = jump
+          , attack = attack
+          }
+      | ACTION_UP =>
+          { left = left
+          , right = right
+          , up = SOME key
+          , down = down
+          , jump = jump
+          , attack = attack
+          }
+      | ACTION_DOWN =>
+          { left = left
+          , right = right
+          , up = up
+          , down = SOME key
+          , jump = jump
+          , attack = attack
+          }
+      | ACTION_JUMP =>
+          { left = left
+          , right = right
+          , up = up
+          , down = down
+          , jump = SOME key
+          , attack = attack
+          }
+      | ACTION_ATTACK =>
+          { left = left
+          , right = right
+          , up = up
+          , down = down
+          , jump = jump
+          , attack = SOME key
+          }
+    end
+
+  fun returnControls controls =
+    let
+      val {left, right, up, down, jump, attack} = controls
+    in
+      case (left, right, up, down, jump, attack) of
+        (SOME left, SOME right, SOME up, SOME down, SOME jump, SOME attack) =>
+          SOME
+            { left = left
+            , right = right
+            , up = up
+            , down = down
+            , jump = jump
+            , attack = attack
+            , escape = CoreKey.KEY_ESCAPE
+            }
+      | _ => NONE
+    end
+
+  (* We don't want to attempt to parse strings 
+   * which have trailing spaces or newlines 
+   * so get the length of the last non-space chr *)
+  fun getLastPos (pos, line) =
+    if pos = String.size line then
+      String.size line - 1
+    else
+      let val chr = String.sub (line, pos)
+      in if Char.isSpace chr then pos - 1 else getLastPos (pos + 1, line)
+      end
+
+  fun helpParse (controls, io) =
+    case TextIO.inputLine io of
+      SOME line =>
+        let
+          val colon = findColon (0, line)
+        in
+          if colon = ~1 then
+            helpParse (controls, io)
+          else
+            let
+              val actionString = String.substring (line, 0, colon)
+              val action = actionFromString actionString
+
+              val keyStart = colon + 1
+              val keyFinish = getLastPos (keyStart, line)
+              val keyLength = keyFinish - keyStart + 1
+              val keyString = String.substring (line, keyStart, keyLength)
+              val key = CoreKey.keyFromString keyString
+
+              val controls =
+                (case (action, key) of
+                   (SOME action, SOME key) =>
+                     updateControls (action, key, controls)
+                 | (_, _) => controls)
+            in
+              helpParse (controls, io)
+            end
+        end
+    | NONE => let val () = TextIO.closeIn io in returnControls controls end
+
+  fun parse () =
+    let
+      val initial =
+        { left = NONE
+        , right = NONE
+        , up = NONE
+        , down = NONE
+        , jump = NONE
+        , attack = NONE
+        }
+      val io = TextIO.openIn "controls.config"
+    in
+      helpParse (initial, io)
+    end
+end

game-sml/shell/shell.sml

@@ -0,0 +1,21 @@
+structure Shell =
+struct
+  fun main () =
+    let
+      (* Set up GLFW. *)
+      val _ = Glfw.init ()
+      val _ = Glfw.windowHint (Glfw.CONTEXT_VERSION_MAJOR (), 3)
+      val _ = Glfw.windowHint (Glfw.DEPRECATED (), Glfw.FALSE ())
+      val _ = Glfw.windowHint (Glfw.WINDOW_MAX (), Glfw.TRUE ())
+
+      val window = Glfw.createWindow (1920, 1080, "shf")
+      val _ = Glfw.makeContextCurrent window
+      val _ = Gles3.loadGlad ()
+
+      val _ = InputState.registerCallbacks window
+    in
+      GlDraw.loop window
+    end
+end
+
+val _ = Shell.main ()