Add 'dotscape/' from commit 'f306501a68a51b634e895c5fdac70788ae899d75'

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

dotscape/LICENSE

@@ -0,0 +1,5 @@
+Copyright (C) 2024 by Humza Shahid <humzasaur@gmail.com>
+
+Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

dotscape/Makefile

@@ -0,0 +1,14 @@
+PREFIX ?= /usr/local
+
+run: build
+	./dsc
+
+build:
+	./build-unix.sh
+
+install: build
+	install -d $(DESTDIR)$(PREFIX)/bin/
+	install -m 755 dsc $(DESTDIR)$(PREFIX)/bin/
+
+uninstall:
+	rm $(DESTDIR)$(PREFIX)/bin/dsc

dotscape/README.md

@@ -0,0 +1,56 @@
+# dotscape
+
+## What is this?
+
+Dotscape is a simple GUI program for composing 2D shapes out of triangles and exporting them to code for use with OpenGL or other graphics libraries.
+
+## Why
+
+I wanted to create glyphs in OpenGL for one of my other projects. 
+
+I coded vectors for 'A' and 'B' (containing 72 elements and 128 elements respectively), but the process was time consuming. 
+
+I wanted there to be a lightweight GUI editor specialised for creating 2D shapes that can be exported as code for use with OpenGL, and that's what this project is for.
+
+## Demo
+
+<p align="center">
+<img src="images/anim.gif" height="400px"/>
+</p>
+
+## Building
+
+### Build requirements
+
+Dotscape has only been tested on aarch64-linux (a Raspberry Pi 5) but it may work on other platforms.
+
+Requirements include:
+
+- The [MLton](https://github.com/mlton/mlton) compiler for Standard ML
+- OpenG ES 3.0
+- The [GLFW](https://github.com/glfw/glfw) windowing library
+
+The last two requirements may be a bit malleable because the project follows the [Functional Core, Imperative Shell](https://hummy123.github.io/2024/06/20/Functional-Core,-Imperative-Shell.html) architecture, maintaining a strict separation between pure and impure code.
+
+### How to build
+
+1. `git clone https://github.com/hummy123/dotscape`
+2. `cd dotscape`
+3. `./build-unix.sh`
+4. `./dotscape`
+
+## To do
+
+This isn't an exhaustive list, but these are some features I would like to add to this project at some point from the top of my head.
+
+- [x] Display clicked positions
+- [x] Redraw components when resized
+- [x] Support undo (with `<Ctrl-z>`) and redo (with `<Ctrl-y>` or `<Ctrl-Shift-z>`)
+- [x] Save drawn project to a custom file format and allow reloading
+- [x] Export to code with `<Ctrl-E>`.
+  - Exports a function which takes `(xPos, yPos, xLength, yLength, windowWidth, windowHeight)` arguments and returns a vector where the object is fitted in these coordinates.
+- [ ] Add right-side panel 
+  - With options (like adjusting x/y coordinates in a number input, possibly layers, selecting export options...)
+- [ ] Support setting more z coordinates and (r,g,b,a) colour values.
+
+There's quite a bit to do!

dotscape/build-unix.sh

@@ -0,0 +1,9 @@
+#!/bin/sh
+mlton -link-opt "$(pkg-config --cflags glfw3) $(pkg-config --static --libs glfw3)" \
+  -export-header ffi/export.h \
+  -output dsc \
+  dotscape.mlb \
+  ffi/glad.c \
+  ffi/glfw-export.c \
+  ffi/gles3-export.c \
+  ffi/glfw-input.c

dotscape/dotscape.mlb

@@ -0,0 +1,77 @@
+$(SML_LIB)/basis/basis.mlb
+
+(* FUNCTIONAL CORE *)
+fcore/grid.sml
+fcore/layer-tree.sml
+
+(* parser *)
+ann
+  "allowVectorExps true"
+in
+  fcore/parser/space-dfa.sml
+  fcore/parser/int-dfa.sml
+  fcore/parser/brace-dfa.sml
+  fcore/parser/all-dfa.sml
+end
+
+fcore/parser/tokens.sml
+fcore/parser/lexer.sml
+fcore/parser/parse-grid.sml
+fcore/parser/parser.sml
+(* end of parser *)
+
+fcore/app-type.sml
+
+ann
+  "allowVectorExps true"
+in
+  fcore/ndc.sml
+end
+
+fcore/graph-lines.sml
+fcore/click-points.sml
+fcore/app-init.sml
+fcore/app-with.sml
+
+message-types/draw-msg.sml
+message-types/file-msg.sml
+message-types/input-msg.sml
+message-types/update-msg.sml
+
+fcore/file-string.sml
+fcore/quad-tree.sml
+
+fcore/common-update.sml
+fcore/normal-mode.sml
+fcore/move-mode.sml
+fcore/app-update.sml
+
+(* IMPERATIVE SHELL *)
+$(SML_LIB)/basis/mlton.mlb
+$(SML_LIB)/cml/cml.mlb
+
+ann
+  "allowFFI true"
+in
+  ffi/gles3-import.sml
+  ffi/glfw-import.sml
+  ffi/glfw-input.sml
+end
+
+ann
+  "allowVectorExps true"
+in
+  imperative-shell/constants.sml
+  imperative-shell/app-draw.sml
+end
+
+imperative-shell/input-callbacks.sml
+
+imperative-shell/update-thread.sml
+imperative-shell/file-thread.sml
+imperative-shell/draw-thread.sml
+imperative-shell/init-glfw.sml
+
+imperative-shell/converter.sml
+
+imperative-shell/shell.sml

dotscape/fcore/app-init.sml

@@ -0,0 +1,92 @@
+signature APP_INIT =
+sig
+  val fromWindowWidthAndHeight: int * int * int * int * string
+                                -> AppType.app_type
+end
+
+structure AppInit :> APP_INIT =
+struct
+  open AppType
+
+  fun helpFromWidthAndHeight
+    ( windowWidth
+    , windowHeight
+    , wStart
+    , wFinish
+    , hStart
+    , hFinish
+    , canvasWidth
+    , canvasHeight
+    , filepath
+    ) : app_type =
+    let
+      val (xClickPoints, yClickPoints) =
+        ClickPoints.generate
+          (windowWidth, windowHeight, canvasWidth, canvasHeight)
+
+      val maxPoints = Int.max (canvasWidth, canvasHeight)
+      val layerTree = LayerTree.init maxPoints
+    in
+      { mode = AppType.NORMAL_MODE
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , mouseX = 0.0
+      , mouseY = 0.0
+      , showGraph = true
+      , arrowX = 0
+      , arrowY = 0
+      , openFilePath = filepath
+      , r = 0
+      , g = 0
+      , b = 0
+      , a = 1
+      , layer = LayerTree.minKey
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun fromWindowWidthAndHeight
+    (windowWidth, windowHeight, canvasWidth, canvasHeight, filepath) =
+    if windowWidth > windowHeight then
+      let
+        val difference = windowWidth - windowHeight
+        val wStart = difference div 2
+        val wFinish = wStart + windowHeight
+      in
+        helpFromWidthAndHeight
+          ( windowWidth
+          , windowHeight
+          , wStart
+          , wFinish
+          , 0
+          , windowHeight
+          , canvasWidth
+          , canvasHeight
+          , filepath
+          )
+      end
+    else
+      let
+        val difference = windowHeight - windowWidth
+        val hStart = difference div 2
+        val hFinish = hStart + windowWidth
+      in
+        helpFromWidthAndHeight
+          ( windowWidth
+          , windowHeight
+          , 0
+          , windowWidth
+          , hStart
+          , hFinish
+          , canvasWidth
+          , canvasHeight
+          , filepath
+          )
+      end
+end

dotscape/fcore/app-type.sml

@@ -0,0 +1,35 @@
+structure AppType =
+struct
+  datatype app_mode = NORMAL_MODE | MOVE_MODE
+
+  type square = {r: int, g: int, b: int, a: int}
+
+  type app_type =
+    { mode: app_mode
+    , canvasWidth: int
+    , canvasHeight: int
+    , windowWidth: int
+    , windowHeight: int
+    , xClickPoints: Real32.real vector
+    , yClickPoints: Real32.real vector
+
+    (* undo and redo commented out temporarily 
+    , undo: (Real32.real * Real32.real) list
+    , redo: (Real32.real * Real32.real) list
+    *)
+
+    , showGraph: bool
+    , mouseX: Real32.real
+    , mouseY: Real32.real
+    , arrowX: int
+    , arrowY: int
+    , openFilePath: string
+    , r: int
+    , g: int
+    , b: int
+    , a: int
+    , layer: int
+    , layerTree: LayerTree.t
+    , modalNum: int
+    }
+end

dotscape/fcore/app-update.sml

@@ -0,0 +1,9 @@
+structure AppUpdate =
+struct
+  open AppType
+
+  fun update (model: app_type, inputMsg) =
+    case #mode model of
+      NORMAL_MODE => NormalMode.update (model, inputMsg)
+    | MOVE_MODE => MoveMode.update (model, inputMsg)
+end

dotscape/fcore/app-with.sml

@@ -0,0 +1,889 @@
+structure AppWith =
+struct
+  open AppType
+
+  fun arrowX (app, arrowX) =
+    let
+      val
+        { mode
+        , arrowX = _
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+
+        , showGraph
+        , mouseX
+        , mouseY
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+    in
+      { mode = mode
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun arrowY (app, arrowY) =
+    let
+      val
+        { mode
+        , arrowX
+        , arrowY = _
+        , canvasWidth
+        , canvasHeight
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+
+        , showGraph
+        , mouseX
+        , mouseY
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+    in
+      { mode = mode
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun windowResize (app: app_type, windowWidth, windowHeight) : app_type =
+    let
+      val
+        { mode
+        , xClickPoints = _
+        , yClickPoints = _
+        , windowWidth = _
+        , windowHeight = _
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , mouseX
+        , mouseY
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+
+      val (xClickPoints, yClickPoints) =
+        ClickPoints.generate
+          (windowWidth, windowHeight, canvasWidth, canvasHeight)
+    in
+      { mode = mode
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun mousePosition (app: app_type, mouseX, mouseY) =
+    let
+      val
+        { mode
+        , mouseX = _
+        , mouseY = _
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun graphVisibility (app: app_type, shouldShowGraph) =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph = _
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = shouldShowGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun mode (app: app_type, newMode) =
+    let
+      val
+        { mode = _
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+    in
+      { mode = newMode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun modalNum (app: app_type, newNum) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum = prevNum
+        } = app
+
+      val newNum = (prevNum * 10) + newNum
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = newNum
+      }
+    end
+
+  fun r (app: app_type) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r = _
+        , g
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+
+      val r = Int.min (modalNum, 255)
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun g (app: app_type) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g = _
+        , b
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+
+      val g = Int.min (modalNum, 255)
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun b (app: app_type) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b = _
+        , a
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+
+      val b = Int.min (modalNum, 255)
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun a (app: app_type) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a = _
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+
+      val a = Int.min (modalNum, 255)
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun layer (app: app_type) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer = _
+        , layerTree
+        , modalNum
+        } = app
+
+      val layer = Int.max (modalNum, 1)
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun layerTree (app: app_type, layerTree, arrowX, arrowY) : app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        , arrowX = _
+        , arrowY = _
+        , canvasWidth
+        , canvasHeight
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree = _
+        , modalNum
+        } = app
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+
+  fun canvasWidth (app: app_type, newCanvasWidth, newLayerTree) =
+    let
+      val
+        { mode
+        , canvasWidth = _
+        , arrowX
+        , arrowY
+        , canvasHeight
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+
+        , showGraph
+        , mouseX
+        , mouseY
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree = _
+        , modalNum
+        } = app
+
+      val arrowX = Int.min (arrowX, newCanvasWidth)
+      val (xClickPoints, yClickPoints) =
+        ClickPoints.generate
+          (windowWidth, windowHeight, newCanvasWidth, canvasHeight)
+    in
+      { mode = mode
+      , canvasWidth = newCanvasWidth
+      , arrowX = arrowX
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowY = arrowY
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = newLayerTree
+      , modalNum = 0
+      }
+    end
+
+  fun canvasHeight (app: app_type, newCanvasHeight, newLayerTree) =
+    let
+      val
+        { mode
+        , canvasHeight = _
+        , canvasWidth
+        , arrowX
+        , arrowY
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+
+        , showGraph
+        , mouseX
+        , mouseY
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree = _
+        , modalNum
+        } = app
+
+      val arrowY = Int.min (arrowY, newCanvasHeight)
+      val (xClickPoints, yClickPoints) =
+        ClickPoints.generate
+          (windowWidth, windowHeight, canvasWidth, newCanvasHeight)
+    in
+      { mode = mode
+      , canvasHeight = newCanvasHeight
+      , canvasWidth = canvasWidth
+      , arrowX = arrowX
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowY = arrowY
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = newLayerTree
+      , modalNum = 0
+      }
+    end
+
+  fun cursorColour (app, r, g, b, a) =
+    let
+      val
+        { mode
+        , canvasHeight
+        , canvasWidth
+        , arrowX
+        , arrowY
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+
+        , showGraph
+        , mouseX
+        , mouseY
+        , openFilePath
+        , r = _
+        , g = _
+        , b = _
+        , a = _
+        , layer
+        , layerTree
+        , modalNum
+        } = app
+    in
+      { mode = mode
+      , canvasHeight = canvasHeight
+      , canvasWidth = canvasWidth
+      , arrowX = arrowX
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowY = arrowY
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = 0
+      }
+    end
+
+  fun parsedLayerTree (app: app_type, layerTree, canvasWidth, canvasHeight) :
+    app_type =
+    let
+      val
+        { mode
+        , mouseX
+        , mouseY
+        , xClickPoints = _
+        , yClickPoints = _
+        , windowWidth
+        , windowHeight
+        , arrowX
+        , arrowY
+        , canvasWidth = _
+        , canvasHeight = _
+
+        , showGraph
+        , openFilePath
+        , r
+        , g
+        , b
+        , a
+        , layer
+        , layerTree = _
+        , modalNum
+        } = app
+
+      val arrowX =
+        if canvasWidth = 0 then 0 else Int.min (canvasWidth - 1, arrowX)
+      val arrowY =
+        if canvasHeight = 0 then 0 else Int.min (canvasHeight - 1, arrowY)
+      val (xClickPoints, yClickPoints) =
+        ClickPoints.generate
+          (windowWidth, windowHeight, canvasWidth, canvasHeight)
+    in
+      { mode = mode
+      , mouseX = mouseX
+      , mouseY = mouseY
+      , arrowX = arrowX
+      , arrowY = arrowY
+      , canvasWidth = canvasWidth
+      , canvasHeight = canvasHeight
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+
+      , showGraph = showGraph
+      , openFilePath = openFilePath
+      , r = r
+      , g = g
+      , b = b
+      , a = a
+      , layer = layer
+      , layerTree = layerTree
+      , modalNum = modalNum
+      }
+    end
+end

dotscape/fcore/click-points.sml

@@ -0,0 +1,88 @@
+structure ClickPoints =
+struct
+  fun generate (windowWidth, windowHeight, canvasWidth, canvasHeight) =
+    let
+      val realWindowWidth = Real32.fromInt windowWidth
+      val realCanvasWidth = Real32.fromInt canvasWidth
+      val realWindowHeight = Real32.fromInt windowHeight
+      val realCanvasHeight = Real32.fromInt canvasHeight
+
+      val xPixelSize = realWindowWidth / realCanvasWidth
+      val yPixelSize = realWindowHeight / realCanvasHeight
+
+      val pixelSize = Real32.min (xPixelSize, yPixelSize)
+
+      val actualWidth = pixelSize * realCanvasWidth
+      val actualHeight = pixelSize * realCanvasHeight
+
+      val heightDifference = realWindowHeight - actualHeight
+      val yOffset = heightDifference / 2.0
+      val widthDifference = realWindowWidth - actualWidth
+      val xOffset = widthDifference / 2.0
+
+      val xClickPoints = Vector.tabulate (canvasWidth + 1, fn i =>
+        (Real32.fromInt i * pixelSize) + xOffset)
+      val yClickPoints = Vector.tabulate (canvasHeight + 1, fn i =>
+        (Real32.fromInt i * pixelSize) + yOffset)
+    in
+      (xClickPoints, yClickPoints)
+    end
+
+  fun getClickPos (clickPoints, mousePos, idx) =
+    let
+      val nextIdx = idx + 1
+    in
+      if nextIdx >= Vector.length clickPoints then
+        NONE
+      else
+        let
+          val curPos = Vector.sub (clickPoints, idx)
+          val nextPos = Vector.sub (clickPoints, nextIdx)
+        in
+          if mousePos >= curPos andalso mousePos <= nextPos then SOME idx
+          else getClickPos (clickPoints, mousePos, idx + 1)
+        end
+    end
+
+  fun getClickPositionFromMouse (app: AppType.app_type) =
+    case getClickPos (#xClickPoints app, #mouseX app, 0) of
+      SOME hIdx =>
+        (case getClickPos (#yClickPoints app, #mouseY app, 0) of
+           SOME vIdx => SOME (hIdx, vIdx)
+         | NONE => NONE)
+    | NONE => NONE
+
+  fun getDrawDot (xpos, ypos, windowWidth, windowHeight) =
+    let
+      (* calculate normalised device coordinates *)
+      val halfWidth = Real32.fromInt (windowWidth div 2)
+      val halfHeight = Real32.fromInt (windowHeight div 2)
+      val hpos = xpos - halfWidth
+      val vpos = ~(ypos - halfHeight)
+
+      (* coordinates to form small box around clicked area *)
+      val left = (hpos - 5.0) / halfWidth
+      val right = (hpos + 5.0) / halfWidth
+      val bottom = (vpos - 5.0) / halfHeight
+      val top = (vpos + 5.0) / halfHeight
+    in
+      Ndc.ltrbToVertex (left, top, right, bottom)
+    end
+
+  fun getDrawDotRgb (xpos, ypos, r, g, b, windowWidth, windowHeight) =
+    let
+      (* calculate normalised device coordinates *)
+      val halfWidth = Real32.fromInt (windowWidth div 2)
+      val halfHeight = Real32.fromInt (windowHeight div 2)
+      val hpos = xpos - halfWidth
+      val vpos = ~(ypos - halfHeight)
+
+      (* coordinates to form small box around clicked area *)
+      val left = (hpos - 5.0) / halfWidth
+      val right = (hpos + 5.0) / halfWidth
+      val bottom = (vpos - 5.0) / halfHeight
+      val top = (vpos + 5.0) / halfHeight
+    in
+      Ndc.ltrbToVertexRgb (left, top, right, bottom, r, g, b)
+    end
+end

dotscape/fcore/common-update.sml

@@ -0,0 +1,103 @@
+structure CommonUpdate =
+struct
+  open AppType
+
+  open DrawMessage
+  open FileMessage
+  open InputMessage
+  open UpdateMessage
+
+  fun resizeWindow (model, width, height, dots) =
+    let
+      val
+        { canvasWidth
+        , canvasHeight
+        , showGraph
+        , arrowX
+        , arrowY
+        , xClickPoints
+        , yClickPoints
+        , layerTree
+        , ...
+        } = model
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+      val squares = LayerTree.flatten (maxSide, layerTree)
+
+      val squares = CollisionTree.toTriangles
+        ( width
+        , height
+        , squares
+        , maxSide
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+
+      val graphLines =
+        if showGraph then GraphLines.generate model else Vector.fromList []
+
+      val drawMsg =
+        RESIZE_SQUARES_DOTS_AND_GRAPH
+          {squares = squares, graphLines = graphLines, dots = dots}
+      val drawMsg = [DRAW drawMsg]
+    in
+      (model, drawMsg)
+    end
+
+  fun getSaveSquaresMsg (model: app_type) =
+    let
+      val {layerTree, canvasWidth, canvasHeight, openFilePath, ...} = model
+      val saveString =
+        CollisionTree.toSaveString (layerTree, canvasWidth, canvasHeight)
+      val msg = SAVE_SQUARES {output = saveString, filepath = openFilePath}
+    in
+      (model, [FILE msg])
+    end
+
+  fun getLoadSquaresMsg (model: app_type) =
+    let val msg = LOAD_SQUARES {filepath = #openFilePath model}
+    in (model, [FILE msg])
+    end
+
+  fun getExportSquaresMsg (model: app_type) =
+    let
+      val {layerTree, canvasWidth, canvasHeight, openFilePath, ...} = model
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+      val squares = LayerTree.flatten (maxSide, layerTree)
+
+      val exportString =
+        CollisionTree.toExportString (squares, canvasWidth, canvasHeight, openFilePath)
+      val msg = EXPORT_SQUARES {output = exportString, filepath = openFilePath}
+    in
+      (model, [FILE msg])
+    end
+
+  fun getCollisionMsg (model: app_type) =
+    let
+      val {layerTree, canvasWidth, canvasHeight, modalNum, openFilePath, ...} =
+        model
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+      val squares = LayerTree.flatten (maxSide, layerTree)
+
+      val exportString =
+        CollisionTree.toCollisionString
+          (squares, canvasWidth, canvasHeight, modalNum)
+
+      val exportFilePath = FileString.getCollisionFilename openFilePath
+      val msg =
+        EXPORT_COLLISIONS {output = exportString, filepath = exportFilePath}
+
+      val model = AppWith.modalNum (model, 0)
+    in
+      (model, [FILE msg])
+    end
+
+  (* unimplemented *)
+  fun useSquaresInNormalMode (model, squares) = (model, [])
+
+  fun squaresLoadError model = (model, [])
+end

dotscape/fcore/file-string.sml

@@ -0,0 +1,59 @@
+structure FileString =
+struct
+  fun findLastChr (str, pos, findChr) =
+    if pos < 0 then ~1
+    else if String.sub (str, pos) = findChr then pos
+    else findLastChr (str, pos - 1, findChr)
+
+  fun extractFileName str =
+    let
+      val lastSlash = findLastChr (str, String.size str - 1, #"/")
+      val strStart = lastSlash + 1
+    in
+      if lastSlash = ~1 then str
+      else String.substring (str, strStart, String.size str - strStart)
+    end
+
+  fun removeFileExtension str =
+    let val lastDot = findLastChr (str, String.size str - 1, #".")
+    in if lastDot = ~1 then str else String.substring (str, 0, lastDot)
+    end
+
+  local
+    fun finish acc =
+      let val acc = List.rev acc
+      in String.implode acc
+      end
+
+    (* convert from kebab-case or snake_case to PascalCase *)
+    fun loop (#"-" :: chr :: tl, acc) =
+          let val acc = Char.toUpper chr :: acc
+          in loop (tl, acc)
+          end
+      | loop (#"_" :: chr :: tl, acc) =
+          let val acc = Char.toUpper chr :: acc
+          in loop (tl, acc)
+          end
+      | loop ([#"-"], acc) = finish acc
+      | loop ([#"_"], acc) = finish acc
+      | loop (chr :: tl, acc) =
+          loop (tl, chr :: acc)
+      | loop ([], acc) = finish acc
+  in
+    fun filenameToStructureName str =
+      let
+        val str = removeFileExtension str
+        val str = extractFileName str
+      in
+        (* capitalise first character in string *)
+        case String.explode str of
+          chr :: tl => let val chr = Char.toUpper chr in loop (tl, [chr]) end
+        | [] => ""
+      end
+  end
+
+  fun getCollisionFilename str =
+    let val str = removeFileExtension str
+    in str ^ "-collisions.sml"
+    end
+end

dotscape/fcore/graph-lines.sml

@@ -0,0 +1,69 @@
+signature GRAPH_LINES =
+sig
+  val generate: AppType.app_type -> Real32.real vector
+end
+
+structure GraphLines :> GRAPH_LINES =
+struct
+  fun helpGenGraphLinesX
+    (pos, xClickPoints, yClickPoints, acc, windowWidth, windowHeight) =
+    if pos = Vector.length xClickPoints then
+      Vector.concat acc
+    else
+      let
+        val halfWidth = Real32.fromInt windowWidth / 2.0
+        val halfHeight = Real32.fromInt windowHeight / 2.0
+
+        val curX = Vector.sub (xClickPoints, pos)
+        val minusX = Ndc.fromPixelX (curX - 1.0, windowWidth, windowHeight)
+        val plusX = Ndc.fromPixelX (curX + 1.0, windowWidth, windowHeight)
+
+        val minY = Vector.sub (yClickPoints, 0)
+        val maxY = Vector.sub (yClickPoints, Vector.length yClickPoints - 1)
+        val minY = Ndc.fromPixelY (minY, windowWidth, windowHeight)
+        val maxY = Ndc.fromPixelY (maxY, windowWidth, windowHeight)
+
+        val acc = Ndc.ltrbToVertex (minusX, maxY, plusX, minY) :: acc
+      in
+        helpGenGraphLinesX
+          (pos + 1, xClickPoints, yClickPoints, acc, windowWidth, windowHeight)
+      end
+
+  fun helpGenGraphLinesY
+    (pos, yClickPoints, xClickPoints, acc, windowWidth, windowHeight) =
+    if pos = Vector.length yClickPoints then
+      acc
+    else
+      let
+        val halfWidth = Real32.fromInt windowWidth / 2.0
+        val halfHeight = Real32.fromInt windowHeight / 2.0
+
+        val curY = Vector.sub (yClickPoints, pos)
+        val minusY = Ndc.fromPixelY (curY - 1.0, windowWidth, windowHeight)
+        val plusY = Ndc.fromPixelY (curY + 1.0, windowWidth, windowHeight)
+
+        val minX = Vector.sub (xClickPoints, 0)
+        val maxX = Vector.sub (xClickPoints, Vector.length xClickPoints - 1)
+        val minX = Ndc.fromPixelX (minX, windowWidth, windowHeight)
+        val maxX = Ndc.fromPixelX (maxX, windowWidth, windowHeight)
+
+        val acc = Ndc.ltrbToVertex (minX, plusY, maxX, minusY) :: acc
+      in
+        helpGenGraphLinesY
+          (pos + 1, yClickPoints, xClickPoints, acc, windowWidth, windowHeight)
+      end
+
+  fun helpGenerate (windowWidth, windowHeight, xClickPoints, yClickPoints) =
+    let
+      val acc = helpGenGraphLinesY
+        (0, yClickPoints, xClickPoints, [], windowWidth, windowHeight)
+    in
+      helpGenGraphLinesX
+        (0, xClickPoints, yClickPoints, acc, windowWidth, windowHeight)
+    end
+
+  fun generate (app: AppType.app_type) =
+    let val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = app
+    in helpGenerate (windowWidth, windowHeight, xClickPoints, yClickPoints)
+    end
+end

dotscape/fcore/grid.sml

@@ -0,0 +1,45 @@
+structure Grid =
+struct
+  type pixel = {r: int, g: int, b: int, a: int}
+
+  type t = pixel vector vector
+
+  val emptyPixel = {r = 0, g = 0, b = 0, a = 0}
+
+  fun isBlank ({a, ...}: pixel) = a = 0
+
+  fun changeGridSize maxSide grid =
+    Vector.tabulate (maxSide, fn i =>
+      if i < Vector.length grid then
+        let
+          val yAxis = Vector.sub (grid, i)
+        in
+          Vector.tabulate (maxSide, fn ii =>
+            if ii < Vector.length yAxis then Vector.sub (yAxis, ii)
+            else emptyPixel)
+        end
+      else
+        Vector.tabulate (maxSide, fn _ => emptyPixel))
+
+  fun updateGrid (grid, newX, newY, pixel) =
+    let
+      val yAxis = Vector.sub (grid, newX)
+      val yAxis = Vector.update (yAxis, newY, pixel)
+    in
+      Vector.update (grid, newX, yAxis)
+    end
+
+  fun makeEmpty maxSide =
+    Vector.tabulate (maxSide, fn _ =>
+      Vector.tabulate (maxSide, fn _ => emptyPixel))
+
+  fun flipHorizontally (xAxis: t) =
+    Vector.mapi
+      (fn (xIdx, yAxis) =>
+         let
+           val flippedXIdx = Vector.length xAxis - 1 - xIdx
+           val flippedYAxis = Vector.sub (xAxis, flippedXIdx)
+         in
+           Vector.mapi (fn (yIdx, _) => Vector.sub (flippedYAxis, yIdx)) yAxis
+         end) xAxis
+end

dotscape/fcore/layer-tree.sml

@@ -0,0 +1,112 @@
+structure LayerTree =
+struct
+  datatype t = NODE of {key: int, value: Grid.t, left: t, right: t} | LEAF
+
+  val minKey = 1
+
+  fun init maxSide =
+    let val grid = Grid.makeEmpty maxSide
+    in NODE {key = minKey, value = grid, left = LEAF, right = LEAF}
+    end
+
+  fun singleton grid =
+    NODE {key = minKey, value = grid, left = LEAF, right = LEAF}
+
+  fun insert (newKey, newValue, tree) =
+    case tree of
+      LEAF => NODE {key = newKey, value = newValue, left = LEAF, right = LEAF}
+    | NODE {key, value, left, right} =>
+        if newKey < key then
+          NODE
+            { key = key
+            , value = value
+            , left = insert (newKey, newValue, left)
+            , right = right
+            }
+        else if newKey > key then
+          NODE
+            { key = key
+            , value = value
+            , left = left
+            , right = insert (newKey, newValue, right)
+            }
+        else
+          NODE {key = key, value = newValue, left = left, right = right}
+
+  fun get (searchKey, tree) =
+    case tree of
+      LEAF => NONE
+    | NODE {key, value, left, right} =>
+        if searchKey < key then get (searchKey, left)
+        else if searchKey > key then get (searchKey, right)
+        else SOME value
+
+  fun foldl (f, tree, acc) =
+    case tree of
+      LEAF => acc
+    | NODE {value, left, right, ...} =>
+        let
+          val acc = foldl (f, left, acc)
+          val acc = f (value, acc)
+        in
+          foldl (f, right, acc)
+        end
+
+  fun foldr (f, tree, acc) =
+    case tree of
+      LEAF => acc
+    | NODE {value, left, right, ...} =>
+        let
+          val acc = foldr (f, right, acc)
+          val acc = f (value, acc)
+        in
+          foldr (f, left, acc)
+        end
+
+  fun map (f, tree) =
+    case tree of
+      LEAF => LEAF
+    | NODE {key, value, left, right} =>
+        let
+          val left = map (f, left)
+          val right = map (f, right)
+          val newValue = f value
+        in
+          NODE {key = key, value = newValue, left = left, right = right}
+        end
+
+  (* copies non-blank pixels in value vector into acc *)
+  fun helpFlatten (value, acc) =
+    Vector.mapi
+      (fn (xIdx, valueYAxis) =>
+         Vector.mapi
+           (fn (yIdx, valuePixel) =>
+              if Grid.isBlank valuePixel then
+                let val accYAxis = Vector.sub (acc, xIdx)
+                in Vector.sub (accYAxis, yIdx)
+                end
+              else
+                valuePixel) valueYAxis) value
+
+  fun flatten (maxSide, tree) =
+    foldl (helpFlatten, tree, Grid.makeEmpty maxSide)
+
+  fun changeGridSize (maxSide, tree) =
+    let val f = Grid.changeGridSize maxSide
+    in map (f, tree)
+    end
+
+  fun addPixel (key, newX, newY, maxSide, pixel, tree) =
+    let
+      val grid =
+        case get (key, tree) of
+          SOME grid => grid
+        | NONE => Grid.makeEmpty maxSide
+
+      val grid = Grid.updateGrid (grid, newX, newY, pixel)
+    in
+      insert (key, grid, tree)
+    end
+
+  fun flipHorizontally tree = map (Grid.flipHorizontally, tree)
+end

dotscape/fcore/move-mode.sml

@@ -0,0 +1,126 @@
+structure MoveMode =
+struct
+  open AppType
+  open InputMessage
+  open DrawMessage
+  open UpdateMessage
+
+  fun resizeWindow (model, width, height) =
+    let
+      val model = AppWith.windowResize (model, width, height)
+      val dots = Vector.fromList []
+    in
+      CommonUpdate.resizeWindow (model, width, height, dots)
+    end
+
+  fun getDrawMsg (model: app_type) =
+    let
+      val
+        { canvasWidth
+        , canvasHeight
+        , windowWidth
+        , windowHeight
+        , layerTree
+        , xClickPoints
+        , yClickPoints
+        , ...
+        } = model
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+      val grid = LayerTree.flatten (maxSide, layerTree)
+
+      val squares = CollisionTree.toTriangles
+        ( windowWidth
+        , windowHeight
+        , grid
+        , maxSide
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+      val drawMsg =
+        DRAW_SQUARES_AND_DOTS {squares = squares, dots = Vector.fromList []}
+    in
+      (model, [DRAW drawMsg])
+    end
+
+  val blankPixel = {r = 0, g = 0, b = 0, a = 0}
+
+  fun makeBlankYAxis length =
+    Vector.tabulate (length, fn _ => blankPixel)
+
+  fun makeBlankXAxis length =
+    Vector.tabulate (length, fn _ => makeBlankYAxis length)
+
+  fun finishMove (model: app_type, newGrid) =
+    let
+      val {layer, layerTree, arrowX, arrowY, ...} = model
+      val layerTree = LayerTree.insert (layer, newGrid, layerTree)
+      val model = AppWith.layerTree (model, layerTree, arrowX, arrowY)
+    in
+      getDrawMsg model
+    end
+
+  fun moveImage (model: app_type, fMove) =
+    let
+      val {layer, layerTree, ...} = model
+    in
+      case LayerTree.get (layer, layerTree) of
+        SOME grid => finishMove (model, fMove grid)
+      | NONE => (model, [])
+    end
+
+  fun helpMoveImageUp grid =
+    Vector.mapi
+      (fn (_, yAxis) =>
+         Vector.mapi
+           (fn (yIdx, pixel) =>
+              if yIdx = Vector.length yAxis - 1 then blankPixel
+              else Vector.sub (yAxis, yIdx + 1)) yAxis) grid
+
+  fun moveImageUp (model: app_type) = moveImage (model, helpMoveImageUp)
+
+  fun helpMoveImageDown grid =
+    Vector.mapi
+      (fn (_, yAxis) =>
+         Vector.mapi
+           (fn (yIdx, pixel) =>
+              if yIdx = 0 then blankPixel else Vector.sub (yAxis, yIdx - 1))
+           yAxis) grid
+
+  fun moveImageDown (model: app_type) = moveImage (model, helpMoveImageDown)
+
+  fun helpMoveImageLeft grid =
+    Vector.mapi
+      (fn (idx, yAxis) =>
+         if idx + 1 = Vector.length grid then
+           makeBlankYAxis (Vector.length grid)
+         else
+           Vector.sub (grid, idx + 1)) grid
+
+  fun moveImageLeft (model: app_type) = moveImage (model, helpMoveImageLeft)
+
+  fun helpMoveImageRight grid =
+    Vector.mapi
+      (fn (idx, yAxis) =>
+         if idx = 0 then makeBlankYAxis (Vector.length grid)
+         else Vector.sub (grid, idx - 1)) grid
+
+  fun moveImageRight (model: app_type) = moveImage (model, helpMoveImageRight)
+
+  fun enterNormalMode model =
+    let val model = AppWith.mode (model, AppType.NORMAL_MODE)
+    in (model, [])
+    end
+
+  fun update (model, inputMsg) =
+    case inputMsg of
+      ARROW_UP => moveImageUp model
+    | ARROW_DOWN => moveImageDown model
+    | ARROW_LEFT => moveImageLeft model
+    | ARROW_RIGHT => moveImageRight model
+    | KEY_ESC => enterNormalMode model
+    | RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
+    | _ => (model, [])
+end

dotscape/fcore/ndc.sml

@@ -0,0 +1,38 @@
+structure Ndc = 
+struct
+  (* ndc = normalised device coordinates *)
+
+  fun ltrbToVertex (left, top, right, bottom) =
+    #[ left, bottom
+     , right, bottom
+     , left, top
+
+     , left, top
+     , right, bottom
+     , right, top
+     ]
+
+  fun ltrbToVertexRgb (startX, startY, endX, endY, r, g, b) =
+    #[ startX, endY, r, g, b
+     , endX, endY, r, g, b
+     , startX, startY, r, g, b
+
+     , startX, startY, r, g, b
+     , endX, endY, r, g, b
+     , endX, startY, r, g, b
+     ]
+
+  fun fromPixelX (xpos, windowWidth, windowHeight) =
+    let
+      val halfWidth = Real32.fromInt windowWidth / 2.0
+    in
+      (xpos - halfWidth) / halfWidth
+    end
+
+  fun fromPixelY (ypos, windowWidth, windowHeight) =
+    let
+      val halfHeight = Real32.fromInt windowHeight / 2.0
+    in
+      ~((ypos - halfHeight) / halfHeight)
+    end
+end

dotscape/fcore/normal-mode.sml

@@ -0,0 +1,404 @@
+structure NormalMode =
+struct
+  open AppType
+
+  open DrawMessage
+  open FileMessage
+  open InputMessage
+  open UpdateMessage
+
+  fun getDotVecFromIndices (model: app_type, hIdx, vIdx) =
+    let
+      val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = model
+      val xpos = Vector.sub (xClickPoints, hIdx)
+      val ypos = Vector.sub (yClickPoints, vIdx)
+
+      val endXpos =
+        if hIdx + 1 = Vector.length xClickPoints then xpos
+        else Vector.sub (xClickPoints, hIdx + 1)
+
+      val endYpos =
+        if vIdx + 1 = Vector.length yClickPoints then ypos
+        else Vector.sub (yClickPoints, vIdx + 1)
+
+      val tl = ClickPoints.getDrawDotRgb
+        (xpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
+      val tr = ClickPoints.getDrawDotRgb
+        (endXpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
+      val bl = ClickPoints.getDrawDotRgb
+        (xpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
+      val br = ClickPoints.getDrawDotRgb
+        (endXpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
+    in
+      Vector.concat [tl, tr, bl, br]
+    end
+
+  fun mouseMoveOrRelease (model: app_type) =
+    let
+      val drawVec =
+        case ClickPoints.getClickPositionFromMouse model of
+          SOME (hIdx, vIdx) => getDotVecFromIndices (model, hIdx, vIdx)
+        | NONE => Vector.fromList []
+
+      val drawMsg = DRAW_DOT drawVec
+      val drawMsg = [DRAW drawMsg]
+    in
+      (model, drawMsg)
+    end
+
+  fun getDrawDotMsgWhenArrowIsAtBoundary model =
+    let
+      val {arrowX, arrowY, ...} = model
+      val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
+      val drawMsg = DRAW_DOT dotVec
+      val drawMsg = [DRAW drawMsg]
+    in
+      (model, drawMsg)
+    end
+
+  fun moveArrowUp (model: app_type) =
+    let
+      val {arrowX, arrowY, ...} = model
+    in
+      if arrowY > 0 then
+        let
+          val newArrowY = arrowY - 1
+          val model = AppWith.arrowY (model, newArrowY)
+
+          val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun moveArrowLeft (model: app_type) =
+    let
+      val {arrowX, arrowY, ...} = model
+    in
+      if arrowX > 0 then
+        let
+          val newArrowX = arrowX - 1
+          val model = AppWith.arrowX (model, newArrowX)
+
+          val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun moveArrowRight (model: app_type) =
+    let
+      val {arrowX, arrowY, xClickPoints, ...} = model
+    in
+      if arrowX < Vector.length xClickPoints - 2 then
+        let
+          val newArrowX = arrowX + 1
+          val model = AppWith.arrowX (model, newArrowX)
+
+          val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun moveArrowDown (model: app_type) =
+    let
+      val {arrowX, arrowY, yClickPoints, ...} = model
+    in
+      if arrowY < Vector.length yClickPoints - 2 then
+        let
+          val newArrowY = arrowY + 1
+          val model = AppWith.arrowY (model, newArrowY)
+
+          val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
+          val drawMsg = DRAW_DOT dotVec
+          val drawMsg = [DRAW drawMsg]
+        in
+          (model, drawMsg)
+        end
+      else
+        getDrawDotMsgWhenArrowIsAtBoundary model
+    end
+
+  fun realToInt x = Real32.toInt IEEEReal.TO_NEAREST x
+
+  fun getDrawMessage (model: app_type, initialMsg) =
+    let
+      val
+        { canvasWidth
+        , canvasHeight
+        , layerTree
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+        , arrowX
+        , arrowY
+        , ...
+        } = model
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+      val squares = LayerTree.flatten (maxSide, layerTree)
+
+      val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
+
+      val squares = CollisionTree.toTriangles
+        ( windowWidth
+        , windowHeight
+        , squares
+        , maxSide
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+      val drawMsg = DRAW_SQUARES_AND_DOTS {squares = squares, dots = dotVec}
+      val drawMsg = DRAW (drawMsg) :: initialMsg
+    in
+      (model, drawMsg)
+    end
+
+  fun changePixel (model: app_type, hIdx, vIdx, pixel) =
+    let
+      val {canvasWidth, canvasHeight, layer, layerTree, ...} = model
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+
+      val layerTree = LayerTree.addPixel
+        (layer, hIdx, vIdx, maxSide, pixel, layerTree)
+      val model = AppWith.layerTree (model, layerTree, hIdx, vIdx)
+    in
+      getDrawMessage (model, [])
+    end
+
+  fun addPixel (model: app_type, hIdx, vIdx) =
+    let
+      val {r, g, b, a, ...} = model
+      val pixel = {r = r, g = g, b = b, a = a}
+    in
+      changePixel (model, hIdx, vIdx, pixel)
+    end
+
+  fun deletePixel (model, hIdx, vIdx) =
+    changePixel (model, hIdx, vIdx, Grid.emptyPixel)
+
+  fun mouseLeftClick model =
+    case ClickPoints.getClickPositionFromMouse model of
+      SOME (hIdx, vIdx) => addPixel (model, hIdx, vIdx)
+    | NONE => (model, [])
+
+  fun enterOrSpaceCoordinates model =
+    let val {arrowX, arrowY, ...} = model
+    in addPixel (model, arrowX, arrowY)
+    end
+
+  fun backspace model =
+    let val {arrowX, arrowY, ...} = model
+    in deletePixel (model, arrowX, arrowY)
+    end
+
+  fun resizeWindow (model, width, height) =
+    let
+      val model = AppWith.windowResize (model, width, height)
+      val {arrowX, arrowY, ...} = model
+      val dots = getDotVecFromIndices (model, arrowX, arrowY)
+    in
+      CommonUpdate.resizeWindow (model, width, height, dots)
+    end
+
+  fun undoAction model = (model, [])
+
+  fun redoAction model = (model, [])
+
+  fun toggleGraph (model: app_type) =
+    if #showGraph model then
+      let
+        val model = AppWith.graphVisibility (model, false)
+        val drawMsg = DRAW_GRAPH (Vector.fromList [])
+        val drawMsg = [DRAW drawMsg]
+      in
+        (model, drawMsg)
+      end
+    else
+      let
+        val model = AppWith.graphVisibility (model, true)
+        val graphLines = GraphLines.generate model
+        val drawMsg = DRAW_GRAPH graphLines
+        val drawMsg = [DRAW drawMsg]
+      in
+        (model, drawMsg)
+      end
+
+  fun updateNum (model: app_type, newNum) =
+    (AppWith.modalNum (model, newNum), [])
+
+  fun clearNum model = updateNum (model, 0)
+
+  fun updateRed model = (AppWith.r model, [])
+  fun updateGreen model = (AppWith.g model, [])
+  fun updateBlue model = (AppWith.b model, [])
+  fun updateAlpha model = (AppWith.a model, [])
+  fun changeLayer model = (AppWith.layer model, [])
+
+  fun selectCursorColour (model: app_type) =
+    let
+      val {layer, layerTree, arrowX, arrowY, ...} = model
+    in
+      case LayerTree.get (layer, layerTree) of
+        SOME grid =>
+          let
+            val yAxis = Vector.sub (grid, arrowX)
+            val {r, g, b, a} = Vector.sub (yAxis, arrowY)
+            val model = AppWith.cursorColour (model, r, g, b, a)
+          in
+            (model, [])
+          end
+      | NONE => (model, [])
+    end
+
+  fun updateCanvas (model, canvasWidth, canvasHeight) =
+    let
+      val
+        { arrowX
+        , arrowY
+        , windowWidth
+        , windowHeight
+        , xClickPoints
+        , yClickPoints
+        , showGraph
+        , layerTree
+        , ...
+        } = model
+
+      val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
+      val graphLines =
+        if showGraph then GraphLines.generate model else Vector.fromList []
+
+      val maxSide = Int.max (canvasWidth, canvasHeight)
+      val squares = LayerTree.flatten (maxSide, layerTree)
+
+      val squares = CollisionTree.toTriangles
+        ( windowWidth
+        , windowHeight
+        , squares
+        , maxSide
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+
+      val msg =
+        RESIZE_SQUARES_DOTS_AND_GRAPH
+          {squares = squares, dots = dotVec, graphLines = graphLines}
+    in
+      (model, [DRAW msg])
+    end
+
+  fun updateCanvasWidth model =
+    let
+      val {modalNum, layerTree, canvasHeight, ...} = model
+      val newCanvasWidth = modalNum
+
+      val maxSide = Int.max (newCanvasWidth, canvasHeight)
+      val layerTree = LayerTree.changeGridSize (maxSide, layerTree)
+
+      val model = AppWith.canvasWidth (model, newCanvasWidth, layerTree)
+      val {canvasWidth, canvasHeight, ...} = model
+    in
+      updateCanvas (model, canvasWidth, canvasHeight)
+    end
+
+  fun updateCanvasHeight model =
+    let
+      val {modalNum, layerTree, canvasWidth, ...} = model
+      val newCanvasHeight = modalNum
+
+      val maxSide = Int.max (newCanvasHeight, canvasWidth)
+      val layerTree = LayerTree.changeGridSize (maxSide, layerTree)
+
+      val model = AppWith.canvasHeight (model, newCanvasHeight, layerTree)
+      val {canvasWidth, canvasHeight, ...} = model
+    in
+      updateCanvas (model, canvasWidth, canvasHeight)
+    end
+
+  fun useLayers (model, layerTree, canvasWidth, canvasHeight) =
+    let
+      val model =
+        AppWith.parsedLayerTree (model, layerTree, canvasWidth, canvasHeight)
+
+      val graphLines =
+        if #showGraph model then GraphLines.generate model
+        else Vector.fromList []
+      val initialMsg = DRAW_GRAPH graphLines
+      val initialMsg = [DRAW initialMsg]
+    in
+      getDrawMessage (model, initialMsg)
+    end
+
+  fun enterMoveMode model =
+    let val model = AppWith.mode (model, AppType.MOVE_MODE)
+    in (model, [])
+    end
+
+  fun flipHorizontally (model: app_type) =
+    let
+      val {layerTree, arrowX, arrowY, ...} = model
+      val layerTree = LayerTree.flipHorizontally layerTree
+      val model = AppWith.layerTree (model, layerTree, arrowX, arrowY)
+    in
+      getDrawMessage (model, [])
+    end
+
+  fun update (model: app_type, inputMsg) =
+    case inputMsg of
+      MOUSE_MOVE {x = mouseX, y = mouseY} =>
+        let val model = AppWith.mousePosition (model, mouseX, mouseY)
+        in mouseMoveOrRelease model
+        end
+    | MOUSE_LEFT_RELEASE => mouseMoveOrRelease model
+    | MOUSE_LEFT_CLICK => mouseLeftClick model
+    | NUM num => updateNum (model, num)
+    | KEY_ESC => clearNum model
+    | KEY_R => updateRed model
+    | KEY_G => updateGreen model
+    | KEY_B => updateBlue model
+    | KEY_A => updateAlpha model
+    | KEY_L => changeLayer model
+    | KEY_C => selectCursorColour model
+    | KEY_W => updateCanvasWidth model
+    | KEY_H => updateCanvasHeight model
+    | KEY_M => enterMoveMode model
+    | KEY_F => flipHorizontally model
+    | RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
+    | UNDO_ACTION => undoAction model
+    | REDO_ACTION => redoAction model
+    | KEY_T => toggleGraph model
+    | KEY_CTRL_S => CommonUpdate.getSaveSquaresMsg model
+    | KEY_CTRL_L => CommonUpdate.getLoadSquaresMsg model
+    | KEY_CTRL_E => CommonUpdate.getExportSquaresMsg model
+    | KEY_CTRL_C => CommonUpdate.getCollisionMsg model
+    | USE_LAYERS {tree, canvasWidth, canvasHeight} =>
+        useLayers (model, tree, canvasWidth, canvasHeight)
+    | SQUARES_LOAD_ERROR => CommonUpdate.squaresLoadError model
+    | ARROW_UP => moveArrowUp model
+    | ARROW_LEFT => moveArrowLeft model
+    | ARROW_RIGHT => moveArrowRight model
+    | ARROW_DOWN => moveArrowDown model
+    | KEY_BACKSPACE => backspace model
+    | KEY_ENTER => enterOrSpaceCoordinates model
+    | KEY_SPACE => enterOrSpaceCoordinates model
+end

dotscape/fcore/parser/all-dfa.sml

@@ -0,0 +1,44 @@
+structure AllDfa =
+struct
+  type t =
+    { curInt: int
+    , curSpace: int
+    , curBrace: int
+    , lastInt: int
+    , lastSpace: int
+    , lastBrace: int
+    }
+
+  val initial: t =
+    { curInt = IntDfa.start
+    , curSpace = SpaceDfa.start
+    , curBrace = BraceDfa.start
+    , lastInt = ~1
+    , lastSpace = ~1
+    , lastBrace = ~1
+    }
+
+  fun areAllDead ({curInt, curSpace, curBrace, ...}: t) =
+    curInt = 0 andalso curSpace = 0 andalso curBrace = 0
+
+  fun update (chr, dfa, pos) =
+    let
+      val {curInt, curSpace, curBrace, lastInt, lastBrace, lastSpace} = dfa
+
+      val curInt = IntDfa.next (curInt, chr)
+      val curSpace = SpaceDfa.next (curSpace, chr)
+      val curBrace = BraceDfa.next (curBrace, chr)
+
+      val lastInt = if IntDfa.isFinal curInt then pos else lastInt
+      val lastSpace = if SpaceDfa.isFinal curSpace then pos else lastSpace
+      val lastBrace = if BraceDfa.isFinal curBrace then pos else lastBrace
+    in
+      { curInt = curInt
+      , curSpace = curSpace
+      , curBrace = curBrace
+      , lastInt = lastInt
+      , lastBrace = lastBrace
+      , lastSpace = lastSpace
+      }
+    end
+end

dotscape/fcore/parser/brace-dfa.sml

@@ -0,0 +1,32 @@
+structure BraceDfa =
+struct
+  val dead = 0
+  val start = 1
+  val final = 2
+
+  fun makeStart i =
+    let
+      val chr = Char.chr i
+    in
+      if chr = #"{" orelse chr = #"}" orelse chr = #"[" orelse chr = #"]" then
+        final
+      else
+        dead
+    end
+
+  val deadTable = SpaceDfa.deadTable
+  val startTable = Vector.tabulate (255, makeStart)
+  val finalTable = deadTable
+
+  val tables = #[deadTable, startTable, finalTable]
+
+  fun isFinal state = state = final
+
+  fun next (state, chr) =
+    let
+      val table = Vector.sub (tables, state)
+      val idx = Char.ord chr
+    in
+      Vector.sub (table, idx)
+    end
+end

dotscape/fcore/parser/int-dfa.sml

@@ -0,0 +1,27 @@
+structure IntDfa =
+struct
+  val dead = 0
+  val start = 1
+  val final = 2
+
+  fun makeStart i =
+    let val chr = Char.chr i
+    in if Char.isDigit chr then final else dead
+    end
+
+  val deadTable = Vector.tabulate (255, fn _ => dead)
+  val startTable = Vector.tabulate (255, makeStart)
+  val finalTable = startTable
+
+  val tables = #[deadTable, startTable, finalTable]
+
+  fun isFinal state = state = final
+
+  fun next (state, chr) =
+    let
+      val table = Vector.sub (tables, state)
+      val idx = Char.ord chr
+    in
+      Vector.sub (table, idx)
+    end
+end

dotscape/fcore/parser/lexer.sml

@@ -0,0 +1,59 @@
+structure Lexer =
+struct
+  structure T = Tokens
+
+  fun validMin (a, b) =
+    if a = ~1 then b else if b = ~1 then a else Int.min (a, b)
+
+  fun addToken (acc, dfa: AllDfa.t, str, finish) =
+    let
+      val {lastInt, lastSpace, lastBrace, ...} = dfa
+      val min = validMin (lastInt, lastSpace)
+      val min = validMin (min, lastBrace)
+    in
+      if min = ~1 then
+        NONE
+      else if min = lastSpace then
+        SOME (lastSpace, acc)
+      else
+        let
+          val str = String.substring (str, min, finish - min + 1)
+        in
+          if min = lastInt then
+            case Int.fromString str of
+              SOME int => SOME (lastInt, T.INT int :: acc)
+            | NONE => NONE
+          else if min = lastBrace then
+            if str = "{" then SOME (lastBrace, T.L_BRACE :: acc)
+            else if str = "}" then SOME (lastBrace, T.R_BRACE :: acc)
+            else if str = "[" then SOME (lastBrace, T.L_BRACKET :: acc)
+            else if str = "]" then SOME (lastBrace, T.R_BRACKET :: acc)
+            else NONE
+          else
+            NONE
+        end
+    end
+
+  fun scanStep (pos, str, acc, dfa, finish) =
+    if pos < 0 orelse AllDfa.areAllDead dfa then
+      addToken (acc, dfa, str, finish)
+    else
+      let
+        val chr = String.sub (str, pos)
+        val dfa = AllDfa.update (chr, dfa, pos)
+      in
+        if AllDfa.areAllDead dfa then addToken (acc, dfa, str, finish)
+        else scanStep (pos - 1, str, acc, dfa, finish)
+      end
+
+  fun scanLoop (pos, str, acc) =
+    if pos < 0 then
+      SOME acc
+    else
+      case scanStep (pos, str, acc, AllDfa.initial, pos) of
+        SOME (pos, acc) => scanLoop (pos - 1, str, acc)
+      | NONE => NONE
+
+  fun scan str =
+    scanLoop (String.size str - 1, str, [])
+end

dotscape/fcore/parser/parse-grid.sml

@@ -0,0 +1,36 @@
+structure ParseGrid =
+struct
+  fun make (canvasWidth, canvasHeight) =
+    let
+      val maxPoints = Int.max (canvasWidth, canvasHeight)
+      val emptyYAxis = Vector.tabulate (maxPoints, fn _ =>
+        {r = 0, g = 0, b = 0, a = 0})
+    in
+      Vector.tabulate (maxPoints, fn _ => emptyYAxis)
+    end
+
+  local
+    fun loopY (yAxis, x, ex, y, ey, colour) =
+      if y > ey orelse y >= Vector.length yAxis then
+        yAxis
+      else
+        let val yAxis = Vector.update (yAxis, y, colour)
+        in loopY (yAxis, x, ex, y + 1, ey, colour)
+        end
+
+    fun loopX (grid, x, ex, y, ey, colour) =
+      if x > ex orelse x >= Vector.length grid then
+        grid
+      else
+        let
+          val yAxis = Vector.sub (grid, x)
+          val yAxis = loopY (yAxis, x, ex, y, ey, colour)
+          val grid = Vector.update (grid, x, yAxis)
+        in
+          loopX (grid, x + 1, ex, y, ey, colour)
+        end
+  in
+    fun applyItem (grid, x, y, ex, ey, colour) =
+      loopX (grid, x, ex, y, ey, colour)
+  end
+end

dotscape/fcore/parser/parser.md

@@ -0,0 +1,21 @@
+# Parsing
+
+The parsing functionality is for saving and loading from a custom file format.
+
+The BNF for the custom file format is below.
+
+Terminals are surrounded by `**` to the left and right. (rule)+ means "1 or more".
+
+```
+int ::= (0-9)+
+
+item ::= **{** int int int int int int int int **}**
+
+layer ::= **[** item **]**
+
+layer_tree ::= int int **{** (layer)* **}**
+```
+
+The first two `int`s in the `layer_tree` always follow the order: `canvasWidth canvasHeight`.
+
+The large number of `int`s in the `item` always follow the order: `x y ex ey r g b a`.

dotscape/fcore/parser/parser.sml

@@ -0,0 +1,82 @@
+structure Parser =
+struct
+  structure T = Tokens
+
+  fun parseItem (tokens, grid) =
+    case tokens of
+      T.L_BRACE ::
+        T.INT x ::
+          T.INT y ::
+            T.INT ex ::
+              T.INT ey ::
+                T.INT r :: T.INT g :: T.INT b :: T.INT a :: T.R_BRACE :: tl =>
+        let
+          val colour = {r = r, g = g, b = b, a = a}
+          val grid = ParseGrid.applyItem (grid, x, y, ex, ey, colour)
+        in
+          SOME (tl, grid)
+        end
+    | _ => NONE
+
+  (* note to be careful of:
+   * - startParseItems returns NONE if there are no items found,
+   * because we have not found a single item yet. 
+   *
+   * - loopParseItems returns SOME if there are no items found,
+   * because this function is called after we have parsed at least one item.
+   * *)
+  fun loopParseItems (tokens, grid) =
+    case parseItem (tokens, grid) of
+      SOME (tokens, grid) => loopParseItems (tokens, grid)
+    | NONE => SOME (tokens, grid)
+
+  fun startParseItems (tokens, grid) =
+    case parseItem (tokens, grid) of
+      SOME (tokens, grid) => loopParseItems (tokens, grid)
+    | NONE => NONE
+
+  fun parseLayer (tokens, canvasWidth, canvasHeight, tree, counter) =
+    case tokens of
+      T.L_BRACKET :: tl =>
+        let
+          val grid = ParseGrid.make (canvasWidth, canvasHeight)
+        in
+          case startParseItems (tl, grid) of
+            SOME (T.R_BRACKET :: tl, grid) =>
+              let val tree = LayerTree.insert (counter, grid, tree)
+              in SOME (tl, tree)
+              end
+          | SOME _ => NONE
+          | NONE => NONE
+        end
+    | _ => NONE
+
+  fun parseLayerLoop (tokens, canvasWidth, canvasHeight, tree, counter) =
+    case parseLayer (tokens, canvasWidth, canvasHeight, tree, counter) of
+      SOME (tl, tree) =>
+        parseLayerLoop (tl, canvasWidth, canvasHeight, tree, counter + 1)
+    | NONE => SOME (tokens, tree)
+
+  fun startParseLayer (tokens, canvasWidth, canvasHeight, tree) =
+    case parseLayer (tokens, canvasWidth, canvasHeight, tree, 1) of
+      SOME (tl, tree) => parseLayerLoop (tl, canvasWidth, canvasHeight, tree, 2)
+    | NONE => NONE
+
+  fun parse string =
+    case Lexer.scan string of
+      SOME tokens =>
+        (case tokens of
+           T.INT canvasWidth :: T.INT canvasHeight :: T.L_BRACE :: tl =>
+             let
+               val maxSide = Int.max (canvasWidth, canvasHeight)
+               val tree = LayerTree.init maxSide
+             in
+               case startParseLayer (tl, canvasWidth, canvasHeight, tree) of
+                 SOME ([T.R_BRACE], tree) =>
+                   SOME (canvasWidth, canvasHeight, tree)
+               | SOME _ => NONE
+               | NONE => NONE
+             end
+         | _ => NONE)
+    | NONE => NONE
+end

dotscape/fcore/parser/space-dfa.sml

@@ -0,0 +1,29 @@
+structure SpaceDfa =
+struct
+  val dead = 0
+  val start = 1
+  val final = 2
+
+  fun makeDead _ = 0
+
+  fun makeStart i =
+    let val chr = Char.chr i
+    in if Char.isSpace chr then final else dead
+    end
+
+  val deadTable = Vector.tabulate (255, makeDead)
+  val startTable = Vector.tabulate (255, makeStart)
+  val finalTable = startTable
+
+  val tables = #[deadTable, startTable, finalTable]
+
+  fun isFinal state = state = final
+
+  fun next (state, chr) =
+    let
+      val table = Vector.sub (tables, state)
+      val idx = Char.ord chr
+    in
+      Vector.sub (table, idx)
+    end
+end

dotscape/fcore/parser/tokens.sml

@@ -0,0 +1,2 @@
+structure Tokens =
+struct datatype t = L_BRACE | R_BRACE | L_BRACKET | R_BRACKET | INT of int end

dotscape/fcore/quad-tree.sml

@@ -0,0 +1,678 @@
+structure CollisionTree =
+struct
+  structure BinTree =
+  struct
+    datatype 'a bintree =
+      NODE of
+        { x: int
+        , y: int
+        , ex: int
+        , ey: int
+        , data: 'a
+        , left: 'a bintree
+        , right: 'a bintree
+        }
+    | LEAF
+
+    val empty = LEAF
+
+    fun insert (newItem as {x, y, ex, ey, data}, tree) =
+      case tree of
+        LEAF =>
+          NODE
+            { x = x
+            , y = y
+            , ex = ex
+            , ey = ey
+            , data = data
+            , left = LEAF
+            , right = LEAF
+            }
+      | NODE {x = ox, y = oy, ex = oex, ey = oey, data = oldData, left, right} =>
+          let
+            val dir =
+              if x < ox then
+                LESS
+              else if x > ox then
+                GREATER
+              else
+                (if y < oy then
+                   LESS
+                 else if y > oy then
+                   GREATER
+                 else
+                   (if ex < oex then
+                      LESS
+                    else if ex > oex then
+                      GREATER
+                    else
+                      (if ey < oey then LESS
+                       else if ey > oey then GREATER
+                       else EQUAL)))
+          in
+            case dir of
+              LESS =>
+                NODE
+                  { left = insert (newItem, left)
+                  , right = right
+                  , x = ox
+                  , y = oy
+                  , ex = oex
+                  , ey = oey
+                  , data = oldData
+                  }
+            | GREATER =>
+                NODE
+                  { right = insert (newItem, right)
+                  , left = left
+                  , x = ox
+                  , y = oy
+                  , ex = oex
+                  , ey = oey
+                  , data = oldData
+                  }
+            | EQUAL =>
+                NODE
+                  { left = left
+                  , right = right
+                  , x = x
+                  , y = y
+                  , ex = ex
+                  , ey = ey
+                  , data = data
+                  }
+          end
+
+    fun foldr (f, tree, acc) =
+      case tree of
+        NODE {x, y, ex, ey, data, left, right} =>
+          let
+            val acc = foldr (f, right, acc)
+            val item = {x = x, y = y, ex = ex, ey = ey, data = data}
+            val acc = f (item, acc)
+          in
+            foldr (f, left, acc)
+          end
+      | LEAF => acc
+
+    fun toList tree =
+      foldr (fn (item, acc) => item :: acc, tree, [])
+  end
+
+  fun shouldIgnoreData {a, r = _, g = _, b = _} = a = 0
+
+  local
+    fun loopYAxis (x, y, eX, eY, yAxis, col) =
+      if y > eY orelse y >= Vector.length yAxis then
+        true
+      else
+        let
+          val newCol = Vector.sub (yAxis, y)
+        in
+          if col = newCol then loopYAxis (x, y + 1, eX, eY, yAxis, col)
+          else false
+        end
+
+    fun loopColour (x, y, eX, eY, grid, col) =
+      if x > eX orelse x >= Vector.length grid then
+        true
+      else
+        let
+          val yAxis = Vector.sub (grid, x)
+        in
+          if loopYAxis (x, y, eX, eY, yAxis, col) then
+            loopColour (x + 1, y, eX, eY, grid, col)
+          else
+            false
+        end
+  in
+    fun quadHasSameColour (startX, startY, endX, endY, grid) =
+      let
+        val yAxis = Vector.sub (grid, startX)
+        val col = Vector.sub (yAxis, startY)
+      in
+        loopColour (startX, startY, endX, endY, grid, col)
+      end
+  end
+
+  (* tree creation *)
+  fun build (x, y, size, grid, bintree) =
+    if x >= Vector.length grid orelse y >= Vector.length grid then
+      bintree
+    else if quadHasSameColour (x, y, x + size, y + size, grid) then
+      let
+        val yAxis = Vector.sub (grid, x)
+        val data = Vector.sub (yAxis, y)
+      in
+        if shouldIgnoreData data then
+          bintree
+        else
+          let
+            val ex = x + size
+            val ey = y + size
+            val ex = Int.min (ex, Vector.length grid - 1)
+            val ey = Int.min (ey, Vector.length grid - 1)
+            val item = {x = x, y = y, ex = ex, ey = ey, data = data}
+          in
+            BinTree.insert (item, bintree)
+          end
+      end
+    else
+      (if size mod 2 = 0 orelse size = 1 then
+         let
+           val halfSize = size div 2
+           val bintree = build (x, y, halfSize, grid, bintree)
+           val bintree = build (x + halfSize, y, halfSize, grid, bintree)
+           val bintree = build (x, y + halfSize, halfSize, grid, bintree)
+         in
+           build (x + halfSize, y + halfSize, halfSize, grid, bintree)
+         end
+       else
+         (* handles odd-number divisions.
+          * For example, `7 div 2` is 3 because of integer division. 
+          * We would not cover every pixel unless we handle odd numbers specially. *)
+         let
+           val halfSizeBefore = size div 2
+           val halfSizeAfter = (size + 1) div 2
+           val bintree = build (x, y, halfSizeAfter, grid, bintree)
+           val bintree = build
+             (x + halfSizeBefore, y, halfSizeAfter, grid, bintree)
+           val bintree = build
+             (x, y + halfSizeBefore, halfSizeAfter, grid, bintree)
+         in
+           build
+             ( x + halfSizeBefore
+             , y + halfSizeBefore
+             , halfSizeAfter
+             , grid
+             , bintree
+             )
+         end)
+
+  fun getClickPoint (clickPoints, pos) =
+    let val idx = Int.min (pos, Vector.length clickPoints - 1)
+    in Vector.sub (clickPoints, idx)
+    end
+
+  fun folder
+    ( windowWidth
+    , windowHeight
+    , canvasWidth
+    , canvasHeight
+    , xClickPoints
+    , yClickPoints
+    ) ({x, ex, y, ey, data}, acc) =
+    let
+      val ex = if ex = x then x + 1 else ex + 1
+      val ey = if ey = y then y + 1 else ey + 1
+
+      val x = getClickPoint (xClickPoints, x)
+      val y = getClickPoint (yClickPoints, y)
+      val ex = getClickPoint (xClickPoints, ex)
+      val ey = getClickPoint (yClickPoints, ey)
+
+      val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
+      val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
+      val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
+      val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
+
+      val {r, g, b, a} = data
+      val r = Real32.fromInt r / 255.0
+      val g = Real32.fromInt g / 255.0
+      val b = Real32.fromInt b / 255.0
+      val a = Real32.fromInt a / 255.0
+    in
+      Ndc.ltrbToVertexRgb (startX, startY, endX, endY, r, g, b) :: acc
+    end
+
+  fun toTriangles
+    ( windowWidth
+    , windowHeight
+    , squares
+    , size
+    , canvasWidth
+    , canvasHeight
+    , xClickPoints
+    , yClickPoints
+    ) =
+    let
+      val bintree = build (0, 0, size, squares, BinTree.empty)
+
+      val f = folder
+        ( windowWidth
+        , windowHeight
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+      val vec = BinTree.foldr (f, bintree, [])
+    in
+      Vector.concat vec
+    end
+
+  (* building and querying quad tree, plus compression *)
+  datatype quad_tree =
+    LEAF of {x: int, y: int, ex: int, ey: int, data: AppType.square}
+  | NODE of {tl: quad_tree, tr: quad_tree, bl: quad_tree, br: quad_tree}
+  | EMPTY
+
+  fun foldWithDuplicates (f, tree, acc) =
+    case tree of
+      EMPTY => acc
+    | LEAF item => f (item, acc)
+    | NODE {tl, tr, bl, br} =>
+        let
+          val acc = foldWithDuplicates (f, tl, acc)
+          val acc = foldWithDuplicates (f, tr, acc)
+          val acc = foldWithDuplicates (f, bl, acc)
+        in
+          foldWithDuplicates (f, br, acc)
+        end
+
+  fun toBintree qtree =
+    foldWithDuplicates (BinTree.insert, qtree, BinTree.empty)
+
+  fun buildTree (x, y, size, grid) =
+    if x >= Vector.length grid orelse y >= Vector.length grid then
+      EMPTY
+    else if quadHasSameColour (x, y, x + size, y + size, grid) then
+      let
+        val yAxis = Vector.sub (grid, x)
+        val data = Vector.sub (yAxis, y)
+      in
+        if shouldIgnoreData data then
+          EMPTY
+        else
+          let
+            val ex = x + size
+            val ex = Int.min (ex, Vector.length grid - 1)
+            val ey = y + size
+            val ey = Int.min (ey, Vector.length grid - 1)
+          in
+            LEAF {x = x, y = y, ex = ex, ey = ey, data = data}
+          end
+      end
+    else
+      (if size mod 2 = 0 orelse size = 1 then
+         let
+           val halfSize = size div 2
+           val tl = buildTree (x, y, halfSize, grid)
+           val tr = buildTree (x + halfSize, y, halfSize, grid)
+           val bl = buildTree (x, y + halfSize, halfSize, grid)
+           val br = buildTree (x + halfSize, y + halfSize, halfSize, grid)
+         in
+           NODE {tl = tl, tr = tr, bl = bl, br = br}
+         end
+       else
+         (* handles odd-number divisions.
+          * For example, `7 div 2` is 3 because of integer division. 
+          * We would not cover every pixel unless we handle odd numbers specially. *)
+         let
+           val halfSizeBefore = size div 2
+           val halfSizeAfter = (size + 1) div 2
+           val tl = buildTree (x, y, halfSizeAfter, grid)
+           val tr = buildTree (x + halfSizeBefore, y, halfSizeAfter, grid)
+           val bl = buildTree (x, y + halfSizeBefore, halfSizeAfter, grid)
+           val br =
+             buildTree
+               (x + halfSizeBefore, y + halfSizeBefore, halfSizeAfter, grid)
+         in
+           NODE {tl = tl, tr = tr, bl = bl, br = br}
+         end)
+
+  local
+    fun loop (x, y, ex, ey, grid) =
+      if x < 0 then
+        0
+      else if quadHasSameColour (x, y, ex, ey, grid) then
+        loop (x - 1, y, x, ey, grid)
+      else
+        ex
+  in
+    fun getLeftmostX ({x, y, ex, ey, data}, grid) =
+      loop (x - 1, y, x, ey, grid)
+  end
+
+  local
+    fun loop (x, y, ex, ey, grid) =
+      if x < Vector.length grid andalso ex < Vector.length grid then
+        if quadHasSameColour (x, y, ex, ey, grid) then
+          loop (ex, y, ex + 1, ey, grid)
+        else
+          x
+      else
+        Vector.length grid - 1
+  in
+    fun getRightmostX ({x, y, ex, ey, data}, grid) =
+      loop (ex, y, ex + 1, ey, grid)
+  end
+
+  local
+    fun loop (x, y, ex, ey, grid) =
+      if y < 0 then
+        0
+      else if quadHasSameColour (x, y, ex, ey, grid) then
+        loop (x, y - 1, ex, y, grid)
+      else
+        ey
+  in
+    fun getTopmostY ({x, y, ex, ey, data}, grid) =
+      if y < 0 orelse ey <= 0 then
+        0
+      else if quadHasSameColour (x, y, ex, ey, grid) then
+        loop (x, y - 1, ex, y, grid)
+      else
+        y
+  end
+
+  local
+    fun loop (x, y, ex, ey, grid) =
+      if y < Vector.length grid andalso ey < Vector.length grid then
+        if quadHasSameColour (x, y, ex, ey, grid) then
+          loop (x, ey, ex, ey + 1, grid)
+        else
+          y
+      else
+        Vector.length grid
+  in
+    fun getBottomY ({x, y, ex, ey, data}, grid) =
+      if quadHasSameColour (x, y, ex, ey, grid) then loop (x, y, ex, ey, grid)
+      else y
+  end
+
+  local
+    fun loop (tree, grid) =
+      case tree of
+        EMPTY => (EMPTY, false)
+      | LEAF (oldItem as {x, y, ex, ey, data}) =>
+          let
+            val topY = getTopmostY (oldItem, grid)
+            val bottomY = getBottomY (oldItem, grid)
+            val newItem = {y = topY, ey = bottomY, x = x, ex = ex, data = data}
+            val didItemChange = newItem <> oldItem
+          in
+            (LEAF newItem, didItemChange)
+          end
+      | NODE {tl, tr, bl, br} =>
+          let
+            val (tl, didTlChange) = loop (tl, grid)
+            val (tr, didTrChange) = loop (tr, grid)
+            val (bl, didBlChange) = loop (bl, grid)
+            val (br, didBrChange) = loop (br, grid)
+
+            val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
+            val didChange =
+              didTlChange orelse didTrChange orelse didBlChange
+              orelse didBrChange
+          in
+            (node, false)
+          end
+  in
+    fun mergeVertical (tree, grid) =
+      let val (newTree, didChange) = loop (tree, grid)
+      in if didChange then mergeVertical (newTree, grid) else newTree
+      end
+  end
+
+  local
+    fun loop (tree, grid) =
+      case tree of
+        EMPTY => (EMPTY, false)
+      | LEAF (oldItem as {x, y, ex, ey, data}) =>
+          let
+            val leftX = getLeftmostX (oldItem, grid)
+            val rightX = getRightmostX (oldItem, grid)
+            val newItem = {x = leftX, ex = rightX, y = y, ey = ey, data = data}
+            val didItemChange = newItem <> oldItem
+          in
+            (LEAF newItem, didItemChange)
+          end
+      | NODE {tl, tr, bl, br} =>
+          let
+            val (tl, didTlChange) = loop (tl, grid)
+            val (tr, didTrChange) = loop (tr, grid)
+            val (bl, didBlChange) = loop (bl, grid)
+            val (br, didBrChange) = loop (br, grid)
+
+            val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
+            val didChange =
+              didTlChange orelse didTrChange orelse didBlChange
+              orelse didBrChange
+          in
+            (node, didChange)
+          end
+  in
+    fun mergeHorizontal (tree, grid) =
+      let val (newTree, didChange) = loop (tree, grid)
+      in if didChange then mergeHorizontal (newTree, grid) else newTree
+      end
+  end
+
+  fun merge (tree, grid) =
+    let
+      val tree = mergeVertical (tree, grid)
+      val tree = mergeHorizontal (tree, grid)
+    in
+      toBintree tree
+    end
+
+  fun toSaveStringFolder ({x, ex, y, ey, data = {r, g, b, a}}, acc) =
+    let
+      val item = String.concat
+        [ " { "
+        , Int.toString x
+        , " "
+        , Int.toString y
+        , " "
+        , Int.toString ex
+        , " "
+        , Int.toString ey
+        , " "
+        , Int.toString r
+        , " "
+        , Int.toString g
+        , " "
+        , Int.toString b
+        , " "
+        , Int.toString a
+        , " } "
+        ]
+    in
+      item :: acc
+    end
+
+  fun toSaveStringTreeFolder size (grid, acc) =
+    let
+      val qtree = buildTree (0, 0, size, grid)
+      val bintree = merge (qtree, grid)
+      val coords = BinTree.foldr (toSaveStringFolder, bintree, [])
+      val coords = String.concat coords
+      val str = "\n  [ " ^ coords ^ " ]"
+    in
+      str :: acc
+    end
+
+  fun toSaveString (layerTree, canvasWidth, canvasHeight) =
+    let
+      val size = Int.max (canvasWidth, canvasHeight)
+      val f = toSaveStringTreeFolder size
+
+      val initial = ["\n}\n"]
+      val acc = LayerTree.foldr (f, layerTree, initial)
+      val acc =
+        String.concat
+          [Int.toString canvasWidth, " ", Int.toString canvasHeight, " { "]
+        :: acc
+    in
+      String.concat acc
+    end
+
+  fun intToRealString num =
+    let
+      val result = Real.fromInt num
+      val result = Real.fmt (StringCvt.FIX (SOME 15)) result
+    in
+      if String.isSubstring "." result then result else result ^ ".0"
+    end
+
+  fun colToRealString col =
+    let
+      val result = Real.fromInt col / 255.0
+      val result = Real.fmt (StringCvt.FIX (SOME 15)) result
+    in
+      if String.isSubstring "." result then result else result ^ ".0"
+    end
+
+  fun makeXString x =
+    let val x = intToRealString x
+    in "xToNdc (xOffset, " ^ x ^ ", scale, halfWidth)"
+    end
+
+  fun makeYString y =
+    let val y = intToRealString y
+    in "yToNdc (yOffset, " ^ y ^ ", scale, halfHeight)"
+    end
+
+  fun toExportStringFolder (maxWidth, maxHeight)
+    ({x, ex, y, ey, data = {r, g, b, a}}, acc) =
+    let
+      val ex = if ex < maxWidth then ex + 1 else ex
+      val ey = if ey < maxHeight then ey + 1 else ey
+
+      val x = makeXString x
+      val y = makeYString y
+      val ex = makeXString ex
+      val ey = makeYString ey
+      val r = colToRealString r
+      val g = colToRealString g
+      val b = colToRealString b
+
+      (* based on triangle order formed by `Ndc.ltrbToVertexRgb` function *)
+      val item = String.concatWith ",\n"
+        [ x
+        , ey
+        , r
+        , g
+        , b
+        , ex
+        , ey
+        , r
+        , g
+        , b
+        , x
+        , y
+        , r
+        , g
+        , b
+        , x
+        , y
+        , r
+        , g
+        , b
+        , ex
+        , ey
+        , r
+        , g
+        , b
+        , ex
+        , y
+        , r
+        , g
+        , b
+        ]
+    in
+      item :: acc
+    end
+
+  fun toExportString (squares, canvasWidth, canvasHeight, filepath) =
+    let
+      val size = Int.max (canvasWidth, canvasHeight)
+      val qtree = buildTree (0, 0, size, squares)
+      val bintree = merge (qtree, squares)
+
+      val f = toExportStringFolder (canvasWidth, canvasHeight)
+      val coords = BinTree.foldr (f, bintree, [])
+      val coords = String.concatWith ",\n" coords
+
+      val structureName = FileString.filenameToStructureName filepath
+      val structureStart = String.concat ["structure ", structureName, " = struct\n"]
+    in
+      String.concat
+        [ structureStart
+        , "  fun xToNdc (xOffset, xpos, scale, halfWidth) =\n"
+        , "    ((xpos * scale + xOffset) - halfWidth) / halfWidth\n\n"
+
+        , "  fun yToNdc (yOffset, ypos, scale, halfHeight) =\n"
+        , "   ~(((ypos * scale + yOffset) - halfHeight) / halfHeight)\n\n"
+
+        , "  fun lerp (xOffset, yOffset, scale, windowWidth, windowHeight) =\n"
+        , "    let\n"
+        , "      val windowWidth = Real32.fromInt windowWidth\n"
+        , "      val halfWidth = windowWidth / 2.0\n"
+        , "      val windowHeight = Real32.fromInt windowHeight\n"
+        , "      val halfHeight = windowHeight / 2.0\n"
+        , "    in\n"
+        , "     #[\n"
+        , coords
+        , "\n"
+        , "      ]\n"
+        , "    end\n"
+        , "end\n"
+        ]
+    end
+
+  (* functions for exporting a collision detection string *)
+  fun mapItem (item as {r, g, b, a}) =
+    if shouldIgnoreData item then item else {r = 1, g = 1, b = 1, a = 1}
+
+  fun mapYAxis yAxis = Vector.map mapItem yAxis
+
+  fun mapGrid grid = Vector.map mapYAxis grid
+
+  fun toCollisionStringFolder (scale, maxWidth, maxHeight)
+    ({x, ex, y, ey, data = _}, acc) =
+    let
+      val ex = if ex < maxWidth then ex + 1 else ex
+      val ey = if ey < maxHeight then ey + 1 else ey
+
+      val width = ex - x
+      val width = if width = 0 then width + 1 else width
+      val height = ey - y
+      val height = if height = 0 then height + 1 else height
+
+      val x = Int.toString (x * scale)
+      val y = Int.toString (y * scale)
+      val width = Int.toString (width * scale)
+      val height = Int.toString (height * scale)
+
+      val item = String.concat
+        [ "{x = "
+        , x
+        , ", y = "
+        , y
+        , ", width = "
+        , width
+        , ", height = "
+        , height
+        , " }"
+        ]
+    in
+      item :: acc
+    end
+
+  fun toCollisionString (squares, canvasWidth, canvasHeight, scale) =
+    let
+      val squares = mapGrid squares
+      val scale = if scale = 0 then 1 else scale
+      val size = Int.max (canvasWidth, canvasHeight)
+      val qtree = buildTree (0, 0, size, squares)
+      val bintree = merge (qtree, squares)
+
+      val f = toCollisionStringFolder (scale, canvasWidth, canvasHeight)
+      val collisions = BinTree.foldr (f, bintree, [])
+      val collisions = String.concatWith ",\n" collisions
+    in
+      String.concat ["val collisions = #[", collisions, "]\n"]
+    end
+end

dotscape/ffi/export.h

@@ -0,0 +1,172 @@
+#ifndef __DSC_ML_H__
+#define __DSC_ML_H__
+
+/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a HPND-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_MLTYPES_H_
+#define _MLTON_MLTYPES_H_
+
+/* We need these because in header files for exported SML functions, 
+ * types.h is included without cenv.h.
+ */
+#if (defined (_AIX) || defined (__hpux__) || defined (__OpenBSD__))
+#include <inttypes.h>
+#elif (defined (__sun__))
+#include <sys/int_types.h>
+#else
+#include <stdint.h>
+#endif
+
+/* ML types */
+typedef unsigned char PointerAux __attribute__ ((may_alias));
+typedef PointerAux* Pointer;
+#define Array(t) Pointer
+#define Ref(t) Pointer
+#define Vector(t) Pointer
+
+typedef int8_t Int8_t;
+typedef int8_t Int8;
+typedef int16_t Int16_t;
+typedef int16_t Int16;
+typedef int32_t Int32_t;
+typedef int32_t Int32;
+typedef int64_t Int64_t;
+typedef int64_t Int64;
+typedef float Real32_t;
+typedef float Real32;
+typedef double Real64_t;
+typedef double Real64;
+typedef uint8_t Word8_t;
+typedef uint8_t Word8;
+typedef uint16_t Word16_t;
+typedef uint16_t Word16;
+typedef uint32_t Word32_t;
+typedef uint32_t Word32;
+typedef uint64_t Word64_t;
+typedef uint64_t Word64;
+
+typedef Int8_t WordS8_t;
+typedef Int8_t WordS8;
+typedef Int16_t WordS16_t;
+typedef Int16_t WordS16;
+typedef Int32_t WordS32_t;
+typedef Int32_t WordS32;
+typedef Int64_t WordS64_t;
+typedef Int64_t WordS64;
+
+typedef Word8_t WordU8_t;
+typedef Word8_t WordU8;
+typedef Word16_t WordU16_t;
+typedef Word16_t WordU16;
+typedef Word32_t WordU32_t;
+typedef Word32_t WordU32;
+typedef Word64_t WordU64_t;
+typedef Word64_t WordU64;
+
+typedef WordU8_t Char8_t;
+typedef WordU8_t Char8;
+typedef WordU16_t Char16_t;
+typedef WordU16_t Char16;
+typedef WordU32_t Char32_t;
+typedef WordU32_t Char32;
+
+typedef Vector(Char8_t) String8_t;
+typedef Vector(Char8_t) String8;
+typedef Vector(Char16_t) String16_t;
+typedef Vector(Char16_t) String16;
+typedef Vector(Char32_t) String32_t;
+typedef Vector(Char32_t) String32;
+
+typedef Int32_t Bool_t;
+typedef Int32_t Bool;
+typedef String8_t NullString8_t;
+typedef String8_t NullString8;
+
+typedef void* CPointer;
+typedef Pointer Objptr;
+
+#endif /* _MLTON_MLTYPES_H_ */
+
+/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a HPND-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_EXPORT_H_
+#define _MLTON_EXPORT_H_
+
+/* ------------------------------------------------- */
+/*                      Symbols                      */
+/* ------------------------------------------------- */
+
+/* An external symbol is something not defined by the module
+ * (executable or library) being built. Rather, it is provided
+ * from a library dependency (dll, dylib, or shared object).
+ *
+ * A public symbol is defined in this module as being available
+ * to users outside of this module. If building a library, this 
+ * means the symbol will be part of the public interface.
+ * 
+ * A private symbol is defined within this module, but will not
+ * be made available outside of it. This is typically used for
+ * internal implementation details that should not be accessible.
+ */
+
+#if defined(_WIN32) || defined(_WIN64) || defined(__CYGWIN__)
+#define EXTERNAL __declspec(dllimport)
+#define PUBLIC   __declspec(dllexport)
+#define PRIVATE
+#else
+#define EXTERNAL __attribute__((visibility("default")))
+#define PUBLIC   __attribute__((visibility("default")))
+#define PRIVATE  __attribute__((visibility("hidden")))
+#endif
+
+#endif /* _MLTON_EXPORT_H_ */
+
+#if !defined(PART_OF_DSC) && \
+    !defined(STATIC_LINK_DSC) && \
+    !defined(DYNAMIC_LINK_DSC)
+#define PART_OF_DSC
+#endif
+
+#if defined(PART_OF_DSC)
+#define MLLIB_PRIVATE(x) PRIVATE x
+#define MLLIB_PUBLIC(x) PUBLIC x
+#elif defined(STATIC_LINK_DSC)
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x) PUBLIC x
+#elif defined(DYNAMIC_LINK_DSC)
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x) EXTERNAL x
+#else
+#error Must specify linkage for dsc
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x)
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+MLLIB_PUBLIC(void mltonMouseMoveCallback (Real32 x0, Real32 x1);)
+MLLIB_PUBLIC(void mltonMouseClickCallback (Int32 x0, Int32 x1);)
+MLLIB_PUBLIC(void mltonFramebufferSizeCallback (Int32 x0, Int32 x1);)
+MLLIB_PUBLIC(void mltonKeyCallback (Int32 x0, Int32 x1, Int32 x2, Int32 x3);)
+
+#undef MLLIB_PRIVATE
+#undef MLLIB_PUBLIC
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __DSC_ML_H__ */

dotscape/ffi/gles3-export.c

@@ -0,0 +1,99 @@
+#include "export.h"
+#include "glad.h"
+#include <GLFW/glfw3.h>
+#include <stdbool.h>
+
+// OpenGL constants used below
+unsigned int VERTEX_SHADER = GL_VERTEX_SHADER;
+unsigned int FRAGMENT_SHADER = GL_FRAGMENT_SHADER;
+unsigned int TRIANGLES = GL_TRIANGLES;
+unsigned int TRIANGLE_FAN = GL_TRIANGLE_FAN;
+unsigned int STATIC_DRAW = GL_STATIC_DRAW;
+unsigned int DYNAMIC_DRAW = GL_DYNAMIC_DRAW;
+
+// OpenGL functions used below
+void loadGlad() {
+  gladLoadGLLoader((GLADloadproc)glfwGetProcAddress);
+}
+
+void viewport(int width, int height) {
+  glViewport(0, 0, width, height);
+}
+
+void clearColor(float r, float g, float b, float a) {
+  glClearColor(r, g, b, a);
+}
+
+void clear() {
+  glClear(GL_COLOR_BUFFER_BIT);
+}
+
+unsigned int createBuffer() {
+  unsigned int buffer;
+  glGenBuffers(1, &buffer);
+  return buffer;
+}
+
+void bindBuffer(unsigned int buffer) {
+  glBindBuffer(GL_ARRAY_BUFFER, buffer);
+}
+
+void bufferData(float* vector, int vectorLength, unsigned int updateMode) {
+  glBufferData(GL_ARRAY_BUFFER, sizeof(float) * vectorLength, vector, updateMode);
+}
+
+unsigned int createShader(unsigned int shaderType) {
+  return glCreateShader(shaderType);
+}
+
+void shaderSource(unsigned int shader, const char *sourceString) {
+  glShaderSource(shader, 1, &sourceString, NULL);
+}
+
+void compileShader(unsigned int shader) {
+  glCompileShader(shader);
+}
+
+void deleteShader(unsigned int shader) {
+  glDeleteShader(shader);
+}
+
+void vertexAttribPointer(int location, int numVecComponents, int stride, int offset) {
+  glVertexAttribPointer(location, numVecComponents, GL_FLOAT, GL_FALSE, stride * sizeof(float), (void*)offset);
+}
+
+void enableVertexAttribArray(int location) {
+  glEnableVertexAttribArray(location);
+}
+
+unsigned int createProgram() {
+  return glCreateProgram();
+}
+
+void attachShader(unsigned int program, unsigned int shader) {
+  glAttachShader(program, shader);
+}
+
+void linkProgram(unsigned int program) {
+  glLinkProgram(program);
+}
+
+void useProgram(unsigned int program) {
+  glUseProgram(program);
+}
+
+void deleteProgram(unsigned int program) {
+  glDeleteProgram(program);
+}
+
+void drawArrays(unsigned int drawMode, int startIndex, int numVertices) {
+  glDrawArrays(drawMode, startIndex, numVertices);
+}
+
+int getUniformLocation(unsigned int program, const char *uniformName) {
+  glGetUniformLocation(program, uniformName);
+}
+
+void uniform4f(int uniformLocation, float a, float b, float c, float d) {
+  glUniform4f(uniformLocation, a, b, c, d);
+}

dotscape/ffi/gles3-import.sml

@@ -0,0 +1,58 @@
+structure Gles3 =
+struct
+  type buffer = Word32.word
+  type shader_type = Word32.word
+  type shader = Word32.word
+  type program = Word32.word
+  type draw_mode = Word32.word
+  type update_mode = Word32.word
+
+  (* OpenGL constants used. *)
+  val (VERTEX_SHADER, _) =
+    _symbol "VERTEX_SHADER" public : ( unit -> shader_type ) * ( shader_type -> unit );
+  val (FRAGMENT_SHADER, _) =
+    _symbol "FRAGMENT_SHADER" public : ( unit -> shader_type ) * ( shader_type -> unit );
+  val (TRIANGLES, _) =
+    _symbol "TRIANGLES" public : ( unit -> draw_mode ) * ( draw_mode -> unit );
+  val (TRIANGLE_FAN, _) =
+    _symbol "TRIANGLE_FAN" public : ( unit -> draw_mode ) * ( draw_mode -> unit );
+  val (STATIC_DRAW, _) =
+    _symbol "STATIC_DRAW" public : ( unit -> update_mode ) * ( update_mode -> unit );
+  val (DYNAMIC_DRAW, _) =
+    _symbol "DYNAMIC_DRAW" public : ( unit -> update_mode ) * ( update_mode -> unit );
+
+  (* OpenGL functions used. *)
+  val loadGlad = _import "loadGlad" public : unit -> unit;
+  val viewport = _import "viewport" public : int * int -> unit;
+
+  val createBuffer = _import "createBuffer" public : unit -> buffer;
+  val bindBuffer = _import "bindBuffer" public : buffer -> unit;
+  val bufferData =
+    _import "bufferData" public : Real32.real vector * int * update_mode -> unit;
+
+  val createShader = _import "createShader" public : shader_type -> shader;
+  val compileShader = _import "compileShader" public : shader -> unit;
+  val deleteShader = _import "deleteShader" public : shader -> unit;
+  val shaderSource = _import "shaderSource" public : shader * string -> unit;
+
+  val vertexAttribPointer =
+    _import "vertexAttribPointer" public : int * int * int * int -> unit;
+  val enableVertexAttribArray =
+    _import "enableVertexAttribArray" public : int -> unit;
+
+  val createProgram = _import "createProgram" public : unit -> program;
+  val attachShader = _import "attachShader" public : program * shader -> unit;
+  val linkProgram = _import "linkProgram" public : program -> unit;
+  val useProgram = _import "useProgram" public : program -> unit;
+  val deleteProgram = _import "deleteProgram" public : program -> unit;
+
+  val clearColor =
+    _import "clearColor" public : Real32.real * Real32.real * Real32.real * Real32.real -> unit;
+  val clear = _import "clear" public : unit -> unit;
+  val drawArrays = _import "drawArrays" public : draw_mode * int * int -> unit;
+
+  val getUniformLocation =
+    _import "getUniformLocation" public : program * string -> int;
+  val uniform4f =
+    _import "uniform4f" public : int * Real32.real * Real32.real * Real32.real * Real32.real -> unit;
+end

dotscape/ffi/glfw-export.c

@@ -0,0 +1,43 @@
+#include <stdbool.h>
+#define GLFW_INCLUDE_NONE
+#include <GLFW/glfw3.h>
+
+// GLFW constants used below
+int CONTEXT_VERSION_MAJOR = GLFW_CONTEXT_VERSION_MAJOR;
+int DEPRECATED = GLFW_DECORATED;
+int GLFW_FFI_FALSE = GLFW_FALSE;
+int SAMPLES = GLFW_SAMPLES;
+
+// GLFW functions used below
+void init() {
+  glfwInit();
+}
+
+void windowHint(int hint, int value) {
+  glfwWindowHint(hint, value);
+}
+
+GLFWwindow* createWindow(int width, int height, const char *title) {
+  return glfwCreateWindow(width, height, title, NULL, NULL);
+}
+
+void terminate() {
+  glfwTerminate();
+}
+
+void makeContextCurrent(GLFWwindow* window) {
+  glfwMakeContextCurrent(window);
+}
+
+bool windowShouldClose(GLFWwindow *window) {
+  glfwWindowShouldClose(window);
+}
+
+void pollEvents() {
+  glfwPollEvents();
+}
+
+void swapBuffers(GLFWwindow *window) {
+  glfwSwapBuffers(window);
+}
+

dotscape/ffi/glfw-import.sml

@@ -0,0 +1,25 @@
+structure Glfw =
+struct
+  type window = MLton.Pointer.t
+
+  (* Window hint constants. *)
+  val (CONTEXT_VERSION_MAJOR, _) =
+    _symbol "CONTEXT_VERSION_MAJOR" public : ( unit -> int ) * ( int -> unit );
+  val (DEPRECATED, _) =
+    _symbol "DEPRECATED" public : ( unit -> int ) * ( int -> unit );
+  val (FALSE, _) =
+    _symbol "GLFW_FFI_FALSE" public : ( unit -> int ) * ( int -> unit );
+  val (SAMPLES, _) =
+    _symbol "SAMPLES" public : ( unit -> int ) * ( int -> unit );
+
+  (* GLFW functions. *)
+  val init = _import "init" public : unit -> unit;
+  val windowHint = _import "windowHint" public : int * int -> unit;
+  val createWindow =
+    _import "createWindow" public : int * int * string -> window;
+  val terminate = _import "terminate" public : unit -> unit;
+  val makeContextCurrent = _import "makeContextCurrent" public : window -> unit;
+  val windowShouldClose = _import "windowShouldClose" public : window -> bool;
+  val pollEvents = _import "pollEvents" public reentrant : unit -> unit;
+  val swapBuffers = _import "swapBuffers" public : window -> unit;
+end

dotscape/ffi/glfw-input.c

@@ -0,0 +1,78 @@
+#include "export.h"
+#define GLFW_INCLUDE_NONE
+#include <GLFW/glfw3.h>
+
+int PRESS = GLFW_PRESS;
+int RELEASE = GLFW_RELEASE;
+int LEFT_MOUSE_BUTTON = GLFW_MOUSE_BUTTON_1;
+
+int KEY_R = GLFW_KEY_R;
+int KEY_G = GLFW_KEY_G;
+int KEY_B = GLFW_KEY_B;
+
+int KEY_T = GLFW_KEY_T;
+int KEY_Y = GLFW_KEY_Y;
+int KEY_Z = GLFW_KEY_Z;
+
+int KEY_S = GLFW_KEY_S;
+int KEY_E = GLFW_KEY_E;
+int KEY_I = GLFW_KEY_I;
+int KEY_L = GLFW_KEY_L;
+int KEY_O = GLFW_KEY_O;
+int KEY_A = GLFW_KEY_A;
+int KEY_W = GLFW_KEY_W;
+int KEY_H = GLFW_KEY_H;
+int KEY_C = GLFW_KEY_C;
+int KEY_M = GLFW_KEY_M;
+int KEY_F = GLFW_KEY_F;
+
+int KEY_ENTER = GLFW_KEY_ENTER;
+int KEY_SPACE = GLFW_KEY_SPACE;
+int KEY_UP = GLFW_KEY_UP;
+int KEY_LEFT = GLFW_KEY_LEFT;
+int KEY_RIGHT = GLFW_KEY_RIGHT;
+int KEY_DOWN = GLFW_KEY_DOWN;
+int KEY_BACKSPACE = GLFW_KEY_BACKSPACE;
+int KEY_ESC = GLFW_KEY_ESCAPE;
+
+int KEY_0 = GLFW_KEY_0;
+int KEY_1 = GLFW_KEY_1;
+int KEY_2 = GLFW_KEY_2;
+int KEY_3 = GLFW_KEY_3;
+int KEY_4 = GLFW_KEY_4;
+int KEY_5 = GLFW_KEY_5;
+int KEY_6 = GLFW_KEY_6;
+int KEY_7 = GLFW_KEY_7;
+int KEY_8 = GLFW_KEY_8;
+int KEY_9 = GLFW_KEY_9;
+
+// Calls function exported from SML 
+void mouseMoveCallback(GLFWwindow *window, double xpos, double ypos) {
+  mltonMouseMoveCallback((float)xpos, (float)ypos);
+}
+
+// Call this from MLton to register callback with GLFW.
+void setMouseMoveCallback(GLFWwindow *window) {
+  glfwSetCursorPosCallback(window, mouseMoveCallback);
+}
+
+void mouseClickCallback(GLFWwindow *window, int button, int action, int mods) {
+  mltonMouseClickCallback(button, action);
+}
+void setMouseClickCallback(GLFWwindow *window) {
+  glfwSetMouseButtonCallback(window, mouseClickCallback);
+}
+
+void framebufferSizeCallback(GLFWwindow *window, int width, int height) {
+  mltonFramebufferSizeCallback(width, height);
+}
+void setFramebufferSizeCallback(GLFWwindow *window, int width, int height) {
+  glfwSetFramebufferSizeCallback(window, framebufferSizeCallback);
+}
+
+void keyCallback(GLFWwindow *window, int key, int scancode, int action, int mods) {
+  mltonKeyCallback(key, scancode, action, mods);
+}
+void setKeyCallback(GLFWwindow *window) {
+  glfwSetKeyCallback(window, keyCallback);
+}

dotscape/ffi/glfw-input.sml

@@ -0,0 +1,108 @@
+structure Input =
+struct
+  type window = MLton.Pointer.t
+
+  (* Export function to C. *)
+  val exportMouseMoveCallback =
+    _export "mltonMouseMoveCallback" public : (Real32.real * Real32.real -> unit) -> unit;
+
+  (* Import function to set callback for GLFW. *)
+  val setMouseMoveCallback = _import "setMouseMoveCallback" public reentrant : window -> unit;
+
+  val exportMouseClickCallback =
+    _export "mltonMouseClickCallback" public : (int * int -> unit) -> unit;
+  val setMouseClickCallback = _import "setMouseClickCallback" public reentrant : window -> unit;
+
+  val exportFramebufferSizeCallback =
+    _export "mltonFramebufferSizeCallback" public : (int * int -> unit) -> unit;
+  val setFramebufferSizeCallback = 
+    _import "setFramebufferSizeCallback" public reentrant : window -> unit;
+
+  (* Constants for mouse input. *)
+  val (PRESS, _) =
+    _symbol "PRESS" public : ( unit -> int ) * ( int -> unit );
+  val (RELEASE, _) =
+    _symbol "RELEASE" public : ( unit -> int ) * ( int -> unit );
+  val (LEFT_MOUSE_BUTTON, _) =
+    _symbol "LEFT_MOUSE_BUTTON" public : ( unit -> int ) * ( int -> unit );
+
+  (* Key input *)
+  val exportKeyCallback =
+    _export "mltonKeyCallback" public : (int * int * int * int -> unit) -> unit;
+  val setKeyCallback = _import "setKeyCallback" public reentrant : window -> unit;
+
+  val (KEY_R, _) =
+    _symbol "KEY_R" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_G, _) =
+    _symbol "KEY_G" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_B, _) =
+    _symbol "KEY_B" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_C, _) =
+    _symbol "KEY_C" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_M, _) =
+    _symbol "KEY_M" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_F, _) =
+    _symbol "KEY_F" public : ( unit -> int ) * ( int -> unit );
+
+  val (KEY_T, _) =
+    _symbol "KEY_T" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_Y, _) =
+    _symbol "KEY_Y" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_Z, _) =
+    _symbol "KEY_Z" public : ( unit -> int ) * ( int -> unit );
+
+  val (KEY_S, _) =
+    _symbol "KEY_S" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_E, _) =
+    _symbol "KEY_E" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_I, _) =
+    _symbol "KEY_I" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_L, _) =
+    _symbol "KEY_L" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_O, _) =
+    _symbol "KEY_O" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_A, _) =
+    _symbol "KEY_A" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_W, _) =
+    _symbol "KEY_W" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_H, _) =
+    _symbol "KEY_H" public : ( unit -> int ) * ( int -> unit );
+
+  val (KEY_ENTER, _) =
+    _symbol "KEY_ENTER" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_SPACE, _) =
+    _symbol "KEY_SPACE" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_UP, _) =
+    _symbol "KEY_UP" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_LEFT, _) =
+    _symbol "KEY_LEFT" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_RIGHT, _) =
+    _symbol "KEY_RIGHT" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_DOWN, _) =
+    _symbol "KEY_DOWN" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_BACKSPACE, _) =
+    _symbol "KEY_BACKSPACE" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_ESC, _) =
+    _symbol "KEY_ESC" public : ( unit -> int ) * ( int -> unit );
+
+  val (KEY_0, _) =
+    _symbol "KEY_0" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_1, _) =
+    _symbol "KEY_1" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_2, _) =
+    _symbol "KEY_2" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_3, _) =
+    _symbol "KEY_3" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_4, _) =
+    _symbol "KEY_4" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_5, _) =
+    _symbol "KEY_5" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_6, _) =
+    _symbol "KEY_6" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_7, _) =
+    _symbol "KEY_7" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_8, _) =
+    _symbol "KEY_8" public : ( unit -> int ) * ( int -> unit );
+  val (KEY_9, _) =
+    _symbol "KEY_9" public : ( unit -> int ) * ( int -> unit );
+end

dotscape/ffi/khrplatform.h

@@ -0,0 +1,282 @@
+#ifndef __khrplatform_h_
+#define __khrplatform_h_
+
+/*
+** Copyright (c) 2008-2018 The Khronos Group Inc.
+**
+** Permission is hereby granted, free of charge, to any person obtaining a
+** copy of this software and/or associated documentation files (the
+** "Materials"), to deal in the Materials without restriction, including
+** without limitation the rights to use, copy, modify, merge, publish,
+** distribute, sublicense, and/or sell copies of the Materials, and to
+** permit persons to whom the Materials are furnished to do so, subject to
+** the following conditions:
+**
+** The above copyright notice and this permission notice shall be included
+** in all copies or substantial portions of the Materials.
+**
+** THE MATERIALS ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+** IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+** CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+** TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+** MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
+*/
+
+/* Khronos platform-specific types and definitions.
+ *
+ * The master copy of khrplatform.h is maintained in the Khronos EGL
+ * Registry repository at https://github.com/KhronosGroup/EGL-Registry
+ * The last semantic modification to khrplatform.h was at commit ID:
+ *      67a3e0864c2d75ea5287b9f3d2eb74a745936692
+ *
+ * Adopters may modify this file to suit their platform. Adopters are
+ * encouraged to submit platform specific modifications to the Khronos
+ * group so that they can be included in future versions of this file.
+ * Please submit changes by filing pull requests or issues on
+ * the EGL Registry repository linked above.
+ *
+ *
+ * See the Implementer's Guidelines for information about where this file
+ * should be located on your system and for more details of its use:
+ *    http://www.khronos.org/registry/implementers_guide.pdf
+ *
+ * This file should be included as
+ *        #include <KHR/khrplatform.h>
+ * by Khronos client API header files that use its types and defines.
+ *
+ * The types in khrplatform.h should only be used to define API-specific types.
+ *
+ * Types defined in khrplatform.h:
+ *    khronos_int8_t              signed   8  bit
+ *    khronos_uint8_t             unsigned 8  bit
+ *    khronos_int16_t             signed   16 bit
+ *    khronos_uint16_t            unsigned 16 bit
+ *    khronos_int32_t             signed   32 bit
+ *    khronos_uint32_t            unsigned 32 bit
+ *    khronos_int64_t             signed   64 bit
+ *    khronos_uint64_t            unsigned 64 bit
+ *    khronos_intptr_t            signed   same number of bits as a pointer
+ *    khronos_uintptr_t           unsigned same number of bits as a pointer
+ *    khronos_ssize_t             signed   size
+ *    khronos_usize_t             unsigned size
+ *    khronos_float_t             signed   32 bit floating point
+ *    khronos_time_ns_t           unsigned 64 bit time in nanoseconds
+ *    khronos_utime_nanoseconds_t unsigned time interval or absolute time in
+ *                                         nanoseconds
+ *    khronos_stime_nanoseconds_t signed time interval in nanoseconds
+ *    khronos_boolean_enum_t      enumerated boolean type. This should
+ *      only be used as a base type when a client API's boolean type is
+ *      an enum. Client APIs which use an integer or other type for
+ *      booleans cannot use this as the base type for their boolean.
+ *
+ * Tokens defined in khrplatform.h:
+ *
+ *    KHRONOS_FALSE, KHRONOS_TRUE Enumerated boolean false/true values.
+ *
+ *    KHRONOS_SUPPORT_INT64 is 1 if 64 bit integers are supported; otherwise 0.
+ *    KHRONOS_SUPPORT_FLOAT is 1 if floats are supported; otherwise 0.
+ *
+ * Calling convention macros defined in this file:
+ *    KHRONOS_APICALL
+ *    KHRONOS_APIENTRY
+ *    KHRONOS_APIATTRIBUTES
+ *
+ * These may be used in function prototypes as:
+ *
+ *      KHRONOS_APICALL void KHRONOS_APIENTRY funcname(
+ *                                  int arg1,
+ *                                  int arg2) KHRONOS_APIATTRIBUTES;
+ */
+
+/*-------------------------------------------------------------------------
+ * Definition of KHRONOS_APICALL
+ *-------------------------------------------------------------------------
+ * This precedes the return type of the function in the function prototype.
+ */
+#if defined(_WIN32) && !defined(__SCITECH_SNAP__)
+#   define KHRONOS_APICALL __declspec(dllimport)
+#elif defined (__SYMBIAN32__)
+#   define KHRONOS_APICALL IMPORT_C
+#elif defined(__ANDROID__)
+#   define KHRONOS_APICALL __attribute__((visibility("default")))
+#else
+#   define KHRONOS_APICALL
+#endif
+
+/*-------------------------------------------------------------------------
+ * Definition of KHRONOS_APIENTRY
+ *-------------------------------------------------------------------------
+ * This follows the return type of the function  and precedes the function
+ * name in the function prototype.
+ */
+#if defined(_WIN32) && !defined(_WIN32_WCE) && !defined(__SCITECH_SNAP__)
+    /* Win32 but not WinCE */
+#   define KHRONOS_APIENTRY __stdcall
+#else
+#   define KHRONOS_APIENTRY
+#endif
+
+/*-------------------------------------------------------------------------
+ * Definition of KHRONOS_APIATTRIBUTES
+ *-------------------------------------------------------------------------
+ * This follows the closing parenthesis of the function prototype arguments.
+ */
+#if defined (__ARMCC_2__)
+#define KHRONOS_APIATTRIBUTES __softfp
+#else
+#define KHRONOS_APIATTRIBUTES
+#endif
+
+/*-------------------------------------------------------------------------
+ * basic type definitions
+ *-----------------------------------------------------------------------*/
+#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || defined(__GNUC__) || defined(__SCO__) || defined(__USLC__)
+
+
+/*
+ * Using <stdint.h>
+ */
+#include <stdint.h>
+typedef int32_t                 khronos_int32_t;
+typedef uint32_t                khronos_uint32_t;
+typedef int64_t                 khronos_int64_t;
+typedef uint64_t                khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif defined(__VMS ) || defined(__sgi)
+
+/*
+ * Using <inttypes.h>
+ */
+#include <inttypes.h>
+typedef int32_t                 khronos_int32_t;
+typedef uint32_t                khronos_uint32_t;
+typedef int64_t                 khronos_int64_t;
+typedef uint64_t                khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif defined(_WIN32) && !defined(__SCITECH_SNAP__)
+
+/*
+ * Win32
+ */
+typedef __int32                 khronos_int32_t;
+typedef unsigned __int32        khronos_uint32_t;
+typedef __int64                 khronos_int64_t;
+typedef unsigned __int64        khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif defined(__sun__) || defined(__digital__)
+
+/*
+ * Sun or Digital
+ */
+typedef int                     khronos_int32_t;
+typedef unsigned int            khronos_uint32_t;
+#if defined(__arch64__) || defined(_LP64)
+typedef long int                khronos_int64_t;
+typedef unsigned long int       khronos_uint64_t;
+#else
+typedef long long int           khronos_int64_t;
+typedef unsigned long long int  khronos_uint64_t;
+#endif /* __arch64__ */
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif 0
+
+/*
+ * Hypothetical platform with no float or int64 support
+ */
+typedef int                     khronos_int32_t;
+typedef unsigned int            khronos_uint32_t;
+#define KHRONOS_SUPPORT_INT64   0
+#define KHRONOS_SUPPORT_FLOAT   0
+
+#else
+
+/*
+ * Generic fallback
+ */
+#include <stdint.h>
+typedef int32_t                 khronos_int32_t;
+typedef uint32_t                khronos_uint32_t;
+typedef int64_t                 khronos_int64_t;
+typedef uint64_t                khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#endif
+
+
+/*
+ * Types that are (so far) the same on all platforms
+ */
+typedef signed   char          khronos_int8_t;
+typedef unsigned char          khronos_uint8_t;
+typedef signed   short int     khronos_int16_t;
+typedef unsigned short int     khronos_uint16_t;
+
+/*
+ * Types that differ between LLP64 and LP64 architectures - in LLP64,
+ * pointers are 64 bits, but 'long' is still 32 bits. Win64 appears
+ * to be the only LLP64 architecture in current use.
+ */
+#ifdef _WIN64
+typedef signed   long long int khronos_intptr_t;
+typedef unsigned long long int khronos_uintptr_t;
+typedef signed   long long int khronos_ssize_t;
+typedef unsigned long long int khronos_usize_t;
+#else
+typedef signed   long  int     khronos_intptr_t;
+typedef unsigned long  int     khronos_uintptr_t;
+typedef signed   long  int     khronos_ssize_t;
+typedef unsigned long  int     khronos_usize_t;
+#endif
+
+#if KHRONOS_SUPPORT_FLOAT
+/*
+ * Float type
+ */
+typedef          float         khronos_float_t;
+#endif
+
+#if KHRONOS_SUPPORT_INT64
+/* Time types
+ *
+ * These types can be used to represent a time interval in nanoseconds or
+ * an absolute Unadjusted System Time.  Unadjusted System Time is the number
+ * of nanoseconds since some arbitrary system event (e.g. since the last
+ * time the system booted).  The Unadjusted System Time is an unsigned
+ * 64 bit value that wraps back to 0 every 584 years.  Time intervals
+ * may be either signed or unsigned.
+ */
+typedef khronos_uint64_t       khronos_utime_nanoseconds_t;
+typedef khronos_int64_t        khronos_stime_nanoseconds_t;
+#endif
+
+/*
+ * Dummy value used to pad enum types to 32 bits.
+ */
+#ifndef KHRONOS_MAX_ENUM
+#define KHRONOS_MAX_ENUM 0x7FFFFFFF
+#endif
+
+/*
+ * Enumerated boolean type
+ *
+ * Values other than zero should be considered to be true.  Therefore
+ * comparisons should not be made against KHRONOS_TRUE.
+ */
+typedef enum {
+    KHRONOS_FALSE = 0,
+    KHRONOS_TRUE  = 1,
+    KHRONOS_BOOLEAN_ENUM_FORCE_SIZE = KHRONOS_MAX_ENUM
+} khronos_boolean_enum_t;
+
+#endif /* __khrplatform_h_ */

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

dotscape/message-types/draw-msg.sml

@@ -0,0 +1,16 @@
+structure DrawMessage =
+struct
+  datatype t =
+    DRAW_DOT of Real32.real vector
+  | DRAW_SQUARES_AND_DOTS of
+      {squares: Real32.real vector, dots: Real32.real vector}
+  | DRAW_SQUARES_AND_RESET_DOTS of Real32.real vector
+  | DRAW_GRAPH of Real32.real vector
+  | RESIZE_SQUARES_DOTS_AND_GRAPH of
+      { squares: Real32.real vector
+      , graphLines: Real32.real vector
+      , dots: Real32.real vector
+      }
+  | CLEAR_DOTS
+  | DRAW_MODAL_TEXT of Real32.real vector
+end

dotscape/message-types/file-msg.sml

@@ -0,0 +1,8 @@
+structure FileMessage =
+struct
+  datatype t =
+    SAVE_SQUARES of {output: string, filepath: string}
+  | LOAD_SQUARES of {filepath: string}
+  | EXPORT_SQUARES of {output: string, filepath: string}
+  | EXPORT_COLLISIONS of {output: string, filepath: string}
+end

dotscape/message-types/input-msg.sml

@@ -0,0 +1,36 @@
+structure InputMessage =
+struct
+  datatype t =
+    MOUSE_MOVE of {x: Real32.real, y: Real32.real}
+  | MOUSE_LEFT_CLICK
+  | MOUSE_LEFT_RELEASE
+  | RESIZE_WINDOW of {width: int, height: int}
+  | UNDO_ACTION
+  | REDO_ACTION
+  | KEY_R
+  | KEY_G
+  | KEY_B
+  | KEY_T
+  | KEY_A
+  | KEY_W
+  | KEY_H
+  | KEY_M
+  | KEY_C
+  | KEY_L
+  | KEY_F
+  | KEY_BACKSPACE
+  | KEY_CTRL_S
+  | KEY_CTRL_L
+  | KEY_CTRL_E
+  | KEY_CTRL_C
+  | KEY_ESC
+  | NUM of int
+  | ARROW_UP
+  | ARROW_LEFT
+  | ARROW_RIGHT
+  | ARROW_DOWN
+  | KEY_ENTER
+  | KEY_SPACE
+  | USE_LAYERS of {tree: LayerTree.t, canvasWidth: int, canvasHeight: int}
+  | SQUARES_LOAD_ERROR
+end

dotscape/message-types/update-msg.sml

@@ -0,0 +1,2 @@
+structure UpdateMessage =
+struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t end