add [r, g, b] field to triangle, so we can draw coloured objects (next: add ability to change current colour)

functional-core/app/app-init.sml

@@ -38,6 +38,9 @@ struct
       , openFilePath = ""
       , fileBrowser = Vector.fromList []
       , fileBrowserIdx = 0
+      , r = 0.0
+      , g = 0.0
+      , b = 0.0
       }
     end
 

functional-core/app/app-type.sml

@@ -17,6 +17,9 @@ sig
     , y1: Real32.real
     , y2: Real32.real
     , y3: Real32.real
+    , r: Real32.real
+    , g: Real32.real
+    , b: Real32.real
     }
 
   type app_type =
@@ -38,6 +41,9 @@ sig
     , openFilePath: string
     , fileBrowser: file_browser_item vector
     , fileBrowserIdx: int
+    , r: Real32.real
+    , g: Real32.real
+    , b: Real32.real
     }
 end
 
@@ -49,11 +55,14 @@ struct
 
   type triangle =
     { x1: Real32.real
-    , y1: Real32.real
     , x2: Real32.real
-    , y2: Real32.real
     , x3: Real32.real
+    , y1: Real32.real
+    , y2: Real32.real
     , y3: Real32.real
+    , r: Real32.real
+    , g: Real32.real
+    , b: Real32.real
     }
 
   datatype triangle_stage =
@@ -89,5 +98,8 @@ struct
     , openFilePath: string
     , fileBrowser: file_browser_item vector
     , fileBrowserIdx: int
+    , r: Real32.real
+    , g: Real32.real
+    , b: Real32.real
     }
 end

functional-core/app/app-update.sml

@@ -246,7 +246,7 @@ struct
         end
     | NO_TRIANGLE =>
         (case #triangles model of
-           {x1, y1, x2, y2, x3, y3} :: trianglesTl =>
+           {x1, y1, x2, y2, x3, y3, r, g, b} :: trianglesTl =>
              (* Have to slice off (x3, y3) from triangle head,
               * turn (x1, y1, x2, y2) into a triangleStage,
               * and redraw both triangle and triangleStage. *)
@@ -309,9 +309,19 @@ struct
          | SECOND {x1, y1, x2, y2} =>
              (* clear triangle stage, add to trinagle list and redraw triangles *)
              let
+               val {r, g, b, ...} = model
                val newTriangleStage = NO_TRIANGLE
                val newTriangle =
-                 {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x, y3 = y}
+                 { x1 = x1
+                 , y1 = y1
+                 , x2 = x2
+                 , y2 = y2
+                 , x3 = x
+                 , y3 = y
+                 , r = r
+                 , g = g
+                 , b = b
+                 }
                val newTriangles = newTriangle :: (#triangles model)
                val model =
                  AppWith.redo (model, newTriangleStage, newTriangles, redoHd)

functional-core/app/app-with.sml

@@ -90,6 +90,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
 
       val newUndo = newUndoHd :: undo
@@ -112,6 +115,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -138,9 +144,22 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
 
-      val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
+      val newTriangle =
+        { x1 = x1
+        , y1 = y1
+        , x2 = x2
+        , y2 = y2
+        , x3 = x3
+        , y3 = y3
+        , r = r
+        , g = g
+        , b = b
+        }
       val newTriangles = newTriangle :: triangles
       val newUndo = newUndoHd :: undo
     in
@@ -162,6 +181,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -186,6 +208,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
     in
       { mode = mode
@@ -206,6 +231,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -230,6 +258,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
     in
       { mode = mode
@@ -250,6 +281,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -276,6 +310,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
 
       val xClickPoints = ClickPoints.generate (wStart, wFinish, numClickPoints)
@@ -299,6 +336,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -346,6 +386,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
     in
       { mode = mode
@@ -366,6 +409,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -391,6 +437,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
 
       val newUndo =
@@ -418,6 +467,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -443,6 +495,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
 
       val newUndo = newUndoHd :: undo
@@ -469,6 +524,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -493,6 +551,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
     in
       { mode = mode
@@ -513,6 +574,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -537,6 +601,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
     in
       { mode = newMode
@@ -557,6 +624,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -581,6 +651,9 @@ struct
         , openFilePath
         , fileBrowser
         , fileBrowserIdx
+        , r
+        , g
+        , b
         } = app
 
       val triangleStage = NO_TRIANGLE
@@ -603,6 +676,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = fileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -627,6 +703,9 @@ struct
         , openFilePath = _
         , fileBrowser = _
         , fileBrowserIdx = _
+        , r
+        , g
+        , b
         } = app
     in
       { mode = mode
@@ -647,6 +726,9 @@ struct
       , openFilePath = path
       , fileBrowser = fileBrowser
       , fileBrowserIdx = 0
+      , r = r
+      , g = g
+      , b = b
       }
     end
 
@@ -671,6 +753,9 @@ struct
         , openFilePath = openFilePath
         , fileBrowser = fileBrowser
         , fileBrowserIdx = _
+        , r
+        , g
+        , b
         } = app
     in
       { mode = mode
@@ -691,6 +776,9 @@ struct
       , openFilePath = openFilePath
       , fileBrowser = fileBrowser
       , fileBrowserIdx = newFileBrowserIdx
+      , r = r
+      , g = g
+      , b = b
       }
     end
 end

functional-core/app/triangles.sml

@@ -9,7 +9,7 @@ struct
 
   fun helpToVector (lst, acc, windowWidth, windowHeight, halfWidth, halfHeight) =
     case lst of
-      {x1, y1, x2, y2, x3, y3} :: tl =>
+      {x1, y1, x2, y2, x3, y3, r, g, b} :: tl =>
         let
           val x1 = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth)
           val x2 = Ndc.centreAlignX (x2, windowWidth, windowHeight, halfWidth)
@@ -22,10 +22,19 @@ struct
           val vec =
            #[ x1 / halfWidth
             , y1 / halfHeight
+            , r
+            , g
+            , b
             , x2 / halfWidth
             , y2 / halfHeight
+            , r
+            , g
+            , b
             , x3 / halfWidth
             , y3 / halfHeight
+            , r
+            , g
+            , b
             ]
           val acc = vec :: acc
         in

functional-core/file/parse-file.sml

@@ -7,16 +7,36 @@ structure ParseFile :> PARSE_FILE =
 struct
   datatype triangle_token = X | Y | COORD of Real32.real | UNKNOWN of string
 
+  val zero: Real32.real = 0.0
+
   fun extractTriangle lst =
     case lst of
-      [ X, COORD x1
+      [ X
-      , Y, COORD y1
+      , COORD x1
-      , X, COORD x2
+      , Y
+      , COORD y1
 
-      , Y, COORD y2
+      , X
-      , X, COORD x3
+      , COORD x2
-      , Y, COORD y3
+      , Y
-      ] => SOME {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
+      , COORD y2
+
+      , X
+      , COORD x3
+      , Y
+      , COORD y3
+      ] =>
+        SOME
+          { x1 = x1
+          , y1 = y1
+          , x2 = x2
+          , y2 = y2
+          , x3 = x3
+          , y3 = y3
+          , r = zero
+          , g = zero
+          , b = zero
+          }
     | _ => NONE
 
   fun tokeniseString str =
@@ -61,9 +81,7 @@ struct
       end
 
   fun parseLine line =
-    let
+    let val lst = helpParseLine (line, 0, [], 0)
-      val lst = helpParseLine (line, 0, [], 0)
+    in extractTriangle lst
-    in
-      extractTriangle lst
     end
 end

imperative-shell/app-draw.sml

@@ -111,41 +111,7 @@ struct
   val uploadModalText = uploadDotVector
   val drawModalText = drawDot
 
-  fun initTriangles () =
+  val initTriangles = initDot
-    let
+  val uploadTrianglesVector = uploadDotVector
-      val triangleDrawObject = initDrawObject
+  val drawTriangles = drawDot
-        (Constants.graphVertexShaderString, Constants.graphFragmentShaderString)
-      val {vertexBuffer, program} = triangleDrawObject
-
-      val _ = Gles3.bindBuffer vertexBuffer
-      val _ = Gles3.bufferData (#[], 0, Gles3.STATIC_DRAW ())
-      val _ = Gles3.vertexAttribPointer (0, 2, 2, 0)
-      val _ = Gles3.enableVertexAttribArray 0
-    in
-      triangleDrawObject
-    end
-
-  fun uploadTrianglesVector (triangleDrawObject: draw_object, vec) =
-    let
-      val {vertexBuffer, ...} = triangleDrawObject
-      val _ = Gles3.bindBuffer vertexBuffer
-      val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW ())
-    in
-      ()
-    end
-
-  fun drawTriangles (triangleDrawObject: draw_object, triangleDrawLength) =
-    if triangleDrawLength > 0 then
-      let
-        val {vertexBuffer, program} = triangleDrawObject
-        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, triangleDrawLength)
-      in
-        ()
-      end
-    else
-      ()
 end

imperative-shell/draw-thread.sml

@@ -70,7 +70,7 @@ struct
                  val _ =
                    AppDraw.uploadTrianglesVector
                      (triangleDrawObject, triangleVec)
-                 val triangleDrawLength = Vector.length triangleVec div 2
+                 val triangleDrawLength = Vector.length triangleVec div 5
                (* dots are reset by setting dotDrawLength to 0 *)
                in
                  run
@@ -91,7 +91,7 @@ struct
                  val _ =
                    AppDraw.uploadTrianglesVector
                      (triangleDrawObject, triangleVec)
-                 val triangleDrawLength = Vector.length triangleVec div 2
+                 val triangleDrawLength = Vector.length triangleVec div 5
 
                  val _ = AppDraw.uploadDotVector (dotDrawObject, dotsVec)
                  val dotDrawLength = Vector.length dotsVec div 5
@@ -130,7 +130,7 @@ struct
                let
                  val _ =
                    AppDraw.uploadTrianglesVector (triangleDrawObject, triangles)
-                 val triangleDrawLength = Vector.length triangles div 2
+                 val triangleDrawLength = Vector.length triangles div 5
 
                  val _ = AppDraw.uploadGraphLines (graphDrawObject, graphLines)
                  val drawGraphLength = Vector.length graphLines div 2

imperative-shell/file-thread.sml

@@ -10,9 +10,9 @@ struct
 
   datatype parse_result = OK of AppType.triangle list | PARSE_ERROR
 
-  val structureName = "UnknownChar"
+  val structureName = "Green"
-  val filename = "fonts/unknown-char.dsc"
+  val filename = "green.dsc"
-  val exportFilename = "fonts/unknown-char.sml"
+  val exportFilename = "green.sml"
 
   fun ndcToLerpX num =
     let
@@ -40,9 +40,14 @@ struct
       ^ ")) / windowHeight) - 1.0"
     end
 
+  fun colToString col =
+    let val col = Real32.toString col
+    in if String.isSubstring "." col then col else col ^ ".0"
+    end
+
   fun helpExportTriangles (io, triangles) =
     case triangles of
-      {x1, y1, x2, y2, x3, y3} :: tl =>
+      {x1, y1, x2, y2, x3, y3, r, g, b} :: tl =>
         let
           val x1 = ndcToLerpX x1
           val x2 = ndcToLerpX x2
@@ -52,6 +57,10 @@ struct
           val y2 = ndcToLerpY y2
           val y3 = ndcToLerpY y3
 
+          val r = colToString r
+          val g = colToString g
+          val b = colToString b
+
           val line = String.concat
             [ x1
             , ",\n"
@@ -64,9 +73,15 @@ struct
             , x3
             , ",\n"
             , y3
+            , ", \n"
+            , r
+            , ", "
+            , g
+            , ", "
+            , b
             , case tl of
-                [] => ", r, g, b\n"
+                [] => "\n"
-              | _ => ", r, g, b,\n"
+              | _ => ",\n"
             ]
 
           val _ = TextIO.output (io, line)
@@ -126,14 +141,17 @@ struct
       val inputMsg =
         case triangles of
           OK triangles => USE_TRIANGLES triangles
-        | PARSE_ERROR => TRIANGLES_LOAD_ERROR
+        | PARSE_ERROR =>
+            let val _ = print "parse error\n"
+            in TRIANGLES_LOAD_ERROR
+            end
     in
       Mailbox.send (inputMailbox, inputMsg)
     end
 
   fun helpSaveTriangles (triangles, io) =
     case triangles of
-      {x1, y1, x2, y2, x3, y3} :: tl =>
+      {x1, y1, x2, y2, x3, y3, r, g, b} :: tl =>
         let
           val triString = String.concat
             [ "x "
@@ -150,6 +168,14 @@ struct
             , Real32.toString x3
             , " y "
             , Real32.toString y3
+
+            , " r "
+            , Real32.toString r
+            , " g "
+            , Real32.toString g
+            , " b "
+            , Real32.toString b
+
             , "\n"
             ]