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.

177
fcore/quad-tree.sml
View File

@@ -93,7 +93,8 @@ struct
end end
| LEAF => acc | LEAF => acc
fun toList tree = foldr (fn (item, acc) => item ::acc, tree, []) fun toList tree =
foldr (fn (item, acc) => item :: acc, tree, [])
end end
structure CollisionTree = structure CollisionTree =
@@ -189,10 +190,10 @@ struct
) )
end) end)
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)
end end
fun folder fun folder
( windowWidth ( windowWidth
@@ -313,58 +314,134 @@ struct
NODE {tl = tl, tr = tr, bl = bl, br = br} NODE {tl = tl, tr = tr, bl = bl, br = br}
end) end)
local local
fun loop (x, y, ex, ey, grid) = fun loop (x, y, ex, ey, grid) =
if x > 0 then if x > 0 then
if quadHasSameColour (x, y, ex, ey, grid) then if quadHasSameColour (x, y, ex, ey, grid) then
loop (x - 1, y, x, ey, grid) loop (x - 1, y, x, ey, grid)
else
ex
else else
0 ex
in else
fun getLeftmostX ({x, y, ex, ey, data}, grid) = 0
loop (x - 1, y, x, ey, grid) in
end fun getLeftmostX ({x, y, ex, ey, data}, grid) =
loop (x - 1, y, x, ey, grid)
end
local local
fun loop (x, y, ex, ey, grid) = fun loop (x, y, ex, ey, grid) =
if x < Vector.length grid andalso ex < Vector.length grid then if x < Vector.length grid andalso ex < Vector.length grid then
if quadHasSameColour (x, y, ex, ey, grid) then if quadHasSameColour (x, y, ex, ey, grid) then
loop (ex, y, ex + 1, ey, grid) loop (ex, y, ex + 1, ey, grid)
else
x
else else
Vector.length grid - 1 x
in else
fun getRightmostX ({x, y, ex, ey, data}, grid) = Vector.length grid - 1
loop (ex, y, ex + 1, ey, grid) in
end fun getRightmostX ({x, y, ex, ey, data}, grid) =
loop (ex, y, ex + 1, ey, grid)
end
local local
fun loop (x, y, ex, ey, grid) = fun loop (x, y, ex, ey, grid) =
if y < 0 then 0 if y < 0 then
else 0
if quadHasSameColour (x, y, ex, ey, grid) then else if quadHasSameColour (x, y, ex, ey, grid) then
loop (x, y - 1, ex, y, grid)
else
ey
in
fun getTopmostY ({x, y, ex, ey, data}, grid) =
loop (x, y - 1, ex, y, grid) loop (x, y - 1, ex, y, grid)
end else
ey
in
fun getTopmostY ({x, y, ex, ey, data}, grid) =
loop (x, y - 1, ex, y, grid)
end
local local
fun loop (x, y, ex, ey, grid) = fun loop (x, y, ex, ey, grid) =
if y < Vector.length grid andalso ey < Vector.length grid then if y < Vector.length grid andalso ey < Vector.length grid then
if quadHasSameColour (x, y, ex, ey, grid) then if quadHasSameColour (x, y, ex, ey, grid) then
loop (x, ey, ex, ey + 1, grid) loop (x, ey, ex, ey + 1, grid)
else
y
else else
Vector.length grid - 1 y
else
Vector.length grid - 1
in
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 in
fun getBottomY ({x, y, ex, ey, data}, grid) = BinTree.toList tree
loop (x, ey, ex, ey + 1, grid)
end end
end end