Add 'shf/' from commit 'b6c5a95b664aeb861d7b33ffc9eefe447ba99dd7'

git-subtree-dir: shf
git-subtree-mainline: 401408448f
git-subtree-split: b6c5a95b66

shf/shell/draw-mailbox.sml

@@ -0,0 +1 @@
+structure DrawMailbox = MakeMailbox(DrawMsg)

shf/shell/exception-logger.sml

@@ -0,0 +1,38 @@
+structure ExceptionLogger =
+struct
+  open InputMsg
+
+  val textCommands = ref ""
+
+  fun addCommand inputMsg =
+    case inputMsg of
+      CHAR_EVENT chr =>
+        let
+          val chr = CharVector.fromList [chr]
+          val newInput = !textCommands ^ chr
+        in
+          textCommands := newInput
+        end
+    | _ => ()
+
+  fun log e =
+    let
+      (* print stack trace for debugging purposes, 
+       * and then raise another exception to exit the program *)
+      val errName = General.exnName e ^ "\n"
+      val stackTrace = MLton.Exn.history e
+      val stackTrace = (String.concatWith "\n" stackTrace) ^ "\n"
+      val history = !textCommands ^ "\n\n"
+
+      val log = String.concat
+        ["ERROR: ", errName, stackTrace, "HISTORY: ", history]
+
+      val () = print ("\n" ^ log)
+
+      val io = TextIO.openAppend "exceptions.log"
+      val () = TextIO.output (io, log)
+      val () = TextIO.closeOut io
+    in
+      raise e
+    end
+end

shf/shell/gl-draw.sml

@@ -0,0 +1,82 @@
+structure GlDraw =
+struct
+  open DrawMsg
+
+  type t =
+    { textVertexBuffer: Word32.word
+    , textProgram: Word32.word
+    , textDrawLength: 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 () =
+    let
+      (* create vertex buffer, program, etc. for text. *)
+      val textVertexBuffer = Gles3.createBuffer ()
+      val xyzRgbVertexShader = createShader
+        (Gles3.VERTEX_SHADER, GlShaders.xyzRgbVertexShaderString)
+
+      val rgbFragmentShader = createShader
+        (Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString)
+
+      val textProgram = createProgram (xyzRgbVertexShader, rgbFragmentShader)
+
+      (* clean up shaders which are no longer needed once progran is linked. *)
+      val _ = Gles3.deleteShader xyzRgbVertexShader
+      val _ = Gles3.deleteShader rgbFragmentShader
+
+      (* because we only have a single vertex buffer, 
+       * we only need to bind and set attributes once. *)
+      val _ = Gles3.bindBuffer textVertexBuffer
+
+      (* enable xyz component from uploaded array *)
+      val _ = Gles3.vertexAttribPointer (0, 3, 6, 0)
+      val _ = Gles3.enableVertexAttribArray 0
+      (* enable rgb component from uploaded array *)
+      val _ = Gles3.vertexAttribPointer (1, 3, 6, 12)
+      val _ = Gles3.enableVertexAttribArray 1
+
+      val _ = Gles3.useProgram textProgram
+    in
+      { textVertexBuffer = textVertexBuffer
+      , textProgram = textProgram
+      , textDrawLength = 0
+      }
+    end
+
+  fun uploadText (drawState: t, vec) =
+    let
+      val {textVertexBuffer, textProgram, textDrawLength = _} = drawState
+
+      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW)
+      val newTextDrawLength = Vector.length vec div 6
+    in
+      { textVertexBuffer = textVertexBuffer
+      , textProgram = textProgram
+      , textDrawLength = newTextDrawLength
+      }
+    end
+
+  fun draw (drawObject: t) =
+    let val {textVertexBuffer, textDrawLength, textProgram} = drawObject
+    in Gles3.drawArrays (Gles3.TRIANGLES, 0, textDrawLength)
+    end
+end

shf/shell/gl-shaders.sml

@@ -0,0 +1,23 @@
+structure GlShaders =
+struct
+  val xyzRgbVertexShaderString =
+    "#version 300 es\n\
+    \layout (location = 0) in vec3 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, apos.z, 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\
+    \}"
+end

shf/shell/glfw-gamepad.sml

@@ -0,0 +1,264 @@
+structure GlfwGamepad =
+struct
+  datatype mode =
+    PENDING
+  (* we need to wait for all keys to be released after pressing a button *)
+  | WAIT_FOR_KEY_RELEASE
+  | TRIANGLE
+  | TRIANGLE_CIRCLE
+  | CIRCLE
+  | CIRCLE_CROSS
+  | CROSS
+  | CROSS_SQUARE
+  | SQUARE
+  (* maybe SQUARE_TRIANGLE for numbers and symbols? *)
+  | SQUARE_TRIANGLE
+
+  structure IM = InputMsg
+
+  type gamepad_state =
+    { mode: mode
+    , shiftChr: bool
+    , trianglePressed: bool
+    , circlePressed: bool
+    , crossPressed: bool
+    , squarePressed: bool
+    }
+
+  fun releaseKeysAndUnshift (gamepadState: gamepad_state) =
+    let
+      val
+        { mode = _
+        , shiftChr = _
+        , trianglePressed
+        , circlePressed
+        , crossPressed
+        , squarePressed
+        } = gamepadState
+    in
+      { mode = WAIT_FOR_KEY_RELEASE
+      , shiftChr = false
+      , trianglePressed = false
+      , circlePressed = false
+      , crossPressed = false
+      , squarePressed = false
+      }
+    end
+
+  fun onWaitForKeyRelease
+    ( gamepadState: gamepad_state
+    , trianglePressed
+    , circlePressed
+    , crossPressed
+    , squarePressed
+    , actions
+    ) =
+    if
+      trianglePressed orelse circlePressed orelse crossPressed
+      orelse squarePressed
+    then
+      (gamepadState, actions)
+    else
+      let
+        val newState =
+          { mode = PENDING
+          , shiftChr = #shiftChr gamepadState
+          , trianglePressed = false
+          , circlePressed = false
+          , crossPressed = false
+          , squarePressed = false
+          }
+      in
+        (newState, actions)
+      end
+
+  fun onPendingMode
+    ( state: gamepad_state
+    , trianglePressed
+    , circlePressed
+    , crossPressed
+    , squarePressed
+    , actions: IM.t list
+    ) =
+    if
+      trianglePressed orelse circlePressed orelse crossPressed
+      orelse squarePressed
+    then
+      (* some button is being pressed, 
+       * so we record that in the returned state,
+       * in addition to whatever buttons were previously pressed *)
+      let
+        val trianglePressed = #trianglePressed state orelse trianglePressed
+        val circlePressed = #circlePressed state orelse circlePressed
+        val crossPressed = #crossPressed state orelse crossPressed
+        val squarePressed = #squarePressed state orelse squarePressed
+
+        val newState =
+          { mode = #mode state
+          , shiftChr = #shiftChr state
+          , trianglePressed = trianglePressed
+          , circlePressed = circlePressed
+          , crossPressed = crossPressed
+          , squarePressed = squarePressed
+          }
+      in
+        (newState, actions)
+      end
+    else
+      (* nothing is currently pressed, 
+       * so we check if there is a valid mode indicated by the state
+       * and change the mode if so *)
+      let
+        val
+          { trianglePressed
+          , circlePressed
+          , crossPressed
+          , squarePressed
+          , shiftChr
+          , mode = _
+          } = state
+        val newMode =
+          if trianglePressed andalso not (crossPressed orelse squarePressed) then
+            if not circlePressed then TRIANGLE else TRIANGLE_CIRCLE
+          else if circlePressed andalso not squarePressed then
+            if not crossPressed then CIRCLE else CIRCLE_CROSS
+          else if crossPressed then
+            if not squarePressed then CROSS else CROSS_SQUARE
+          else if squarePressed then
+            if not trianglePressed then SQUARE else SQUARE_TRIANGLE
+          else
+            (* some buttons are being pressed, 
+             * but not a valid combination to switch
+             * to another mode, so we are still on PENDING *)
+            PENDING
+
+        val newState =
+          { mode = newMode
+          , shiftChr = shiftChr
+          , trianglePressed = false
+          , circlePressed = false
+          , crossPressed = false
+          , squarePressed = false
+          }
+      in
+        (newState, actions)
+      end
+
+  fun onTriangleMode
+    ( gamepadState
+    , trianglePressed
+    , circlePressed
+    , crossPressed
+    , squarePressed
+    , actions
+    ) =
+    if trianglePressed then
+      let
+        val newState = releaseKeysAndUnshift gamepadState
+        val actions = IM.CHAR_EVENT #"a" :: actions
+      in
+        (newState, actions)
+      end
+    else if circlePressed then
+      let
+        val newState = releaseKeysAndUnshift gamepadState
+        val actions = IM.CHAR_EVENT #"b" :: actions
+      in
+        (newState, actions)
+      end
+    else if crossPressed then
+      let
+        val newState = releaseKeysAndUnshift gamepadState
+        val actions = IM.CHAR_EVENT #"c" :: actions
+      in
+        (newState, actions)
+      end
+    else if squarePressed then
+      let
+        val newState = releaseKeysAndUnshift gamepadState
+        val actions = IM.CHAR_EVENT #"d" :: actions
+      in
+        (newState, actions)
+      end
+    else
+      (gamepadState, actions)
+
+  fun handleButtons
+    ( gamepadState
+    , trianglePressed
+    , circlePressed
+    , crossPressed
+    , squarePressed
+    , l1Pressed
+    , r1Pressed
+    ) =
+    let
+      val actions = if l1Pressed then [IM.KEY_BACKSPACE] else []
+      val actions =
+        if r1Pressed then (IM.CHAR_EVENT #" ") :: actions else actions
+    in
+      case #mode gamepadState of
+        PENDING =>
+          onPendingMode
+            ( gamepadState
+            , trianglePressed
+            , circlePressed
+            , crossPressed
+            , squarePressed
+            , actions
+            )
+      | WAIT_FOR_KEY_RELEASE =>
+          onWaitForKeyRelease
+            ( gamepadState
+            , trianglePressed
+            , circlePressed
+            , crossPressed
+            , squarePressed
+            , actions
+            )
+      | TRIANGLE =>
+          onTriangleMode
+            ( gamepadState
+            , trianglePressed
+            , circlePressed
+            , crossPressed
+            , squarePressed
+            , actions
+            )
+    end
+
+  (* impure functions below *)
+  fun getGamepadState () =
+    Input.getGamepadState 0 <> 0 orelse Input.getGamepadState 1 <> 0
+    orelse Input.getGamepadState 2 <> 0 orelse Input.getGamepadState 3 <> 0
+    orelse Input.getGamepadState 4 <> 0 orelse Input.getGamepadState 5 <> 0
+    orelse Input.getGamepadState 6 <> 0 orelse Input.getGamepadState 7 <> 0
+    orelse Input.getGamepadState 8 <> 0 orelse Input.getGamepadState 9 <> 0
+    orelse Input.getGamepadState 10 <> 0 orelse Input.getGamepadState 11 <> 0
+    orelse Input.getGamepadState 12 <> 0 orelse Input.getGamepadState 13 <> 0
+    orelse Input.getGamepadState 14 <> 0 orelse Input.getGamepadState 15 <> 0
+
+  fun query gamepadState =
+    if getGamepadState () then
+      let
+        val trianglePressed = Input.isTriangleButtonPressed () <> 0
+        val circlePressed = Input.isCircleButtonPressed () <> 0
+        val crossPressed = Input.isCrossButtonPressed () <> 0
+        val squarePressed = Input.isSquareButtonPressed () <> 0
+        val l1Pressed = Input.isL1ButtonPressed () <> 0
+        val r1Pressed = Input.isR1ButtonPressed () <> 0
+      in
+        handleButtons
+          ( gamepadState
+          , trianglePressed
+          , circlePressed
+          , crossPressed
+          , squarePressed
+          , l1Pressed
+          , r1Pressed
+          )
+      end
+    else
+      (* nothing to do, so return same state *)
+      (gamepadState, [])
+end

shf/shell/glfw-loop.sml

@@ -0,0 +1,174 @@
+structure GlfwLoop =
+struct
+  fun yank (window, str) =
+    let
+      (* print when text is yanked
+       * because GLFW currently has a bug on Wayland
+       * when setting the clipboard string *)
+      val msg = "|" ^ String.toCString str ^ "|\n"
+      val () = print msg
+      val () = Glfw.setClipboardString (window, str)
+    in
+      ()
+    end
+
+  fun consumeEvent (drawState, window, msg) =
+    let
+      open DrawMsg
+
+      val {textVertexBuffer, textProgram, textDrawLength = _, ...} = drawState
+    in
+      case msg of
+        DRAW_TEXT textVec => GlDraw.uploadText (drawState, textVec)
+      | YANK str => (yank (window, str); drawState)
+    end
+
+  fun consumeEventsLoop (pos, msgVec, drawState, window) =
+    if pos = Vector.length msgVec then
+      drawState
+    else
+      let
+        val msg = Vector.sub (msgVec, pos)
+        val drawState = consumeEvent (drawState, window, msg)
+      in
+        consumeEventsLoop (pos + 1, msgVec, drawState, window)
+      end
+
+  fun consumeEvents (drawState, window) =
+    consumeEventsLoop (0, DrawMailbox.getMessagesAndClear (), drawState, window)
+
+  fun helpLoop (app, drawState, window, gamepad) =
+    case Glfw.windowShouldClose window of
+      false =>
+        let
+          val drawState = consumeEvents (drawState, window)
+
+          val _ = Gles3.clearColor (0.89, 0.89, 0.89, 1.0)
+          val _ = Gles3.clear ()
+
+          (* one update reacting to gamepad events *)
+          val (gamepad, actions) = GlfwGamepad.query gamepad
+          val app = Updater.updateLoop (0, Vector.fromList actions, app)
+
+          (* one update reacting to keyboard events *)
+          val app = Updater.update app
+          val _ = GlDraw.draw drawState
+
+          val _ = Glfw.swapBuffers window
+          val _ = Glfw.waitEvents ()
+        in
+          helpLoop (app, drawState, window, gamepad)
+        end
+    | true => Glfw.terminate ()
+
+  fun loop (app, window) =
+    let
+      val drawState = GlDraw.create ()
+
+      val gamepad: GlfwGamepad.gamepad_state =
+        { mode = GlfwGamepad.PENDING
+        , shiftChr = false
+        , trianglePressed = false
+        , circlePressed = false
+        , crossPressed = false
+        , squarePressed = false
+        }
+    in
+      helpLoop (app, drawState, window, gamepad)
+    end
+
+  open InputMsg
+
+  fun frameBufferSizeCallback (width, height) =
+    InputMailbox.append (RESIZE_EVENT (width, height))
+
+  fun charCallback word =
+    let
+      val word = Word32.toInt word
+      val chr = Char.chr word
+    in
+      InputMailbox.append (CHAR_EVENT chr)
+    end
+
+  fun keyCallback (key, scancode, action, mods) =
+    let
+      open Input
+    in
+      if key = KEY_ESC andalso action = PRESS andalso mods = 0 then
+        InputMailbox.append (InputMsg.KEY_ESC)
+      else if key = KEY_ENTER andalso action = PRESS andalso mods = 0 then
+        InputMailbox.append (InputMsg.KEY_ENTER)
+      else if key = KEY_BACKSPACE andalso action <> RELEASE andalso mods = 0 then
+        InputMailbox.append (InputMsg.KEY_BACKSPACE)
+      else if key = KEY_ARROW_LEFT andalso action <> RELEASE andalso mods = 0 then
+        InputMailbox.append (InputMsg.ARROW_LEFT)
+      else if key = KEY_ARROW_RIGHT andalso action <> RELEASE andalso mods = 0 then
+        InputMailbox.append (InputMsg.ARROW_RIGHT)
+      else if key = KEY_ARROW_UP andalso action <> RELEASE andalso mods = 0 then
+        InputMailbox.append (InputMsg.ARROW_UP)
+      else if key = KEY_ARROW_DOWN andalso action <> RELEASE andalso mods = 0 then
+        InputMailbox.append (InputMsg.ARROW_DOWN)
+      else
+        ()
+    end
+
+  fun registerCallbacks window =
+    let
+      val () = Input.exportFramebufferSizeCallback frameBufferSizeCallback
+      val () = Input.setFramebufferSizeCallback window
+
+      val () = Input.exportCharCallback charCallback
+      val () = Input.setCharCallback window
+
+      val () = Input.exportKeyCallback keyCallback
+      val () = Input.setKeyCallback window
+    in
+      ()
+    end
+
+  local
+    fun loop (io, acc, lastCharWasNewline) =
+      case TextIO.inputLine io of
+        SOME str =>
+          let
+            val endsWithNewline =
+              String.size str > 0
+              andalso String.sub (str, String.size str - 1) = #"\n"
+          in
+            loop (io, LineGap.append (str, acc), endsWithNewline)
+          end
+      | NONE =>
+          if lastCharWasNewline then
+            LineGap.goToStart acc
+          else
+            let val acc = LineGap.append ("\n", acc)
+            in LineGap.goToStart acc
+            end
+  in
+    fun ioToLineGap (io, acc) = loop (io, acc, false)
+  end
+
+  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 window = Glfw.createWindow (1920, 1080, "shf")
+      val _ = Glfw.makeContextCurrent window
+      val _ = Glfw.loadGlad ()
+      val _ = Gles3.enableDepthTest ()
+
+      (* load file intol gap buffer and create initial app *)
+      val io = TextIO.openIn "temp.txt"
+      val lineGap = ioToLineGap (io, LineGap.empty)
+      val _ = TextIO.closeIn io
+      val app = AppType.init (lineGap, 1920, 1080, Time.now ())
+
+      val () = registerCallbacks window
+    in
+      loop (app, window)
+    end
+end
+
+val _ = GlfwLoop.main ()

shf/shell/input-mailbox.sml

@@ -0,0 +1 @@
+structure InputMailbox = MakeMailbox(InputMsg)

shf/shell/make-mailbox.sml

@@ -0,0 +1,29 @@
+signature MAKE_MAILBOX =
+sig
+  type t
+end
+
+functor MakeMailbox(Fn: MAKE_MAILBOX) =
+struct
+  val messages: Fn.t vector ref = ref #[]
+
+  fun getMessagesAndClear () =
+    let
+      val () = MLton.Thread.atomicBegin ()
+      val msgs = !messages
+      val () = messages := #[]
+      val () = MLton.Thread.atomicEnd ()
+    in
+      msgs
+    end
+
+  fun append newMsg =
+    let
+      val () = MLton.Thread.atomicBegin ()
+      val msgs = !messages
+      val msgs = Vector.concat [msgs, #[newMsg]]
+      val () = messages := msgs
+    in
+      MLton.Thread.atomicEnd ()
+    end
+end

shf/shell/rgfw-loop.sml

@@ -0,0 +1,118 @@
+structure RgfwLoop =
+struct
+  fun yank string =
+    Rgfw.writeClipboard (string, String.size string)
+
+  fun consumeEvent (drawState, msg) =
+    let
+      open DrawMsg
+
+      val {textVertexBuffer, textProgram, textDrawLength = _, ...} = drawState
+    in
+      case msg of
+        DRAW_TEXT textVec => GlDraw.uploadText (drawState, textVec)
+      | YANK str => (yank str; drawState)
+    end
+
+  fun consumeEventsLoop (pos, msgVec, drawState) =
+    if pos = Vector.length msgVec then
+      drawState
+    else
+      let
+        val msg = Vector.sub (msgVec, pos)
+        val drawState = consumeEvent (drawState, msg)
+      in
+        consumeEventsLoop (pos + 1, msgVec, drawState)
+      end
+
+  fun consumeEvents drawState =
+    consumeEventsLoop (0, DrawMailbox.getMessagesAndClear (), drawState)
+
+  fun loop (window, app, drawState) =
+    if Rgfw.shouldCloseWindow window then
+      Rgfw.closeWindow window
+    else
+      let
+        val () = Gles3.clearColor (0.89, 0.89, 0.89, 1.0)
+        val () = Gles3.clear ()
+
+        val () = Rgfw.pollEvents ()
+
+        val app = Updater.update app
+
+        val drawState = consumeEvents drawState
+        val () = GlDraw.draw drawState
+        val () = Rgfw.swapBuffers window
+      in
+        loop (window, app, drawState)
+      end
+
+  local
+    fun loop (io, acc, lastCharWasNewline) =
+      case TextIO.inputLine io of
+        SOME str =>
+          let
+            val endsWithNewline =
+              String.size str > 0
+              andalso String.sub (str, String.size str - 1) = #"\n"
+          in
+            loop (io, LineGap.append (str, acc), endsWithNewline)
+          end
+      | NONE =>
+          if lastCharWasNewline then
+            LineGap.goToStart acc
+          else
+            let val acc = LineGap.append ("\n", acc)
+            in LineGap.goToStart acc
+            end
+  in
+    fun ioToLineGap (io, acc) = loop (io, acc, false)
+  end
+
+  fun escapeCallback () = InputMailbox.append InputMsg.KEY_ESC
+
+  fun backspaceCallback () = InputMailbox.append InputMsg.KEY_BACKSPACE
+
+  fun enterCallback () = InputMailbox.append InputMsg.KEY_ENTER
+
+  fun charCallback chr =
+    InputMailbox.append (InputMsg.CHAR_EVENT chr)
+
+  fun resizeCallback (width, height) =
+    InputMailbox.append (InputMsg.RESIZE_EVENT (width, height))
+
+  fun registerCallbacks () =
+    let
+      val () = Rgfw.exportEscapeCallback escapeCallback
+      val () = Rgfw.exportBackspaceCallback backspaceCallback
+      val () = Rgfw.exportEnterCallback enterCallback
+      val () = Rgfw.exportCharCallback charCallback
+      val () = Rgfw.setKeyCallback ()
+
+      val () = Rgfw.exportResizeCallback resizeCallback
+      val () = Rgfw.setResizeCallback ()
+    in
+      ()
+    end
+
+  fun main () =
+    let
+      val window = Rgfw.createWindow ("shf", 0, 0, 1920, 1080)
+      val () = Rgfw.enableVsync window
+      val () = Gles3.enableDepthTest ()
+
+      (* load file intol gap buffer and create initial app *)
+      val io = TextIO.openIn "temp.txt"
+      val lineGap = ioToLineGap (io, LineGap.empty)
+      val () = TextIO.closeIn io
+
+      val () = registerCallbacks ()
+
+      val app = AppType.init (lineGap, 1920, 1080, Time.now ())
+      val drawState = GlDraw.create ()
+    in
+      loop (window, app, drawState)
+    end
+end
+
+val _ = RgfwLoop.main ()

shf/shell/updater.sml

@@ -0,0 +1,47 @@
+structure Updater =
+struct
+  open MailboxType
+  open InputMsg
+
+  fun sendMsg msg =
+    case msg of DRAW msg => DrawMailbox.append msg
+
+  fun sendMsgs msgList =
+    case msgList of
+      hd :: tl => let val () = sendMsg hd in sendMsgs tl end
+    | [] => ()
+
+  fun updateOne (app: AppType.app_type, inputMsg) =
+    let
+      val time = Time.now ()
+
+      val () =
+        case inputMsg of
+          CHAR_EVENT #"~" =>
+            ExceptionLogger.log (Fail "intentionally caused exception")
+        | _ => ()
+
+      val () = ExceptionLogger.addCommand inputMsg
+
+      val app = AppUpdate.update (app, inputMsg, time)
+                handle e => ExceptionLogger.log e
+
+      val () = sendMsgs (#msgs app)
+    in
+      app
+    end
+
+  fun updateLoop (pos, msgVec, app) =
+    if pos = Vector.length msgVec then
+      app
+    else
+      let
+        val msg = Vector.sub (msgVec, pos)
+        val app = updateOne (app, msg)
+      in
+        updateLoop (pos + 1, msgVec, app)
+      end
+
+  fun update app =
+    updateLoop (0, InputMailbox.getMessagesAndClear (), app)
+end