correctly generate click points dynamically, even when window resolution is not a square

2024-08-02 03:09:59 +01:00
parent b01637ba3b
commit 98f6c63b05
3 changed files with 189 additions and 60 deletions
--- a/BIN
+++ b/BIN
--- a/functional-core/app-type.sml
+++ b/functional-core/app-type.sml
@@ -18,7 +18,10 @@ sig
  type app_type =
    { triangles: triangle list
    , triangleStage: triangle_stage
-    , clickPoints: Real32.real vector
+    , windowWidth: int
+    , windowHeight: int
+    , xClickPoints: Real32.real vector
+    , yClickPoints: Real32.real vector
    }

  val getInitial: int * int -> app_type
@@ -36,6 +39,8 @@ sig
    * Real32.real
    * Real32.real
    -> app_type
+
+  val withWindowResize: app_type * int * int -> app_type
 end

 structure AppType :> APP_TYPE =
@@ -66,45 +71,148 @@ struct
  type app_type =
    { triangles: triangle list
    , triangleStage: triangle_stage
-    , clickPoints: Real32.real vector
+    , windowWidth: int
+    , windowHeight: int
+    , xClickPoints: Real32.real vector
+    , yClickPoints: Real32.real vector
    }

-  fun genClickPoints (windowWidth, windowHeight) =
+  fun genClickPoints (start, finish) =
    let
-      val w = Real32.fromInt windowWidth / 40.0
-      val h = Real32.fromInt windowHeight / 40.0
+      val difference = finish - start
+      val increment = Real32.fromInt difference / 40.0
+      val start = Real32.fromInt start
    in
-      Vector.tabulate (41, fn idx => Real32.fromInt idx * w)
+      Vector.tabulate (41, fn idx => (Real32.fromInt idx * increment) + start)
    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 = _, clickPoints = clickPoints} = app
-    in
-      { triangles = triangles
-      , triangleStage = newTriangleStage
-      , clickPoints = clickPoints
+  local
+    fun make (windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) =
+      { triangles = []
+      , triangleStage = NO_TRIANGLE
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
+      , xClickPoints = genClickPoints (wStart, wFinish)
+      , yClickPoints = genClickPoints (hStart, hFinish)
      }
-    end
+  in
+    fun getInitial (windowWidth, windowHeight) =
+      if windowWidth = windowHeight then
+        make (windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
+      else if windowWidth > windowHeight then
+        let
+          val difference = windowWidth - windowHeight
+          val wStart = difference div 2
+          val wFinish = wStart + windowHeight
+        in
+          make (windowWidth, windowHeight, 0, wFinish, 0, windowHeight)
+        end
+      else
+        let
+          val difference = windowHeight - windowWidth
+          val hStart = difference div 2
+          val hFinish = hStart + windowHeight
+        in
+          make (windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
+        end
+
+    fun withTriangleStage (app: app_type, newTriangleStage: triangle_stage) :
+      app_type =
+      let
+        val
+          { triangleStage = _
+          , triangles
+          , xClickPoints
+          , yClickPoints
+          , windowWidth
+          , windowHeight
+          } = app
+      in
+        { triangleStage = newTriangleStage
+        , triangles = triangles
+        , xClickPoints = xClickPoints
+        , yClickPoints = yClickPoints
+        , windowWidth = windowWidth
+        , windowHeight = windowHeight
+        }
+      end
+  end

  fun addTriangleAndResetStage (app: app_type, x1, y1, x2, y2, x3, y3) :
    app_type =
    let
-      val {triangles, triangleStage = _, clickPoints = clickPoints} = app
+      val
+        { triangles
+        , triangleStage = _
+        , xClickPoints
+        , yClickPoints
+        , windowWidth
+        , windowHeight
+        } = 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
-      , clickPoints = clickPoints
+      { triangleStage = NO_TRIANGLE
+      , triangles = newTriangles
+      , xClickPoints = xClickPoints
+      , yClickPoints = yClickPoints
+      , windowWidth = windowWidth
+      , windowHeight = windowHeight
      }
    end
+
+  local
+    fun make
+      ( app: app_type
+      , windowWidth
+      , windowHeight
+      , wStart
+      , wFinish
+      , hStart
+      , hFinish
+      ) : app_type =
+      let
+        val
+          { xClickPoints = _
+          , yClickPoints = _
+          , triangles
+          , triangleStage
+          , windowWidth
+          , windowHeight
+          } = app
+
+        val xClickPoints = genClickPoints (wStart, wFinish)
+        val yClickPoints = genClickPoints (hStart, hFinish)
+      in
+        { xClickPoints = xClickPoints
+        , yClickPoints = yClickPoints
+        , triangles = triangles
+        , triangleStage = triangleStage
+        , windowWidth = windowWidth
+        , windowHeight = windowHeight
+        }
+      end
+  in
+    fun withWindowResize (app: app_type, windowWidth, windowHeight) =
+      if windowWidth = windowHeight then
+        make (app, windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
+      else if windowWidth > windowHeight then
+        let
+          val difference = windowWidth - windowHeight
+          val wStart = difference div 2
+          val wFinish = wStart + windowHeight
+        in
+          make
+            (app, windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
+        end
+      else
+        let
+          val difference = windowHeight - windowWidth
+          val hStart = difference div 2
+          val hFinish = hStart + windowHeight
+        in
+          make (app, windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
+        end
+  end
 end
--- a/functional-core/app-update.sml
+++ b/functional-core/app-update.sml
@@ -29,20 +29,22 @@ struct

  local
    fun getVerticalClickPos
-      (clickPoints, idx, horizontalPos, mouseX, mouseY, r, g, b) =
-      if idx = Vector.length clickPoints then
+      (yClickPoints, idx, horizontalPos, mouseX, mouseY, r, g, b, windowWidth,
+      windowHeight) =
+      if idx = Vector.length yClickPoints then
        (#[], 0.0, 0.0)
      else
        let
-          val curVerticalPos = Vector.sub (clickPoints, idx)
+          val curVerticalPos = Vector.sub (yClickPoints, idx)
        in
          if mouseY < curVerticalPos - 7.0 orelse mouseY > curVerticalPos + 7.0 then
            getVerticalClickPos
-              (clickPoints, idx + 1, horizontalPos, mouseX, mouseY, r, g, b)
+              (yClickPoints, idx + 1, horizontalPos, mouseX, mouseY, r, g, b,
+              windowWidth, windowHeight)
          else
            let
-              val halfWidth = Real32.fromInt (Constants.windowWidth div 2)
-              val halfHeight = Real32.fromInt (Constants.windowHeight div 2)
+              val halfWidth = Real32.fromInt (windowWidth div 2)
+              val halfHeight = Real32.fromInt (windowHeight div 2)
              val hpos = horizontalPos - halfWidth
              val vpos = ~(curVerticalPos - halfHeight)
              val left = (hpos - 5.0) / halfWidth
@@ -59,19 +61,22 @@ struct
            end
        end

-    fun getHorizontalClickPos (clickPoints, idx, mouseX, mouseY, r, g, b) =
-      if idx = Vector.length clickPoints then
+    fun getHorizontalClickPos (xClickPoints, yClickPoints, idx, mouseX, mouseY,
+      r, g, b, windowWidth, windowHeight) =
+      if idx = Vector.length xClickPoints then
        (#[], 0.0, 0.0)
      else
        let
-          val curPos = Vector.sub (clickPoints, idx)
+          val curPos = Vector.sub (xClickPoints, idx)
        in
          if mouseX < curPos - 7.0 orelse mouseX > curPos + 7.0 then
            getHorizontalClickPos
-              (clickPoints, idx + 1, mouseX, mouseY, r, g, b)
+              (xClickPoints, yClickPoints, idx + 1, mouseX, mouseY, r, g, b,
+              windowWidth, windowHeight)
          else
            getVerticalClickPos
-              (clickPoints, 0, curPos, mouseX, mouseY, r, g, b)
+              (yClickPoints, 0, curPos, mouseX, mouseY, r, g, b, windowWidth,
+              windowHeight)
        end
  in
    (*
@@ -80,14 +85,18 @@ struct
     * If a square wasn't found at the clicked position, 
     * an empty vector is returned.
     *)
-    fun getClickPos (clickPoints, mouseX, mouseY, r, g, b) =
-      getHorizontalClickPos (clickPoints, 0, mouseX, mouseY, r, g, b)
+    fun getClickPos (mouseX, mouseY, r, g, b, model: app_type) =
+      getHorizontalClickPos (#xClickPoints model, #yClickPoints model, 0,
+      mouseX, mouseY, r, g, b, #windowWidth model, #windowHeight model)
  end

-  fun getFirstTriangleStageVector (x1, y1, drawVec) =
+  fun getFirstTriangleStageVector (x1, y1, drawVec, model) =
    let
-      val halfWidth = Real32.fromInt (Constants.windowWidth div 2)
-      val halfHeight = Real32.fromInt (Constants.windowHeight div 2)
+      val windowWidth = #windowWidth model
+      val windowHeight = #windowHeight model
+
+      val halfWidth = Real32.fromInt (windowWidth div 2)
+      val halfHeight = Real32.fromInt (windowHeight div 2)

      val x1px = x1 * halfWidth
      val left = (x1px - 5.0) / halfWidth
@@ -102,10 +111,13 @@ struct
      Vector.concat [firstVec, drawVec]
    end

-  fun getSecondTriangleStageVector (x1, y1, x2, y2, drawVec) =
+  fun getSecondTriangleStageVector (x1, y1, x2, y2, drawVec, model) =
    let
-      val halfWidth = Real32.fromInt (Constants.windowWidth div 2)
-      val halfHeight = Real32.fromInt (Constants.windowHeight div 2)
+      val windowWidth = #windowWidth model
+      val windowHeight = #windowHeight model
+
+      val halfWidth = Real32.fromInt (windowWidth div 2)
+      val halfHeight = Real32.fromInt (windowHeight div 2)

      val x1px = x1 * halfWidth
      val left = (x1px - 5.0) / halfWidth
@@ -133,28 +145,30 @@ struct
  fun getTriangleStageVector (model: app_type, drawVec) =
    case #triangleStage model of
      NO_TRIANGLE => drawVec
-    | FIRST {x1, y1} => getFirstTriangleStageVector (x1, y1, drawVec)
+    | FIRST {x1, y1} => getFirstTriangleStageVector (x1, y1, drawVec, model)
    | SECOND {x1, y1, x2, y2} =>
-        getSecondTriangleStageVector (x1, y1, x2, y2, drawVec)
+        getSecondTriangleStageVector (x1, y1, x2, y2, drawVec, model)

  local
    open DrawMessage
    open InputMessage

-    fun mouseMoveOrRelease (model, mouseX, mouseY) =
+    fun mouseMoveOrRelease (model: app_type, mouseX, mouseY) =
      let
+        val {xClickPoints, yClickPoints, ...} = model 
        val (drawVec, _, _) = getClickPos
-          (#clickPoints model, mouseX, mouseY, 1.0, 0.0, 0.0)
+          (mouseX, mouseY, 1.0, 0.0, 0.0, model)
        val drawVec = getTriangleStageVector (model, drawVec)
        val drawMsg = DRAW_BUTTON drawVec
      in
        (model, drawMsg, mouseX, mouseY)
      end

-    fun mouseLeftClick (model, mouseX, mouseY) =
+    fun mouseLeftClick (model: app_type, mouseX, mouseY) =
      let
+        val {xClickPoints, yClickPoints, ...} = model 
        val (buttonVec, hpos, vpos) = getClickPos
-          (#clickPoints model, mouseX, mouseY, 0.0, 0.0, 1.0)
+          (mouseX, mouseY, 0.0, 0.0, 1.0, model)
      in
        if Vector.length buttonVec > 0 then
          case #triangleStage model of
@@ -170,7 +184,8 @@ struct
              end
          | FIRST {x1, y1} =>
              let
-                val drawVec = getFirstTriangleStageVector (x1, y1, buttonVec)
+                val drawVec = getFirstTriangleStageVector (x1, y1, buttonVec,
+                model)
                val drawMsg = DRAW_BUTTON drawVec

                val newTriangleStage = SECOND
@@ -195,22 +210,28 @@ struct

    fun resizeWindow (model, mouseX, mouseY, width, height) =
      let
-        val low = Int.min (width, height)
-        val high = Int.min (width, height)
-
-        val difference = high - low
-        val offset = difference div 2
-        val _ = print "resized window \n"
+        val msg = String.concat [
+        "resized window. ",
+        "width = ",
+        Int.toString width,
+        " height = ",
+        Int.toString height,
+        "\n"
+                    ]
+        val _ = print msg
+        val model = AppType.withWindowResize (model, width, height)
      in
        (model, NO_DRAW, mouseX, mouseY)
      end
  in
-    fun update (model, mouseX, mouseY, inputMsg) =
+    fun update (model: app_type, mouseX, mouseY, inputMsg) =
      case inputMsg of
        MOUSE_MOVE {x = mouseX, y = mouseY} =>
          mouseMoveOrRelease (model, mouseX, mouseY)
-      | MOUSE_LEFT_RELEASE => mouseMoveOrRelease (model, mouseX, mouseY)
-      | MOUSE_LEFT_CLICK => mouseLeftClick (model, mouseX, mouseY)
+      | MOUSE_LEFT_RELEASE => 
+          mouseMoveOrRelease (model, mouseX, mouseY)
+      | MOUSE_LEFT_CLICK => 
+          mouseLeftClick (model, mouseX, mouseY)
      | RESIZE_WINDOW {width, height} =>
          resizeWindow (model, mouseX, mouseY, width, height)
  end