amend bug relating to being unable to select on quad tree, related to dividing odd numbers by 2 (because performing integer division on an odd number by 2 results in rounding, which we don't want)

fcore/app-init.sml

@@ -21,7 +21,7 @@ struct
       val xClickPoints = ClickPoints.generate (wStart, wFinish, canvasWidth)
       val yClickPoints = ClickPoints.generate (hStart, hFinish, canvasHeight)
 
-      val maxPoints = Int.max (canvasWidth, canvasHeight) + 1
+      val maxPoints = Int.max (canvasWidth, canvasHeight)
       val squares = Vector.tabulate (maxPoints, fn _ =>
         Vector.tabulate (maxPoints, fn _ => 0))
     in

fcore/app-with.sml

@@ -188,7 +188,7 @@ struct
         , modalNum
         } = app
 
-      val maxPoints = Int.max (canvasWidth, canvasHeight) + 1
+      val maxPoints = Int.max (canvasWidth, canvasHeight)
       val xClickPoints = ClickPoints.generate (wStart, wFinish, maxPoints)
       val yClickPoints = ClickPoints.generate (hStart, hFinish, maxPoints)
     in

fcore/quad-tree.sml

@@ -72,16 +72,20 @@ struct
                 }
         end
 
-  fun toList (tree, acc) =
-    case tree of
-      NODE {x, y, ex, ey, data, left, right} =>
-        let
-          val acc = toList (right, acc)
-          val acc = {x = x, y = y, ex = ex, ey = ey, data = data} :: acc
-        in
-          toList (left, acc)
-        end
-    | LEAF => acc
+  local
+    fun loop (tree, acc) =
+      case tree of
+        NODE {x, y, ex, ey, data, left, right} =>
+          let
+            val acc = loop (right, acc)
+            val acc = {x = x, y = y, ex = ex, ey = ey, data = data} :: acc
+          in
+            loop (left, acc)
+          end
+      | LEAF => acc
+  in
+    fun toList tree = loop (tree, [])
+  end
 end
 
 structure CollisionTree =
@@ -161,7 +165,7 @@ struct
 
   local
     fun loopYAxis (x, y, eX, eY, yAxis, col) =
-      if y > eY then
+      if y > eY orelse y >= Vector.length yAxis then
         true
       else
         let
@@ -172,7 +176,7 @@ struct
         end
 
     fun loopColour (x, y, eX, eY, grid, col) =
-      if x > eX then
+      if x > eX orelse x >= Vector.length grid then
         true
       else
         let
@@ -194,23 +198,32 @@ struct
   end
 
   (* tree creation/insertion/query functions *)
-  fun build (x, y, size, grid) =
-    if quadHasSameColour (x, y, x + size, y + size, grid) then
+  fun build (x, y, size, grid, bintree) =
+    if x >= Vector.length grid orelse y >= Vector.length grid then
+      bintree
+    else if quadHasSameColour (x, y, x + size, y + size, grid) then
       let
         val yAxis = Vector.sub (grid, x)
         val data = Vector.sub (yAxis, y)
+        val ex = x + size
+        val ey = y + size
+        val item = {x = x, y = y, ex = ex, ey = ey, data = data}
       in
-        LEAF {x = x, y = y, ex = x + size, ey = y + size, data = data}
+        BinTree.insert (item, bintree)
       end
     else
       let
-        val halfSize = size div 2
-        val tl = build (x, y, halfSize, grid)
-        val tr = build (x + halfSize, y, halfSize, grid)
-        val bl = build (x, y + halfSize, halfSize, grid)
-        val br = build (x + halfSize, y + halfSize, halfSize, grid)
+        (* handles odd-number divisions.
+         * For example, `7 div 2` is 3 because of integer division. *)
+        val halfSize =
+          if size = 1 orelse size mod 2 = 0 then size div 2
+          else (size + 1) div 2
+
+        val bintree = build (x, y, halfSize, grid, bintree)
+        val bintree = build (x + halfSize, y, halfSize, grid, bintree)
+        val bintree = build (x, y + halfSize, halfSize, grid, bintree)
       in
-        NODE {tl = tl, bl = bl, tr = tr, br = br}
+        build (x + halfSize, y + halfSize, halfSize, grid, bintree)
       end
 
   fun foldWithDuplicates (f, tree, acc) =
@@ -225,54 +238,87 @@ struct
           foldWithDuplicates (f, br, acc)
         end
 
-  fun insertItemIntoTree (item, acc) =
-    if #data item <> 0 then
-      BinTree.insert (item, acc)
-    else acc
+  fun insertItemIntoTree (item, acc) = BinTree.insert (item, acc)
 
   fun toList qtree =
-    let val tree = foldWithDuplicates (insertItemIntoTree, qtree, BinTree.empty)
-    in BinTree.toList (tree, [])
-    end
+    foldWithDuplicates (fn (item, acc) => item :: acc, qtree, [])
 
   local
-    fun loop (windowWidth, windowHeight, squares, acc, canvasWidth,
-      canvasHeight, xClickPoints, yClickPoints) =
+    fun getClickPoint (clickPoints, pos) =
+      let val idx = Int.min (pos, Vector.length clickPoints - 1)
+      in Vector.sub (clickPoints, idx)
+      end
+
+    fun loop
+      ( windowWidth
+      , windowHeight
+      , squares
+      , acc
+      , canvasWidth
+      , canvasHeight
+      , xClickPoints
+      , yClickPoints
+      ) =
       case squares of
-        {x, y, ex, ey, data = _} :: tl =>
+        {x, y, ex, ey, data} :: tl =>
           let
             val ex = if ex = x then x + 1 else ex
             val ey = if ey = y then y + 1 else ey
 
-            val x = Vector.sub (xClickPoints, x)
-            val ex = Vector.sub (xClickPoints, ex)
-            val y = Vector.sub (yClickPoints, y)
-            val ey = Vector.sub (yClickPoints, ey)
+            val x = getClickPoint (xClickPoints, x)
+            val y = getClickPoint (yClickPoints, y)
+            val ex = getClickPoint (xClickPoints, ex)
+            val ey = getClickPoint (yClickPoints, ey)
 
             val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
-            val endX = Ndc.fromPixelX (ex , windowWidth, windowHeight)
+            val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
             val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
-            val endY = Ndc.fromPixelY (ey , windowWidth, windowHeight)
+            val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
 
-            val vec = 
-              Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0)
-            val acc = vec :: acc
+            val acc =
+              if data <> 0 then
+                Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0)
+                :: acc
+              else
+                acc
           in
-            loop (windowWidth, windowHeight, tl, acc, canvasWidth, canvasHeight,
-            xClickPoints, yClickPoints)
+            loop
+              ( windowWidth
+              , windowHeight
+              , tl
+              , acc
+              , canvasWidth
+              , canvasHeight
+              , xClickPoints
+              , yClickPoints
+              )
           end
       | [] => Vector.concat acc
   in
-    fun toTriangles (windowWidth, windowHeight, squares, size, canvasWidth,
-      canvasHeight, xClickPoints, yClickPoints) =
+    fun toTriangles
+      ( windowWidth
+      , windowHeight
+      , squares
+      , size
+      , canvasWidth
+      , canvasHeight
+      , xClickPoints
+      , yClickPoints
+      ) =
       let
-        val qtree = build (0, 0, size, squares)
-        val squares = toList qtree
-        val msg = List.length squares
-        val () = print (Int.toString msg ^ "\n")
+        val bintree = build (0, 0, size, squares, BinTree.empty)
+        val squares = BinTree.toList bintree
       in
-        loop (windowWidth, windowHeight, squares, [], canvasWidth, canvasHeight,
-        xClickPoints, yClickPoints)
+        loop
+          ( windowWidth
+          , windowHeight
+          , squares
+          , []
+          , canvasWidth
+          , canvasHeight
+          , xClickPoints
+          , yClickPoints
+          )
       end
   end
 end