rewrite merge functions which query grid instead of quad tree (only partially)
This commit is contained in:
@@ -92,6 +92,8 @@ struct
|
|||||||
foldr (f, left, acc)
|
foldr (f, left, acc)
|
||||||
end
|
end
|
||||||
| LEAF => acc
|
| LEAF => acc
|
||||||
|
|
||||||
|
fun toList tree = foldr (fn (item, acc) => item ::acc, tree, [])
|
||||||
end
|
end
|
||||||
|
|
||||||
structure CollisionTree =
|
structure CollisionTree =
|
||||||
@@ -187,7 +189,6 @@ struct
|
|||||||
)
|
)
|
||||||
end)
|
end)
|
||||||
|
|
||||||
local
|
|
||||||
fun getClickPoint (clickPoints, pos) =
|
fun getClickPoint (clickPoints, pos) =
|
||||||
let val idx = Int.min (pos, Vector.length clickPoints - 1)
|
let val idx = Int.min (pos, Vector.length clickPoints - 1)
|
||||||
in Vector.sub (clickPoints, idx)
|
in Vector.sub (clickPoints, idx)
|
||||||
@@ -217,7 +218,7 @@ struct
|
|||||||
in
|
in
|
||||||
Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) :: acc
|
Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) :: acc
|
||||||
end
|
end
|
||||||
in
|
|
||||||
fun toTriangles
|
fun toTriangles
|
||||||
( windowWidth
|
( windowWidth
|
||||||
, windowHeight
|
, windowHeight
|
||||||
@@ -243,7 +244,6 @@ struct
|
|||||||
in
|
in
|
||||||
Vector.concat vec
|
Vector.concat vec
|
||||||
end
|
end
|
||||||
end
|
|
||||||
|
|
||||||
(* building and querying quad tree, plus compression *)
|
(* building and querying quad tree, plus compression *)
|
||||||
datatype quad_tree =
|
datatype quad_tree =
|
||||||
@@ -251,6 +251,22 @@ struct
|
|||||||
| NODE of {tl: quad_tree, tr: quad_tree, bl: quad_tree, br: quad_tree}
|
| NODE of {tl: quad_tree, tr: quad_tree, bl: quad_tree, br: quad_tree}
|
||||||
| EMPTY
|
| EMPTY
|
||||||
|
|
||||||
|
fun foldWithDuplicates (f, tree, acc) =
|
||||||
|
case tree of
|
||||||
|
EMPTY => acc
|
||||||
|
| LEAF item => f (item, acc)
|
||||||
|
| NODE {tl, tr, bl, br} =>
|
||||||
|
let
|
||||||
|
val acc = foldWithDuplicates (f, tl, acc)
|
||||||
|
val acc = foldWithDuplicates (f, tr, acc)
|
||||||
|
val acc = foldWithDuplicates (f, bl, acc)
|
||||||
|
in
|
||||||
|
foldWithDuplicates (f, br, acc)
|
||||||
|
end
|
||||||
|
|
||||||
|
fun toBintree qtree =
|
||||||
|
foldWithDuplicates (BinTree.insert, qtree, BinTree.empty)
|
||||||
|
|
||||||
fun buildTree (x, y, size, grid) =
|
fun buildTree (x, y, size, grid) =
|
||||||
if x >= Vector.length grid orelse y >= Vector.length grid then
|
if x >= Vector.length grid orelse y >= Vector.length grid then
|
||||||
EMPTY
|
EMPTY
|
||||||
@@ -297,255 +313,58 @@ struct
|
|||||||
NODE {tl = tl, tr = tr, bl = bl, br = br}
|
NODE {tl = tl, tr = tr, bl = bl, br = br}
|
||||||
end)
|
end)
|
||||||
|
|
||||||
fun getItemWithDataAt (x, y, qx, qy, size, tree, data) =
|
local
|
||||||
case tree of
|
fun loop (x, y, ex, ey, grid) =
|
||||||
EMPTY => NONE
|
if x > 0 then
|
||||||
| LEAF (item as {x = ix, y = iy, ex = iex, ey = iey, data = oldData}) =>
|
if quadHasSameColour (x, y, ex, ey, grid) then
|
||||||
if (x >= ix andalso x <= iex) andalso (y >= iy andalso y <= iey) then
|
loop (x - 1, y, x, ey, grid)
|
||||||
(* search coordinates are in item *)
|
|
||||||
if data = oldData then (* data matches *) SOME item else NONE
|
|
||||||
else
|
else
|
||||||
NONE
|
ex
|
||||||
| NODE {tl, tr, bl, br} =>
|
else
|
||||||
if size mod 2 = 0 orelse size = 1 then
|
0
|
||||||
let
|
|
||||||
val halfSize = size div 2
|
|
||||||
val qmx = x + halfSize
|
|
||||||
val qfx = x + size
|
|
||||||
val qmy = y + halfSize
|
|
||||||
val qfy = y + size
|
|
||||||
in
|
in
|
||||||
if y >= qy andalso y <= qmy then
|
fun getLeftmostX ({x, y, ex, ey, data}, grid) =
|
||||||
(* top *)
|
loop (x - 1, y, x, ey, grid)
|
||||||
if x >= qx andalso x <= qmx then
|
|
||||||
(* top left *)
|
|
||||||
getItemWithDataAt (x, y, qx, qy, halfSize, tl, data)
|
|
||||||
else
|
|
||||||
(* top right *)
|
|
||||||
getItemWithDataAt (x, y, qx + halfSize, qy, halfSize, tr, data)
|
|
||||||
else (* bottom *) if x >= qx andalso x <= qmx then
|
|
||||||
(* bottom left *)
|
|
||||||
getItemWithDataAt (x, y, qx, qy + halfSize, halfSize, bl, data)
|
|
||||||
else
|
|
||||||
(* bottom right *)
|
|
||||||
getItemWithDataAt
|
|
||||||
(x, y, qx + halfSize, qy + halfSize, halfSize, br, data)
|
|
||||||
end
|
|
||||||
else
|
|
||||||
let
|
|
||||||
val halfSizeBefore = size div 2
|
|
||||||
val halfSizeAfter = (size + 1) div 2
|
|
||||||
val qmx = x + halfSizeBefore
|
|
||||||
val qmy = y + halfSizeBefore
|
|
||||||
in
|
|
||||||
if y >= qy andalso y <= qmy then
|
|
||||||
(* top *)
|
|
||||||
if x >= qx andalso x <= qmx then
|
|
||||||
(* top left *)
|
|
||||||
getItemWithDataAt (x, y, qx, qy, halfSizeAfter, tl, data)
|
|
||||||
else
|
|
||||||
(* top right *)
|
|
||||||
getItemWithDataAt (x, y, qmx, qy, halfSizeAfter, tr, data)
|
|
||||||
else (* bottom *) if x >= qx andalso x <= qmx then
|
|
||||||
(* bottom left *)
|
|
||||||
getItemWithDataAt (x, y, qx, qmy, halfSizeAfter, bl, data)
|
|
||||||
else
|
|
||||||
(* bottom right *)
|
|
||||||
getItemWithDataAt (x, y, qmx, qmy, halfSizeAfter, br, data)
|
|
||||||
end
|
|
||||||
|
|
||||||
fun getLeftmostX (rootSize, rootTree, prevItem) =
|
|
||||||
let
|
|
||||||
val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} =
|
|
||||||
prevItem
|
|
||||||
in
|
|
||||||
case
|
|
||||||
getItemWithDataAt (prevX - 1, prevY, 0, 0, rootSize, rootTree, prevData)
|
|
||||||
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
|
|
||||||
| NONE => prevX
|
|
||||||
end
|
|
||||||
|
|
||||||
fun getRightmostX (rootSize, rootTree, prevItem) =
|
|
||||||
let
|
|
||||||
val {x = prevX, y = prevY, ex = prevEx, ey = prevEy, data = prevData} =
|
|
||||||
prevItem
|
|
||||||
in
|
|
||||||
case
|
|
||||||
getItemWithDataAt
|
|
||||||
(prevEx + 1, prevY, 0, 0, rootSize, rootTree, prevData)
|
|
||||||
of
|
|
||||||
SOME (newItem as {y = newY, ey = newEy, data = newData, ...}) =>
|
|
||||||
if prevY = newY andalso newEy = prevEy andalso prevData = newData then
|
|
||||||
getRightmostX (rootSize, rootTree, newItem)
|
|
||||||
else
|
|
||||||
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
|
||||||
|
|
||||||
local
|
local
|
||||||
fun mergePass (qx, qy, size, tree, rootSize, rootTree) =
|
fun loop (x, y, ex, ey, grid) =
|
||||||
case tree of
|
if x < Vector.length grid andalso ex < Vector.length grid then
|
||||||
EMPTY => (EMPTY, false)
|
if quadHasSameColour (x, y, ex, ey, grid) then
|
||||||
| LEAF item =>
|
loop (ex, y, ex + 1, ey, grid)
|
||||||
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
|
else
|
||||||
let
|
x
|
||||||
val halfSizeBefore = size div 2
|
else
|
||||||
val halfSizeAfter = (size + 1) div 2
|
Vector.length grid - 1
|
||||||
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
|
in
|
||||||
(node, didMergeAny)
|
fun getRightmostX ({x, y, ex, ey, data}, grid) =
|
||||||
|
loop (ex, y, ex + 1, ey, grid)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
local
|
||||||
|
fun loop (x, y, ex, ey, grid) =
|
||||||
|
if y < 0 then 0
|
||||||
|
else
|
||||||
|
if quadHasSameColour (x, y, ex, ey, grid) then
|
||||||
|
loop (x, y - 1, ex, y, grid)
|
||||||
|
else
|
||||||
|
ey
|
||||||
in
|
in
|
||||||
fun merge (rootSize, rootTree) =
|
fun getTopmostY ({x, y, ex, ey, data}, grid) =
|
||||||
let
|
loop (x, y - 1, ex, y, grid)
|
||||||
val (newTree, didMerge) = mergePass
|
|
||||||
(0, 0, rootSize, rootTree, rootSize, rootTree)
|
|
||||||
in
|
|
||||||
if didMerge then merge (rootSize, newTree) else newTree
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
local
|
||||||
|
fun loop (x, y, ex, ey, grid) =
|
||||||
|
if y < Vector.length grid andalso ey < Vector.length grid then
|
||||||
|
if quadHasSameColour (x, y, ex, ey, grid) then
|
||||||
|
loop (x, ey, ex, ey + 1, grid)
|
||||||
|
else
|
||||||
|
y
|
||||||
|
else
|
||||||
|
Vector.length grid - 1
|
||||||
|
in
|
||||||
|
fun getBottomY ({x, y, ex, ey, data}, grid) =
|
||||||
|
loop (x, ey, ex, ey + 1, grid)
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|||||||
Reference in New Issue
Block a user