humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

code additional merging functions, which merge vertically and horizontally as much as possible

Browse Source
This commit is contained in:
Humza Shahid
2025-07-08 03:18:57 +01:00
parent 12cfe7a04e
commit ee3764b253
2 changed files with 127 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
dotscape
View File

Binary file not shown.

85
fcore/quad-tree.sml
View File

@@ -93,7 +93,8 @@ struct
end
| LEAF => acc
fun toList tree = foldr (fn (item, acc) => item ::acc, tree, [])
fun toList tree =
foldr (fn (item, acc) => item :: acc, tree, [])
end
structure CollisionTree =
@@ -343,9 +344,9 @@ struct
local
fun loop (x, y, ex, ey, grid) =
if y < 0 then 0
else
if quadHasSameColour (x, y, ex, ey, grid) then
if y < 0 then
0
else if quadHasSameColour (x, y, ex, ey, grid) then
loop (x, y - 1, ex, y, grid)
else
ey
@@ -367,4 +368,80 @@ struct
fun getBottomY ({x, y, ex, ey, data}, grid) =
loop (x, ey, ex, ey + 1, grid)
end
local
fun loop (tree, grid) =
case tree of
EMPTY => (EMPTY, false)
| LEAF (oldItem as {x, y, ex, ey, data}) =>
let
val topY = getTopmostY (oldItem, grid)
val bottomY = getBottomY (oldItem, grid)
val newItem = {y = topY, ey = bottomY, x = x, ex = ex, data = data}
val didItemChange = newItem <> oldItem
in
(LEAF newItem, didItemChange)
end
| NODE {tl, tr, bl, br} =>
let
val (tl, didTlChange) = loop (tl, grid)
val (tr, didTrChange) = loop (tr, grid)
val (bl, didBlChange) = loop (bl, grid)
val (br, didBrChange) = loop (br, grid)
val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
val didChange =
didTlChange orelse didTrChange orelse didBlChange
orelse didBrChange
in
(node, didChange)
end
in
fun mergeVertical (tree, grid) =
let val (newTree, didChange) = loop (tree, grid)
in if didChange then mergeVertical (newTree, grid) else newTree
end
end
local
fun loop (tree, grid) =
case tree of
EMPTY => (EMPTY, false)
| LEAF (oldItem as {x, y, ex, ey, data}) =>
let
val leftX = getLeftmostX (oldItem, grid)
val rightX = getRightmostX (oldItem, grid)
val newItem = {x = leftX, ex = rightX, y = y, ey = ey, data = data}
val didItemChange = newItem <> oldItem
in
(LEAF newItem, didItemChange)
end
| NODE {tl, tr, bl, br} =>
let
val (tl, didTlChange) = loop (tl, grid)
val (tr, didTrChange) = loop (tr, grid)
val (bl, didBlChange) = loop (bl, grid)
val (br, didBrChange) = loop (br, grid)
val node = NODE {tl = tl, tr = tr, bl = bl, br = br}
val didChange =
didTlChange orelse didTrChange orelse didBlChange
orelse didBrChange
in
(node, didChange)
end
in
fun mergeHorizontal (tree, grid) =
let val (newTree, didChange) = loop (tree, grid)
in if didChange then mergeHorizontal (newTree, grid) else newTree
end
end
fun merge (tree, grid) =
let
val tree = mergeVertical (tree, grid)
val tree = mergeHorizontal (tree, grid)
in
BinTree.toList tree
end
end