add function to quad tree to turn items into strings (for later saving to file)

fcore/parser/all-dfa.sml

@@ -0,0 +1,35 @@
+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

fcore/parser/brace-dfa.sml

@@ -0,0 +1,33 @@
+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 = #"}" 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

fcore/parser/int-dfa.sml

@@ -0,0 +1,32 @@
+structure IntDfa =
+struct
+  val dead = 0
+  val start = 1
+  val final = 2
+
+  fun makeStart i =
+    let
+      val chr = Char.chr i
+    in
+      if chr >= #"0" orelse chr < #"9" then
+        final
+      else dead
+    end
+
+  val deadTable = SpaceDfa.deadTable
+  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

fcore/parser/lexer.sml

@@ -0,0 +1,56 @@
+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)
+        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 NONE
+          else
+            NONE
+        end
+    end
+
+  fun scanStep (pos, str, acc, dfa, finish) =
+    if 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
+        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

fcore/parser/parse-grid.sml

@@ -0,0 +1,35 @@
+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 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 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

fcore/parser/parser.md

@@ -0,0 +1,19 @@
+# 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 o more".
+
+```
+int ::= (0-9)+
+
+item ::= **{** int int int int int int int int **}**
+
+grid ::= int int **{** (item)+ **}**
+```
+
+The first two `int`s in the grid `int int **{** (item)+ **}**` always follow the order: `canvasWidth canvasHeight`.
+
+The large number of `int`s in the `item` always follows the order: `x y ex ey r g b a`.

fcore/parser/parser.mlb

@@ -0,0 +1,16 @@
+$(SML_LIB)/basis/basis.mlb
+
+ann
+  "allowVectorExps true"
+in
+  space-dfa.sml
+  int-dfa.sml
+  brace-dfa.sml
+  all-dfa.sml
+end
+
+tokens.sml
+lexer.sml
+
+parse-grid.sml
+parser.sml

fcore/parser/parser.sml

@@ -0,0 +1,35 @@
+structure Parser =
+struct
+  structure T = Tokens
+
+  fun parseItems (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
+          parseItems (tl, grid)
+        end
+    | _ => SOME (tokens, grid)
+
+  fun parse tokens =
+    case tokens of
+      T.INT canvasWidth :: T.INT canvasHeight :: T.L_BRACE :: tl =>
+        let
+          val grid = ParseGrid.make (canvasWidth, canvasHeight)
+        in
+          case parseItems (tl, grid) of
+            SOME (tokens, grid) =>
+              (case tokens of
+                 [T.R_BRACE] => SOME grid
+               | _ => NONE)
+            | NONE => NONE
+        end
+    | _ => NONE
+end

fcore/parser/space-dfa.sml

@@ -0,0 +1,34 @@
+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

fcore/parser/tokens.sml

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