add clickPoints to app-type so we are able to change those points at runtime

2024-08-01 21:39:09 +01:00
parent 0fc6201231
commit c5d9ed4c69
4 changed files with 74 additions and 42 deletions
--- a/BIN
+++ b/BIN
--- a/functional-core/app-type.sml
+++ b/functional-core/app-type.sml
@@ -15,21 +15,27 @@ sig
    , y3: Real32.real
    }

-  type app_type = {triangleStage: triangle_stage, triangles: triangle list}
+  type app_type =
+    { triangles: triangle list
+    , triangleStage: triangle_stage
+    , clickPoints: Real32.real vector
+    }

-  val initial: app_type
+  val getInitial: int * int -> app_type
+
+  val genClickPoints: int * int -> Real32.real vector

  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
+    * Real32.real
+    * Real32.real
+    * Real32.real
+    * Real32.real
+    * Real32.real
+    * Real32.real
+    -> app_type
 end

 structure AppType :> APP_TYPE =
@@ -57,24 +63,48 @@ struct
  | SECOND of
      {x1: Real32.real, y1: Real32.real, x2: Real32.real, y2: Real32.real}

-  type app_type = {triangles: triangle list, triangleStage: triangle_stage}
+  type app_type =
+    { triangles: triangle list
+    , triangleStage: triangle_stage
+    , clickPoints: Real32.real vector
+    }

-  val initial = {triangles = [], triangleStage = NO_TRIANGLE}
+  fun genClickPoints (windowWidth, windowHeight) =
+    let
+      val w = Real32.fromInt windowWidth / 40.0
+      val h = Real32.fromInt windowHeight / 40.0
+    in
+      Vector.tabulate (41, fn idx => Real32.fromInt idx * w)
+    end
+
+  fun getInitial (windowWidth, windowHeight) =
+    { triangles = []
+    , triangleStage = NO_TRIANGLE
+    , clickPoints = genClickPoints (windowWidth, windowHeight)
+    }

  fun withTriangleStage (app: app_type, newTriangleStage: triangle_stage) :
    app_type =
-    let val {triangles, triangleStage = _} = app
-    in {triangles = triangles, triangleStage = newTriangleStage}
+    let
+      val {triangles, triangleStage = _, clickPoints = clickPoints} = app
+    in
+      { triangles = triangles
+      , triangleStage = newTriangleStage
+      , clickPoints = clickPoints
+      }
    end

  fun addTriangleAndResetStage (app: app_type, x1, y1, x2, y2, x3, y3) :
    app_type =
    let
-      val {triangles, triangleStage = _} = app
+      val {triangles, triangleStage = _, clickPoints = clickPoints} = 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}
+      { triangles = newTriangles
+      , triangleStage = NO_TRIANGLE
+      , clickPoints = clickPoints
+      }
    end
 end
--- a/functional-core/app-update.sml
+++ b/functional-core/app-update.sml
@@ -28,18 +28,8 @@ struct
     ]

  local
-    fun genClickPoints (windowWidth, windowHeight) =
-      let
-        val w = Real32.fromInt windowWidth / 40.0
-        val h = Real32.fromInt windowHeight / 40.0
-      in
-        Vector.tabulate (41, fn idx => Real32.fromInt idx * w)
-      end
-
-    val clickPoints =
-      genClickPoints (Constants.windowWidth, Constants.windowHeight)
-
-    fun getVerticalClickPos (idx, horizontalPos, mouseX, mouseY, r, g, b) =
+    fun getVerticalClickPos
+      (clickPoints, idx, horizontalPos, mouseX, mouseY, r, g, b) =
      if idx = Vector.length clickPoints then
        (#[], 0.0, 0.0)
      else
@@ -48,7 +38,7 @@ struct
        in
          if mouseY < curVerticalPos - 7.0 orelse mouseY > curVerticalPos + 7.0 then
            getVerticalClickPos
-              (idx + 1, horizontalPos, mouseX, mouseY, r, g, b)
+              (clickPoints, idx + 1, horizontalPos, mouseX, mouseY, r, g, b)
          else
            let
              val halfWidth = Real32.fromInt (Constants.windowWidth div 2)
@@ -69,7 +59,7 @@ struct
            end
        end

-    fun getHorizontalClickPos (idx, mouseX, mouseY, r, g, b) =
+    fun getHorizontalClickPos (clickPoints, idx, mouseX, mouseY, r, g, b) =
      if idx = Vector.length clickPoints then
        (#[], 0.0, 0.0)
      else
@@ -77,9 +67,11 @@ struct
          val curPos = Vector.sub (clickPoints, idx)
        in
          if mouseX < curPos - 7.0 orelse mouseX > curPos + 7.0 then
-            getHorizontalClickPos (idx + 1, mouseX, mouseY, r, g, b)
+            getHorizontalClickPos
+              (clickPoints, idx + 1, mouseX, mouseY, r, g, b)
          else
-            getVerticalClickPos (0, curPos, mouseX, mouseY, r, g, b)
+            getVerticalClickPos
+              (clickPoints, 0, curPos, mouseX, mouseY, r, g, b)
        end
  in
    (*
@@ -88,9 +80,8 @@ struct
     * If a square wasn't found at the clicked position, 
     * an empty vector is returned.
     *)
-    fun getClickPos (mouseX, mouseY, r, g, b) =
-      getHorizontalClickPos
-        (0, mouseX, mouseY, r, g, b)
+    fun getClickPos (clickPoints, mouseX, mouseY, r, g, b) =
+      getHorizontalClickPos (clickPoints, 0, mouseX, mouseY, r, g, b)
  end

  fun getFirstTriangleStageVector (x1, y1, drawVec) =
@@ -154,7 +145,8 @@ struct
      case inputMsg of
        MOUSE_MOVE {x = mouseX, y = mouseY} =>
          let
-            val (drawVec, _, _) = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0)
+            val (drawVec, _, _) = getClickPos
+              (#clickPoints model, mouseX, mouseY, 1.0, 0.0, 0.0)
            val drawVec = getTriangleStageVector (model, drawVec)
            val drawMsg = DRAW_BUTTON drawVec
          in
@@ -162,7 +154,8 @@ struct
          end
      | MOUSE_LEFT_RELEASE =>
          let
-            val (drawVec, _, _) = getClickPos (mouseX, mouseY, 1.0, 0.0, 0.0)
+            val (drawVec, _, _) = getClickPos
+              (#clickPoints model, mouseX, mouseY, 1.0, 0.0, 0.0)
            val drawVec = getTriangleStageVector (model, drawVec)
            val drawMsg = DRAW_BUTTON drawVec
          in
@@ -171,7 +164,7 @@ struct
      | MUSE_LEFT_CLICK =>
          let
            val (buttonVec, hpos, vpos) = getClickPos
-              (mouseX, mouseY, 0.0, 0.0, 1.0)
+              (#clickPoints model, mouseX, mouseY, 0.0, 0.0, 1.0)
          in
            if Vector.length buttonVec > 0 then
              (case #triangleStage model of
--- a/imperative-shell/event-loop.sml
+++ b/imperative-shell/event-loop.sml
@@ -15,7 +15,13 @@ struct
      end
  in
    fun update (inputMailbox, drawMailbox) =
-      loop (inputMailbox, drawMailbox, 0.0, 0.0, AppType.initial)
+      loop
+        ( inputMailbox
+        , drawMailbox
+        , 0.0
+        , 0.0
+        , AppType.getInitial (Constants.windowWidth, Constants.windowHeight)
+        )
  end

  fun draw
@@ -35,7 +41,8 @@ struct
            val _ = Gles3.clear ()

            val _ = AppDraw.drawGraphLines graphDrawObject
-            val _ = AppDraw.drawTriangles (triangleDrawObject, triangleDrawLength)
+            val _ =
+              AppDraw.drawTriangles (triangleDrawObject, triangleDrawLength)
            val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength)

            val _ = Glfw.pollEvents ()
@@ -70,7 +77,9 @@ struct
               end
           | DRAW_TRIANGLES_AND_RESET_BUTTONS triangleVec =>
               let
-                 val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangleVec)
+                 val _ =
+                   AppDraw.uploadTrianglesVector
+                     (triangleDrawObject, triangleVec)
                 val triangleDrawLength = Vector.length triangleVec div 2
               (* buttons are reset by setting buttonDrawLength to 0 *)
               in