get drawing of triangles implemented

functional-core/app-type.sml

@@ -20,6 +20,16 @@ sig
   val initial: app_type
 
   val withTriangleStage: app_type * triangle_stage -> app_type
+
+  val addTriangleAndResetStage : 
+    app_type *
+    Real32.real *
+    Real32.real *
+    Real32.real *
+    Real32.real *
+    Real32.real *
+    Real32.real ->
+    app_type
 end
 
 structure AppType :> APP_TYPE =
@@ -56,4 +66,15 @@ struct
     let val {triangles, triangleStage = _} = app
     in {triangles = triangles, triangleStage = newTriangleStage}
     end
+
+  fun addTriangleAndResetStage (app: app_type, x1, y1, x2, y2, x3, y3) :
+    app_type =
+    let
+      val {triangles, triangleStage = _} = app
+
+      val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
+      val newTriangles = newTriangle :: triangles
+    in
+      {triangles = newTriangles, triangleStage = NO_TRIANGLE}
+    end
 end

functional-core/app-update.sml

@@ -189,7 +189,8 @@ struct
                    end
                | FIRST {x1, y1} =>
                    let
-                     val drawVec = getFirstTriangleStageVector (x1, y1, buttonVec)
+                     val drawVec = 
+                       getFirstTriangleStageVector (x1, y1, buttonVec)
                      val drawMsg = DRAW_BUTTON drawVec
 
                      val newTriangleStage = SECOND
@@ -201,13 +202,12 @@ struct
                    end
                | SECOND {x1, y1, x2, y2} =>
                    let
-                     val drawVec = 
-                       getSecondTriangleStageVector (x1, y1, x2, y2, buttonVec)
-                     val drawMsg = DRAW_BUTTON drawVec
-
-                     val newTriangleStage = NO_TRIANGLE
                      val model =
-                       AppType.withTriangleStage (model, newTriangleStage)
+                       AppType.addTriangleAndResetStage 
+                         (model, x1, y1, x2, y2, hpos, vpos)
+
+                     val drawVec = getTrianglesVector model
+                     val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec
                    in
                      (model, drawMsg, mouseX, mouseY)
                    end)

imperative-shell/app-draw.sml

@@ -106,4 +106,45 @@ struct
     in
       ()
     end
+
+  fun initTriangles () =
+    let
+      val triangleDrawObject = initDrawObject
+        (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) =
+    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
 end

imperative-shell/event-loop.sml

@@ -19,7 +19,14 @@ struct
   end
 
   fun draw
-    (drawMailbox, window, graphDrawObject, buttonDrawObject, buttonDrawLength) =
+    ( drawMailbox
+    , window
+    , graphDrawObject
+    , buttonDrawObject
+    , buttonDrawLength
+    , triangleDrawObject
+    , triangleDrawLength
+    ) =
     if not (Glfw.windowShouldClose window) then
       case Mailbox.recvPoll drawMailbox of
         NONE =>
@@ -28,6 +35,7 @@ struct
             val _ = Gles3.clear ()
 
             val _ = AppDraw.drawGraphLines graphDrawObject
+            val _ = AppDraw.drawTriangles (triangleDrawObject, triangleDrawLength)
             val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength)
 
             val _ = Glfw.pollEvents ()
@@ -39,6 +47,8 @@ struct
               , graphDrawObject
               , buttonDrawObject
               , buttonDrawLength
+              , triangleDrawObject
+              , triangleDrawLength
               )
           end
       | SOME drawMsg =>
@@ -54,6 +64,24 @@ struct
                    , graphDrawObject
                    , buttonDrawObject
                    , buttonDrawLength
+                   , triangleDrawObject
+                   , triangleDrawLength
+                   )
+               end
+           | DRAW_TRIANGLES_AND_RESET_BUTTONS triangleVec =>
+               let
+                 val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangleVec)
+                 val triangleDrawLength = Vector.length triangleVec div 2
+                 (* have to reset buttons too *)
+               in
+                 draw
+                   ( drawMailbox
+                   , window
+                   , graphDrawObject
+                   , buttonDrawObject
+                   , 0
+                   , triangleDrawObject
+                   , triangleDrawLength
                    )
                end
            | NO_DRAW =>
@@ -63,6 +91,8 @@ struct
                  , graphDrawObject
                  , buttonDrawObject
                  , buttonDrawLength
+                 , triangleDrawObject
+                 , triangleDrawLength
                  ))
     else
       Glfw.terminate ()

imperative-shell/shell.sml

@@ -10,12 +10,14 @@ struct
       val _ = Glfw.windowHint (Glfw.DEPRECATED (), Glfw.FALSE ())
       val _ = Glfw.windowHint (Glfw.SAMPLES (), 4)
       val window =
-        Glfw.createWindow (Constants.windowWidth, Constants.windowHeight, "MLton - dot to dot")
+        Glfw.createWindow
+          (Constants.windowWidth, Constants.windowHeight, "MLton - dot to dot")
       val _ = Glfw.makeContextCurrent window
       val _ = Gles3.loadGlad ()
 
       val graphDrawObject = AppDraw.initGraphLines ()
       val buttonDrawObject = AppDraw.initButton ()
+      val triangleDrawObject = AppDraw.initTriangles ()
 
       val inputMailbox = Mailbox.mailbox ()
       val drawMailbox = Mailbox.mailbox ()
@@ -25,7 +27,14 @@ struct
       val _ = CML.spawn (fn () => EventLoop.update (inputMailbox, drawMailbox))
       val _ = CML.spawn (fn () =>
         EventLoop.draw
-          (drawMailbox, window, graphDrawObject, buttonDrawObject, 0))
+          ( drawMailbox
+          , window
+          , graphDrawObject
+          , buttonDrawObject
+          , 0
+          , triangleDrawObject
+          , 0
+          ))
     in
       ()
     end

message-types/draw-msg.sml

@@ -1,11 +1,15 @@
 signature DRAW_MESSAGE =
 sig
-  datatype t = DRAW_BUTTON of Real32.real vector
+  datatype t =
+    DRAW_BUTTON of Real32.real vector
+  | DRAW_TRIANGLES_AND_RESET_BUTTONS of Real32.real vector
   | NO_DRAW
 end
 
 structure DrawMessage :> DRAW_MESSAGE =
 struct
-  datatype t = DRAW_BUTTON of Real32.real vector 
+  datatype t =
+    DRAW_BUTTON of Real32.real vector
+  | DRAW_TRIANGLES_AND_RESET_BUTTONS of Real32.real vector
   | NO_DRAW
 end