done writing merge function

fcore/quad-tree.sml

@@ -481,4 +481,71 @@ struct
     let val {x, ex, data, y = _, ey = _} = item
     in {y = newY, ey = newEy, x = x, ex = ex, data = data}
     end
+
+  local
+    fun mergePass (qx, qy, size, tree, rootSize, rootTree) =
+      case tree of
+        EMPTY => (EMPTY, false)
+      | LEAF item =>
+          let
+            val mergeDir = getMergeDir (rootSize, rootTree, item)
+          in
+            case mergeDir of
+              NO_MERGE => (LEAF item, false)
+            | VERTICAL {up, down} =>
+                (LEAF (mergeVertical (item, up, down)), true)
+            | HORIZONTAL {left, right} =>
+                (LEAF (mergeHorizontal (item, left, right)), true)
+          end
+      | NODE {tl, tr, bl, br} =>
+          if size = 1 orelse size mod 2 = 0 then
+            let
+              val halfSize = size div 2
+
+              val (tl, didMergeTl) = mergePass
+                (qx, qy, halfSize, tl, rootSize, rootTree)
+              val (tr, didMergeTr) = mergePass
+                (qx + halfSize, qy, halfSize, tr, rootSize, rootTree)
+              val (bl, didMergeBl) = mergePass
+                (qx, qy + halfSize, halfSize, bl, rootSize, rootTree)
+              val (br, didMergeBr) = mergePass
+                (qx + halfSize, qy + halfSize, halfSize, br, rootSize, rootTree)
+
+              val didMergeAny =
+                didMergeTl orelse didMergeTr orelse didMergeBl orelse didMergeBr
+              val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
+            in
+              (node, didMergeAny)
+            end
+          else
+            let
+              val halfSizeBefore = size div 2
+              val halfSizeAfter = (size + 1) div 2
+              val qmx = qx + halfSizeBefore
+              val qmy = qy + halfSizeAfter
+
+              val (tl, didMergeTl) = mergePass
+                (qx, qy, halfSizeAfter, tl, rootSize, rootTree)
+              val (tr, didMergeTr) = mergePass
+                (qmx, qy, halfSizeAfter, tr, rootSize, rootTree)
+              val (bl, didMergeBl) = mergePass
+                (qx, qmy, halfSizeAfter, bl, rootSize, rootTree)
+              val (br, didMergeBr) = mergePass
+                (qmx, qmy, halfSizeAfter, br, rootSize, rootTree)
+
+              val didMergeAny =
+                didMergeTl orelse didMergeTr orelse didMergeBl orelse didMergeBr
+              val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
+            in
+              (node, didMergeAny)
+            end
+  in
+    fun merge (rootSize, rootTree) =
+      let
+        val (newTree, didMerge) = mergePass
+          (0, 0, rootSize, rootTree, rootSize, rootTree)
+      in
+        if didMerge then merge (rootSize, newTree) else newTree
+      end
+  end
 end