refactoring and scaffolding

dot-to-dot.mlb

@@ -11,6 +11,7 @@ in
 end
 
 message-types/input-msg.sml
+message-types/draw-msg.sml
 
 functional-core/app-type.sml
 ann

functional-core/app-type.sml

@@ -1,4 +1,26 @@
-structure AppType =
+signature APP_TYPE =
+sig
+  datatype triangle_stage =
+    FIRST of {x1: Real32.real, y1: Real32.real}
+  | NO_TRIANGLE
+  | SECOND of
+      {x1: Real32.real, x2: Real32.real, y1: Real32.real, y2: Real32.real}
+
+  type triangle =
+    { x1: Real32.real
+    , x2: Real32.real
+    , x3: Real32.real
+    , y1: Real32.real
+    , y2: Real32.real
+    , y3: Real32.real
+    }
+
+  type app_type = {triangleStage: triangle_stage, triangles: triangle list}
+
+  val initial: app_type
+end
+
+structure AppType :> APP_TYPE =
 struct
   type triangle =
     { x1: Real32.real
@@ -25,18 +47,5 @@ struct
 
   type app_type = {triangles: triangle list, triangleStage: triangle_stage}
 
-  local
+  val initial = {triangles = [], triangleStage = NO_TRIANGLE}
-    fun helpGetTrianglesVector (lst, acc) =
-      case lst of
-        {x1, y1, x2, y2, x3, y3} :: tl =>
-          let val vec = Vector.fromList [x1, y1, x2, y2, x3, y3]
-          in helpGetTrianglesVector (tl, vec :: acc)
-          end
-      | [] => acc
-  in
-    fun getTrianglesVector (app: app_type) =
-      let val lst = helpGetTrianglesVector (#triangles app, [])
-      in Vector.concat lst
-      end
-  end
 end

functional-core/app-update.sml

@@ -1,28 +1,31 @@
 structure AppUpdate =
 struct
-  val clickPoints =
+  open AppType
-   #[ 25
-    , 50
-    , 75
-    , 100
-    , 125
-    , 150
-    , 175
-    , 200
-    , 225
-    , 250
-    , 275
-    , 300
-    , 325
-    , 350
-    , 375
-    , 400
-    , 425
-    , 450
-    , 475
-    ]
 
   local
+    fun helpGetTrianglesVector (lst, acc) =
+      case lst of
+        {x1, y1, x2, y2, x3, y3} :: tl =>
+          let val vec = Vector.fromList [x1, y1, x2, y2, x3, y3]
+          in helpGetTrianglesVector (tl, vec :: acc)
+          end
+      | [] => acc
+  in
+    fun getTrianglesVector (app: app_type) =
+      let val lst = helpGetTrianglesVector (#triangles app, [])
+      in Vector.concat lst
+      end
+  end
+
+  local
+    val clickPoints =
+     #[ 25,  50,  75,  100
+      , 125, 150, 175, 200
+      , 225, 250, 275, 300
+      , 325, 350, 375, 400
+      , 425, 450, 475
+      ]
+
     fun getVerticalClickPos (idx, horizontalPos, mouseX, mouseY, r, g, b) =
       if idx = Vector.length clickPoints then
         #[]
@@ -40,13 +43,13 @@ struct
               val bottom = Real32.fromInt (curVerticalPos - 10) / 500.0
               val top = Real32.fromInt (curVerticalPos + 10) / 500.0
             in
-             #[ left, bottom, r, g, b,
+              #[ left, bottom, r, g, b
-                right, bottom, r, g, b,
+               , right, bottom, r, g, b
-                left, top, r, g, b,
+               , left, top, r, g, b
 
-                left, top, r, g, b,
+               , left, top, r, g, b
-                right, bottom, r, g, b,
+               , right, bottom, r, g, b
-                right, top, r, g, b
+               , right, top, r, g, b
                ]
             end
         end
@@ -73,4 +76,36 @@ struct
     fun getClickPos (mouseX, mouseY, r, g, b) =
       getHorizontalClickPos (0, mouseX, mouseY, r, g, b)
   end
+
+  fun update (model, mouseX, mouseY, inputMsg) =
+    let
+      open DrawMessage
+      open InputMessage
+    in
+      case inputMsg of
+        MOUSE_MOVE {x = mouseX, y = mouseY} =>
+          let
+            val _ = print "mouse moved\n"
+            val drawMsg =
+            DRAW_BUTTON (getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0))
+          in
+            (model, drawMsg, mouseX, mouseY)
+          end
+      | MOUSE_LEFT_RELEASE =>
+          let
+            val _ = print "mouse released\n"
+            val drawMsg = DRAW_BUTTON
+          (getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0))
+          in
+            (model, drawMsg, mouseX, mouseY)
+          end
+      | MUSE_LEFT_CLICK =>
+          let
+            val _ = print "mouse clicked\n"
+            val buttonVec = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0)
+            val drawMsg = DRAW_BUTTON buttonVec
+          in
+            (model, drawMsg, mouseX, mouseY)
+          end
+    end
 end

imperative-shell/event-loop.sml

@@ -3,17 +3,18 @@ struct
   open CML
   open InputMessage
 
-  fun update inputMailbox =
+  local
+  fun loop (inputMailbox, drawMailbox, mouseX, mouseY, model) =
     let
-      val _ =
+      val inputMsg = Mailbox.recv inputMailbox
-        case Mailbox.recv inputMailbox of
+      val (model, drawMsg, mouseX, mouseY) = AppUpdate.update (model, mouseX, mouseY, inputMsg)
-          MOUSE_MOVE {x, y} =>
+      val _ = Mailbox.send (drawMailbox, drawMsg)
-            print (String.concat
-              ["x pos: ", Int.toString x, ", y pos: ", Int.toString y, "\n"])
-        | MOUSE_LEFT_CLICK => print "clicked mouse\n"
-        | MOUSE_LEFT_RELEASE => print "released mouse\n"
     in
-      update inputMailbox
+      loop (inputMailbox, drawMailbox, mouseX, mouseY, model)
+    end
+  in
+    fun update (inputMailbox, drawMailbox) =
+      loop (inputMailbox, drawMailbox, 0, 0, AppType.initial)
   end
 
   fun draw (window, graphDrawObject, buttonDrawObject, buttonDrawLength) =

imperative-shell/input-callbacks.sml

@@ -14,4 +14,18 @@ struct
         Mailbox.send (mailbox, MOUSE_LEFT_RELEASE)
     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
+        in
+          ()
+        end
 end

imperative-shell/shell.sml

@@ -17,24 +17,13 @@ struct
       val buttonDrawObject = AppDraw.initButton ()
 
       val inputMailbox = Mailbox.mailbox ()
-      (* Set callback sender *)
+      val drawMailbox = Mailbox.mailbox ()
-      val _ = CML.spawn (fn () =>
-        let
-          val mouseMoveCallback = InputCallbacks.mouseMoveCallback inputMailbox
-          val _ = Input.exportMouseMoveCallback mouseMoveCallback
-          val _ = Input.setMouseMoveCallback window
 
-          val mouseClickCallback =
+      val _ = CML.spawn (fn () => InputCallbacks.registerCallbacks (window, inputMailbox))
-            InputCallbacks.mouseClickCallback inputMailbox
+      val _ = CML.spawn (fn () => EventLoop.update (inputMailbox, drawMailbox))
-          val _ = Input.exportMouseClickCallback mouseClickCallback
+      val _ = CML.spawn (fn () => EventLoop.draw (window, graphDrawObject, buttonDrawObject, 0))
-          val _ = Input.setMouseClickCallback window
     in
       ()
-        end)
-      (* Set callback listener *)
-      val _ = CML.spawn (fn () => EventLoop.update inputMailbox)
-    in
-      EventLoop.draw (window, graphDrawObject, buttonDrawObject, 0)
     end
 end
 

message-types/draw-msg.sml

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