Add 'dotscape/' from commit 'f306501a68a51b634e895c5fdac70788ae899d75'

git-subtree-dir: dotscape
git-subtree-mainline: 6b91d64fc3
git-subtree-split: f306501a68

dotscape/imperative-shell/app-draw.sml

@@ -0,0 +1,117 @@
+structure AppDraw =
+struct
+  type draw_object = {vertexBuffer: Word32.word, program: Word32.word}
+
+  fun initDrawObject (vertexShaderString, fragmentShaderString) : draw_object =
+    let
+      val vertexBuffer = Gles3.createBuffer ()
+      val vertexShader = Gles3.createShader (Gles3.VERTEX_SHADER ())
+      val _ = Gles3.shaderSource (vertexShader, vertexShaderString)
+      val _ = Gles3.compileShader vertexShader
+
+      val fragmentBuffer = Gles3.createBuffer ()
+      val fragmentShader = Gles3.createShader (Gles3.FRAGMENT_SHADER ())
+      val _ = Gles3.shaderSource (fragmentShader, fragmentShaderString)
+      val _ = Gles3.compileShader fragmentShader
+
+      val program = Gles3.createProgram ()
+      val _ = Gles3.attachShader (program, vertexShader)
+      val _ = Gles3.attachShader (program, fragmentShader)
+      val _ = Gles3.linkProgram program
+
+      (* Flag shaders for deletion as we no longer need them 
+       * once the program is linked. *)
+      val _ = Gles3.deleteShader vertexShader
+      val _ = Gles3.deleteShader fragmentShader
+    in
+      {vertexBuffer = vertexBuffer, program = program}
+    end
+
+  fun initGraphLines () =
+    let
+      val graphDrawObject = initDrawObject
+        (Constants.graphVertexShaderString, Constants.graphFragmentShaderString)
+      val {vertexBuffer, program} = graphDrawObject
+
+      val _ = Gles3.bindBuffer vertexBuffer
+      val _ = Gles3.bufferData (#[], 0, Gles3.STATIC_DRAW ())
+      val _ = Gles3.vertexAttribPointer (0, 2, 2, 0)
+      val _ = Gles3.enableVertexAttribArray 0
+    in
+      graphDrawObject
+    end
+
+  fun uploadGraphLines (graphDrawObject: draw_object, vec) =
+    let
+      val {vertexBuffer, ...} = graphDrawObject
+      val _ = Gles3.bindBuffer vertexBuffer
+      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW ())
+    in
+      ()
+    end
+
+  fun drawGraphLines (graphDrawObject: draw_object, graphDrawLength) =
+    let
+      val {vertexBuffer, program} = graphDrawObject
+      val _ = Gles3.bindBuffer vertexBuffer
+      val _ = Gles3.vertexAttribPointer (0, 2, 2, 0)
+      val _ = Gles3.enableVertexAttribArray 0
+      val _ = Gles3.useProgram program
+      val _ = Gles3.drawArrays (Gles3.TRIANGLES (), 0, graphDrawLength)
+    in
+      ()
+    end
+
+  fun initDot () =
+    let
+      val dotDrawObject = initDrawObject
+        ( Constants.colouredVertexShaderString
+        , Constants.colouredFragmentShaderString
+        )
+      val {vertexBuffer, program} = dotDrawObject
+
+      val _ = Gles3.bindBuffer vertexBuffer
+      val _ = Gles3.bufferData (#[], 0, Gles3.STATIC_DRAW ())
+      val _ = Gles3.vertexAttribPointer (0, 2, 5, 0)
+      val _ = Gles3.enableVertexAttribArray 0
+
+      val _ = Gles3.vertexAttribPointer (1, 3, 5, 8)
+      val _ = Gles3.enableVertexAttribArray 1
+    in
+      dotDrawObject
+    end
+
+  fun uploadDotVector (dotDrawObject: draw_object, vec) =
+    let
+      val {vertexBuffer, ...} = dotDrawObject
+      val _ = Gles3.bindBuffer vertexBuffer
+      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW ())
+    in
+      ()
+    end
+
+  fun drawDot (dotDrawObject: draw_object, dotDrawLength) =
+    if dotDrawLength > 0 then
+      let
+        val {vertexBuffer, program} = dotDrawObject
+        val _ = Gles3.bindBuffer vertexBuffer
+        val _ = Gles3.vertexAttribPointer (0, 2, 5, 0)
+        val _ = Gles3.enableVertexAttribArray 0
+        val _ = Gles3.vertexAttribPointer (1, 3, 5, 8)
+        val _ = Gles3.enableVertexAttribArray 1
+        val _ = Gles3.useProgram program
+        val _ = Gles3.drawArrays (Gles3.TRIANGLES (), 0, dotDrawLength)
+      in
+        ()
+      end
+    else
+      ()
+
+  val initModalText = initDot
+  val uploadModalText = uploadDotVector
+  val drawModalText = drawDot
+
+  val initSquares = initDot
+  val uploadSquaresVector = uploadDotVector
+  val drawSquares = drawDot
+end

dotscape/imperative-shell/constants.sml

@@ -0,0 +1,45 @@
+structure Constants =
+struct
+  val windowWidth = 1000
+  val windowHeight = 900
+  val initialWidthClickPoints = 4
+  val initialHeightClickPoints = 4
+
+  val graphVertexShaderString =
+    "#version 300 es\n\
+    \layout (location = 0) in vec2 apos;\n\
+    \void main()\n\
+    \{\n\
+    \   gl_Position = vec4(apos.x, apos.y, 0.0f, 1.0f);\n\
+    \}"
+
+  val graphFragmentShaderString =
+    "#version 300 es\n\
+    \precision mediump float;\n\
+    \out vec4 FragColor;\n\
+    \void main()\n\
+    \{\n\
+    \   FragColor = vec4(0.0f, 0.0f, 0.0f, 1.0f);\n\
+    \}"
+
+  val colouredVertexShaderString =
+    "#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 colouredFragmentShaderString =
+    "#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

dotscape/imperative-shell/converter.sml

@@ -0,0 +1,76 @@
+structure Converter =
+struct
+  fun loadIO (io, str) =
+    case TextIO.inputLine io of
+      SOME line => loadIO (io, str ^ line)
+    | NONE => str
+
+  fun convertFile fullPath =
+    let
+      val io = TextIO.openIn fullPath
+      val text = loadIO (io, "")
+      val () = TextIO.closeIn io
+    in
+      case Parser.parse text of
+        SOME (canvasWidth, canvasHeight, tree) =>
+          let
+            val maxSide = Int.max (canvasWidth, canvasHeight)
+            val squares = LayerTree.flatten (maxSide, tree)
+            val exportString =
+              CollisionTree.toExportString (squares, canvasWidth, canvasHeight, fullPath)
+
+            val pathWithoutExtension = String.substring
+              (fullPath, 0, String.size fullPath - 4)
+            val outputFilePath = pathWithoutExtension ^ ".sml"
+            val io = TextIO.openOut outputFilePath
+            val () = TextIO.output (io, exportString)
+          in
+            TextIO.closeOut io
+          end
+      | NONE => (* we have an error, but ignore *) ()
+    end
+
+  fun endsWithDsc str =
+    if String.size str >= 4 then
+      let
+        val size = String.size str
+        val expectedExtension = String.substring (str, size - 4, 4)
+      in
+        expectedExtension = ".dsc"
+      end
+    else
+      false
+
+  fun loop (dir, rootPath) =
+    case OS.FileSys.readDir dir of
+      SOME path =>
+        let
+          val folderPath = String.concat [rootPath, "/", path]
+          val () =
+            if OS.FileSys.isDir folderPath then
+              (* handle recursive directory *)
+              let val newDir = OS.FileSys.openDir folderPath
+              in loop (newDir, folderPath)
+              end
+            else if OS.FileSys.isLink folderPath then
+              (* ignore *)
+              ()
+            else if endsWithDsc path then
+              (* is a file ending with .dsc extension *)
+              convertFile folderPath
+            else
+              (* is a file but doesn't end with .dsc, so ignore *)
+              ()
+        in
+          loop (dir, rootPath)
+        end
+    | NONE => OS.FileSys.closeDir dir
+
+  fun main () =
+    let
+      val path = OS.FileSys.getDir ()
+      val dir = OS.FileSys.openDir path
+    in
+      loop (dir, path)
+    end
+end

dotscape/imperative-shell/draw-thread.sml

@@ -0,0 +1,188 @@
+structure DrawThread =
+struct
+  open CML
+  open DrawMessage
+
+  fun run
+    ( drawMailbox
+    , window
+    , graphDrawObject
+    , drawGraphLength
+    , dotDrawObject
+    , dotDrawLength
+    , squareDrawObject
+    , squareDrawLength
+    , modalTextDrawObject
+    , modalTextDrawLength
+    ) =
+    if not (Glfw.windowShouldClose window) then
+      case Mailbox.recvPoll drawMailbox of
+        NONE =>
+          let
+            val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0)
+            val _ = Gles3.clear ()
+
+            val _ = AppDraw.drawGraphLines (graphDrawObject, drawGraphLength)
+            val _ = AppDraw.drawSquares (squareDrawObject, squareDrawLength)
+            val _ = AppDraw.drawDot (dotDrawObject, dotDrawLength)
+            val _ =
+              AppDraw.drawModalText (modalTextDrawObject, modalTextDrawLength)
+
+            val _ = Glfw.swapBuffers window
+            val _ = Glfw.pollEvents ()
+          in
+            run
+              ( drawMailbox
+              , window
+              , graphDrawObject
+              , drawGraphLength
+              , dotDrawObject
+              , dotDrawLength
+              , squareDrawObject
+              , squareDrawLength
+              , modalTextDrawObject
+              , modalTextDrawLength
+              )
+          end
+      | SOME drawMsg =>
+          (case drawMsg of
+             DRAW_DOT vec =>
+               let
+                 val _ = AppDraw.uploadDotVector (dotDrawObject, vec)
+                 val dotDrawLength = Vector.length vec div 5
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , dotDrawLength
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end
+           | DRAW_SQUARES_AND_RESET_DOTS squareVec =>
+               let
+                 val _ =
+                   AppDraw.uploadSquaresVector (squareDrawObject, squareVec)
+                 val squareDrawLength = Vector.length squareVec div 5
+               (* dots are reset by setting dotDrawLength to 0 *)
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , 0
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end
+           | DRAW_SQUARES_AND_DOTS {squares = squareVec, dots = dotsVec} =>
+               let
+                 val _ =
+                   AppDraw.uploadSquaresVector (squareDrawObject, squareVec)
+                 val squareDrawLength = Vector.length squareVec div 5
+
+                 val _ = AppDraw.uploadDotVector (dotDrawObject, dotsVec)
+                 val dotDrawLength = Vector.length dotsVec div 5
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , dotDrawLength
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end
+           | CLEAR_DOTS =>
+               let
+                 val dotDrawLength = 0
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , dotDrawLength
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end
+           | RESIZE_SQUARES_DOTS_AND_GRAPH {squares, graphLines, dots} =>
+               let
+                 val _ = AppDraw.uploadSquaresVector (squareDrawObject, squares)
+                 val squareDrawLength = Vector.length squares div 5
+
+                 val _ = AppDraw.uploadGraphLines (graphDrawObject, graphLines)
+                 val drawGraphLength = Vector.length graphLines div 2
+
+                 val _ = AppDraw.uploadDotVector (dotDrawObject, dots)
+                 val dotDrawLength = Vector.length dots div 5
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , dotDrawLength
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end
+           | DRAW_GRAPH graphLines =>
+               let
+                 val _ = AppDraw.uploadGraphLines (graphDrawObject, graphLines)
+                 val drawGraphLength = Vector.length graphLines div 2
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , dotDrawLength
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end
+           | DRAW_MODAL_TEXT vec =>
+               let
+                 val _ = AppDraw.uploadModalText (modalTextDrawObject, vec)
+                 val modalTextDrawLength = Vector.length vec div 5
+               in
+                 run
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , drawGraphLength
+                   , dotDrawObject
+                   , dotDrawLength
+                   , squareDrawObject
+                   , squareDrawLength
+                   , modalTextDrawObject
+                   , modalTextDrawLength
+                   )
+               end)
+    else
+      Glfw.terminate ()
+end

dotscape/imperative-shell/file-thread.sml

@@ -0,0 +1,54 @@
+signature FILE_THREAD =
+sig
+  val run: FileMessage.t Mailbox.mbox * InputMessage.t Mailbox.mbox -> unit
+end
+
+structure FileThread :> FILE_THREAD =
+struct
+  open FileMessage
+  open InputMessage
+
+  fun loadIO (io, str) =
+    case TextIO.inputLine io of
+      SOME line => loadIO (io, str ^ line)
+    | NONE => str
+
+  fun loadSquares (path, inputMailbox) =
+    let
+      val io = TextIO.openIn path
+      val str = loadIO (io, "")
+      val () = TextIO.closeIn io
+    in
+      case Parser.parse str of
+        SOME (canvasWidth, canvasHeight, tree) =>
+          Mailbox.send
+            ( inputMailbox
+            , USE_LAYERS
+                { tree = tree
+                , canvasWidth = canvasWidth
+                , canvasHeight = canvasHeight
+                }
+            )
+      | NONE => ()
+    end
+
+  fun saveString (filename, toSaveString) =
+    let
+      val io = TextIO.openOut filename
+      val () = TextIO.output (io, toSaveString)
+    in
+      TextIO.closeOut io
+    end
+
+  fun run (fileMailbox, inputMailbox) =
+    let
+      val _ =
+        case Mailbox.recv fileMailbox of
+          SAVE_SQUARES {filepath, output} => saveString (filepath, output)
+        | EXPORT_SQUARES {filepath, output} => saveString (filepath, output)
+        | EXPORT_COLLISIONS {filepath, output} => saveString (filepath, output)
+        | LOAD_SQUARES {filepath} => loadSquares (filepath, inputMailbox)
+    in
+      run (fileMailbox, inputMailbox)
+    end
+end

dotscape/imperative-shell/init-glfw.sml

@@ -0,0 +1,65 @@
+structure InitGlfw =
+struct
+  open CML
+
+  fun init path () =
+    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.SAMPLES (), 0)
+      val window =
+        Glfw.createWindow
+          (Constants.windowWidth, Constants.windowHeight, "Dotscape")
+      val _ = Glfw.makeContextCurrent window
+      val _ = Gles3.loadGlad ()
+
+      val initialModel = AppInit.fromWindowWidthAndHeight
+        ( Constants.windowWidth
+        , Constants.windowHeight
+        , Constants.initialWidthClickPoints
+        , Constants.initialHeightClickPoints
+        , path
+        )
+
+      val graphLines = GraphLines.generate initialModel
+      val graphDrawObject = AppDraw.initGraphLines ()
+      val _ = AppDraw.uploadGraphLines (graphDrawObject, graphLines)
+
+      val dotDrawObject = AppDraw.initDot ()
+      val squareDrawObject = AppDraw.initSquares ()
+
+      val modalTextDrawObject = AppDraw.initModalText ()
+
+      val inputMailbox = Mailbox.mailbox ()
+      val drawMailbox = Mailbox.mailbox ()
+      val fileMailbox = Mailbox.mailbox ()
+
+      val _ = InputCallbacks.registerCallbacks (window, inputMailbox)
+
+      val _ = CML.spawn (fn () =>
+        UpdateThread.run (inputMailbox, drawMailbox, fileMailbox, initialModel))
+
+      val _ = CML.spawn (fn () =>
+        DrawThread.run
+          ( drawMailbox
+          , window
+          , graphDrawObject
+          , Vector.length graphLines div 2
+          , dotDrawObject
+          , 0
+          , squareDrawObject
+          , 0
+          , modalTextDrawObject
+          , 0
+          ))
+
+      val _ = CML.spawn (fn () => FileThread.run (fileMailbox, inputMailbox))
+    in
+      ()
+    end
+
+  fun main path =
+    (RunCML.doit (init path, NONE); ())
+end

dotscape/imperative-shell/input-callbacks.sml

@@ -0,0 +1,206 @@
+structure InputCallbacks =
+struct
+  open CML
+  open InputMessage
+
+  fun mouseMoveCallback mailbox (x, y) =
+    Mailbox.send (mailbox, (MOUSE_MOVE {x = x, y = y}))
+
+  fun mouseClickCallback mailbox (button, action) =
+    if button = Input.LEFT_MOUSE_BUTTON () then
+      if action = Input.PRESS () then Mailbox.send (mailbox, MOUSE_LEFT_CLICK)
+      else Mailbox.send (mailbox, MOUSE_LEFT_RELEASE)
+    else
+      ()
+
+  fun framebufferSizeCallback mailbox (width, height) =
+    let val _ = Gles3.viewport (width, height)
+    in Mailbox.send (mailbox, RESIZE_WINDOW {width = width, height = height})
+    end
+
+  fun keyActionCallback mailbox (key, scancode, action, mods) =
+    if
+      key = Input.KEY_Z () andalso action <> Input.RELEASE ()
+    then
+      if mods = 0x0002 then
+        (* ctrl-z *)
+        Mailbox.send (mailbox, UNDO_ACTION)
+      else if mods = 0x0003 then
+        (* ctrl-shift-z *)
+        Mailbox.send (mailbox, REDO_ACTION)
+      else
+        (* no action recognised *)
+        ()
+    else if
+      (* ctrl-y *)
+      key = Input.KEY_Y () andalso action <> Input.RELEASE ()
+      andalso mods = 0x0002
+    then
+      Mailbox.send (mailbox, REDO_ACTION)
+    else if
+      key = Input.KEY_R () andalso action <> Input.RELEASE () andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_R)
+    else if
+      key = Input.KEY_G () andalso action <> Input.RELEASE () andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_G)
+    else if
+      key = Input.KEY_B () andalso action <> Input.RELEASE () andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_B)
+    else if
+      key = Input.KEY_T () andalso action <> Input.RELEASE () andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_T)
+    else if
+      (* ctrl-s *)
+      key = Input.KEY_S () andalso action = Input.PRESS () andalso mods = 0x002
+    then
+      Mailbox.send (mailbox, KEY_CTRL_S)
+    else if
+      key = Input.KEY_L () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_L)
+    else if
+      (* ctrl-l *)
+      key = Input.KEY_L () andalso action = Input.PRESS () andalso mods = 0x002
+    then
+      Mailbox.send (mailbox, KEY_CTRL_L)
+    else if
+      (* ctrl-e *)
+      key = Input.KEY_E () andalso action = Input.PRESS () andalso mods = 0x002
+    then
+      Mailbox.send (mailbox, KEY_CTRL_E)
+    else if
+      (* ctrl-c *)
+      key = Input.KEY_C () andalso action = Input.PRESS () andalso mods = 0x002
+    then
+      Mailbox.send (mailbox, KEY_CTRL_C)
+    else if
+      key = Input.KEY_A () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_A)
+    else if
+      key = Input.KEY_W () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_W)
+    else if
+      key = Input.KEY_H () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_H)
+    else if
+      key = Input.KEY_C () andalso action = Input.PRESS () andalso mods = 0x000
+    then
+      Mailbox.send (mailbox, KEY_C)
+    else if
+      key = Input.KEY_UP () andalso action <> Input.RELEASE ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, ARROW_UP)
+    else if
+      key = Input.KEY_LEFT () andalso action <> Input.RELEASE ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, ARROW_LEFT)
+    else if
+      key = Input.KEY_RIGHT () andalso action <> Input.RELEASE ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, ARROW_RIGHT)
+    else if
+      key = Input.KEY_DOWN () andalso action <> Input.RELEASE ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, ARROW_DOWN)
+    else if
+      key = Input.KEY_BACKSPACE () andalso action = Input.PRESS ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_BACKSPACE)
+    else if
+      key = Input.KEY_ENTER () andalso action = Input.PRESS ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_ENTER)
+    else if
+      key = Input.KEY_SPACE () andalso action = Input.PRESS ()
+      andalso mods = 0x0
+    then
+      Mailbox.send (mailbox, KEY_SPACE)
+    else if
+      key = Input.KEY_0 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 0)
+    else if
+      key = Input.KEY_1 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 1)
+    else if
+      key = Input.KEY_2 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 2)
+    else if
+      key = Input.KEY_3 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 3)
+    else if
+      key = Input.KEY_4 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 4)
+    else if
+      key = Input.KEY_5 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 5)
+    else if
+      key = Input.KEY_6 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 6)
+    else if
+      key = Input.KEY_7 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 7)
+    else if
+      key = Input.KEY_8 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 8)
+    else if
+      key = Input.KEY_9 () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, NUM 9)
+    else if
+      key = Input.KEY_ESC () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_ESC)
+    else if
+      key = Input.KEY_M () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_M)
+    else if
+      key = Input.KEY_F () andalso action = Input.PRESS () andalso mods = 0
+    then
+      Mailbox.send (mailbox, KEY_F)
+    else
+      ()
+
+  fun registerCallbacks (window, inputMailbox) =
+    let
+      val mouseMoveCallback = mouseMoveCallback inputMailbox
+      val _ = Input.exportMouseMoveCallback mouseMoveCallback
+      val _ = Input.setMouseMoveCallback window
+
+      val mouseClickCallback = mouseClickCallback inputMailbox
+      val _ = Input.exportMouseClickCallback mouseClickCallback
+      val _ = Input.setMouseClickCallback window
+
+      val resizeCallback = framebufferSizeCallback inputMailbox
+      val _ = Input.exportFramebufferSizeCallback resizeCallback
+      val _ = Input.setFramebufferSizeCallback window
+
+      val keyCallback = keyActionCallback inputMailbox
+      val _ = Input.exportKeyCallback keyCallback
+      val _ = Input.setKeyCallback window
+    in
+      ()
+    end
+end

dotscape/imperative-shell/shell.sml

@@ -0,0 +1,17 @@
+structure Shell =
+struct
+  fun main () =
+    case CommandLine.arguments () of
+      ["-r"] => Converter.main ()
+    | [filename] => InitGlfw.main filename
+    | [] => print "error: no arguments\n"
+    | args =>
+        let
+          val args = String.concatWith "" args
+          val msg = String.concat ["unknown arguments error: \"", args, "\"\n"]
+        in
+          print msg
+        end
+end
+
+val _ = Shell.main ()

dotscape/imperative-shell/update-thread.sml

@@ -0,0 +1,40 @@
+signature UPDATE_THREAD =
+sig
+  val run:
+    InputMessage.t Mailbox.mbox
+    * DrawMessage.t Mailbox.mbox
+    * FileMessage.t Mailbox.mbox
+    * AppType.app_type
+    -> unit
+end
+
+structure UpdateThread :> UPDATE_THREAD =
+struct
+  open CML
+  open UpdateMessage
+
+  fun handleMsg (drawMailbox, fileMailbox, updateMsg) =
+    case updateMsg of
+      DRAW drawMsg => Mailbox.send (drawMailbox, drawMsg)
+    | FILE fileMsg => Mailbox.send (fileMailbox, fileMsg)
+
+  fun handleMsgs (drawMailbox, fileMailbox, lst) =
+    case lst of
+      hd :: tl =>
+        let val _ = handleMsg (drawMailbox, fileMailbox, hd)
+        in handleMsgs (drawMailbox, fileMailbox, tl)
+        end
+    | [] => ()
+
+  fun loop (inputMailbox, drawMailbox, fileMailbox, model) =
+    let
+      val inputMsg = Mailbox.recv inputMailbox
+      val (model, updateMsgs) = AppUpdate.update (model, inputMsg)
+      val _ = handleMsgs (drawMailbox, fileMailbox, updateMsgs)
+    in
+      loop (inputMailbox, drawMailbox, fileMailbox, model)
+    end
+
+  fun run (inputMailbox, drawMailbox, fileMailbox, initial) =
+    loop (inputMailbox, drawMailbox, fileMailbox, initial)
+end