diff --git a/dotscape b/dotscape index e59a088..05f0f4e 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index 55ac445..c7efdb9 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -364,6 +364,7 @@ struct of SOME (newItem as {y = newY, ey = newEy, data = newData, ...}) => if prevY = newY andalso newEy = prevEy andalso prevData = newData then + (* Y side has same edge, so is mergeable, and data is also same *) getLeftmostX (rootSize, rootTree, newItem) else prevX @@ -386,4 +387,98 @@ struct prevEx | NONE => prevEx end + + fun getTopmostY (rootSize, rootTree, prevItem) = + let + val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} = + prevItem + in + case + getItemWithDataAt (prevX, prevY - 1, 0, 0, rootSize, rootTree, prevData) + of + SOME (newItem as {x = newX, ex = newEx, data = newData, ...}) => + if prevX = newX andalso prevEx = newEx andalso prevData = newData then + (* X side has same edge and data is also same, so mergeable *) + getTopmostY (rootSize, rootTree, newItem) + else + prevY + | NONE => prevY + end + + fun getBottomY (rootSize, rootTree, prevItem) = + let + val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} = + prevItem + in + case + getItemWithDataAt + (prevX, prevEy + 1, 0, 0, rootSize, rootTree, prevData) + of + SOME (newItem as {x = newX, ex = newEx, data = newData, ...}) => + if prevX = newX andalso prevEx = newEx andalso prevData = newData then + (* X side has same edge and data is also same, so mergeable *) + getBottomY (rootSize, rootTree, newItem) + else + prevEy + | NONE => prevEy + end + + datatype merge_dir = + HORIZONTAL of {left: int, right: int} + | VERTICAL of {up: int, down: int} + | NO_MERGE + + fun getHorizontal (ox, oex, leftX, rightX) = + let + val left = if leftX < ox then ox - 1 else ox + val right = if rightX > oex then oex + 1 else oex + in + HORIZONTAL {left = left, right = right} + end + + fun getVertical (oy, oey, upY, bottomY) = + let + val up = if upY < oy then oy - 1 else oy + val down = if bottomY > oey then oey + 1 else oey + in + VERTICAL {up = up, down = down} + end + + fun getMergeDir (rootSize, rootTree, item) = + let + val {x = ox, y = oy, ex = oex, ey = oey, data} = item + + val leftX = getLeftmostX (rootSize, rootTree, item) + val rightX = getRightmostX (rootSize, rootTree, item) + val upY = getTopmostY (rootSize, rootTree, item) + val bottomY = getBottomY (rootSize, rootTree, item) + + val xChanged = leftX <> ox orelse rightX <> oex + val yChanged = upY <> oy orelse bottomY <> oey + in + if xChanged andalso yChanged then + let + val diffX = abs (rightX - leftX) + val diffY = abs (bottomY - upY) + in + if diffX > diffY then getHorizontal (ox, oex, leftX, rightX) + else getVertical (oy, oey, upY, bottomY) + end + else if xChanged then + getHorizontal (ox, oex, leftX, rightX) + else if yChanged then + getVertical (oy, oey, upY, bottomY) + else + NO_MERGE + end + + fun mergeHorizontal (item, newX, newEx) = + let val {y, ey, data, x = _, ex = _} = item + in {x = newX, ex = newEx, y = y, ey = ey, data = data} + end + + fun mergeVertical (item, newY, newEy) = + let val {x, ex, data, y = _, ey = _} = item + in {y = newY, ey = newEy, x = x, ex = ex, data = data} + end end