diff --git a/dotscape b/dotscape index 05f0f4e..22c0ee3 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index c7efdb9..df17a27 100644 --- a/fcore/quad-tree.sml +++ b/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