progress with merging vertically

fcore/quad-tree.sml

@@ -153,6 +153,8 @@ struct
           let
             val ex = x + size
             val ey = y + size
+            val ex = Int.min (ex, Vector.length grid - 1)
+            val ey = Int.min (ey, Vector.length grid - 1)
             val item = {x = x, y = y, ex = ex, ey = ey, data = data}
           in
             BinTree.insert (item, bintree)
@@ -204,8 +206,8 @@ struct
     , yClickPoints
     ) ({x, ex, y, ey, data}, acc) =
     let
-      val ex = if ex = x then x + 1 else ex
-      val ey = if ey = y then y + 1 else ey
+      val ex = if ex = x then x + 1 else ex + 1
+      val ey = if ey = y then y + 1 else ey + 1
 
       val x = getClickPoint (xClickPoints, x)
       val y = getClickPoint (yClickPoints, y)
@@ -281,7 +283,9 @@ struct
         else
           let
             val ex = x + size
+            val ex = Int.min (ex, Vector.length grid - 1)
             val ey = y + size
+            val ey = Int.min (ey, Vector.length grid - 1)
           in
             LEAF {x = x, y = y, ex = ex, ey = ey, data = data}
           end
@@ -344,7 +348,9 @@ struct
 
   local
     fun loop (x, y, ex, ey, grid) =
-      if y < 0 then
+      if y = 0 then
+        1
+      else if ey <= 0 then
         0
       else if quadHasSameColour (x, y, ex, ey, grid) then
         loop (x, y - 1, ex, y, grid)
@@ -352,7 +358,12 @@ struct
         ey
   in
     fun getTopmostY ({x, y, ex, ey, data}, grid) =
-      loop (x, y - 1, ex, y, grid)
+      if y <= 0 orelse ey <= 0 then
+        0
+      else if quadHasSameColour (x, y, ex, ey, grid) then
+        loop (x, y - 1, ex, y, grid)
+      else
+        y
   end
 
   local
@@ -363,12 +374,30 @@ struct
         else
           y
       else
-        Vector.length grid - 1
+        Vector.length grid
   in
     fun getBottomY ({x, y, ex, ey, data}, grid) =
-      loop (x, ey, ex, ey + 1, grid)
+      if quadHasSameColour (x, y, ex, ey, grid) then loop (x, y, ex, ey, grid)
+      else y
   end
 
+  fun printItem {x, y, ex, ey, data} =
+    let
+      val msg = String.concat
+        [ "{x = "
+        , Int.toString x
+        , ", y = "
+        , Int.toString y
+        , ", ex = "
+        , Int.toString ex
+        , ", ey = "
+        , Int.toString ey
+        , "}\n"
+        ]
+    in
+      print msg
+    end
+
   local
     fun loop (tree, grid) =
       case tree of
@@ -394,7 +423,7 @@ struct
               didTlChange orelse didTrChange orelse didBlChange
               orelse didBrChange
           in
-            (node, didChange)
+            (node, false)
           end
   in
     fun mergeVertical (tree, grid) =
@@ -438,10 +467,41 @@ struct
   end
 
   fun merge (tree, grid) =
+    let val tree = mergeVertical (tree, grid)
+    in toBintree tree
+    end
+
+  (* temporarily shadow previous "toTriangles" function. 
+   * When this is done being implemented, rename to "toTrianglesCompressed" *)
+  fun toTriangles
+    ( windowWidth
+    , windowHeight
+    , squares
+    , size
+    , canvasWidth
+    , canvasHeight
+    , xClickPoints
+    , yClickPoints
+    ) =
     let
-      val tree = mergeVertical (tree, grid)
-      val tree = mergeHorizontal (tree, grid)
+      val qtree = buildTree (0, 0, size, squares)
+      val bintree = toBintree qtree
+      val bintree = merge (qtree, squares)
+
+      val list = BinTree.toList bintree
+      val length = List.length list
+      val _ = print ("length = " ^ Int.toString length ^ "\n")
+
+      val f = folder
+        ( windowWidth
+        , windowHeight
+        , canvasWidth
+        , canvasHeight
+        , xClickPoints
+        , yClickPoints
+        )
+      val vec = BinTree.foldr (f, bintree, [])
     in
-      BinTree.toList tree
+      Vector.concat vec
     end
 end