clean up quad tree code, deleting unused functions and removing intermediate some data structures
This commit is contained in:
@@ -72,97 +72,21 @@ struct
|
||||
}
|
||||
end
|
||||
|
||||
local
|
||||
fun loop (tree, acc) =
|
||||
case tree of
|
||||
NODE {x, y, ex, ey, data, left, right} =>
|
||||
let
|
||||
val acc = loop (right, acc)
|
||||
val acc = {x = x, y = y, ex = ex, ey = ey, data = data} :: acc
|
||||
in
|
||||
loop (left, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
in
|
||||
fun toList tree = loop (tree, [])
|
||||
end
|
||||
fun foldr (f, tree, acc) =
|
||||
case tree of
|
||||
NODE {x, y, ex, ey, data, left, right} =>
|
||||
let
|
||||
val acc = foldr (f, right, acc)
|
||||
val item = {x = x, y = y, ex = ex, ey = ey, data = data}
|
||||
val acc = f (item, acc)
|
||||
in
|
||||
foldr (f, left, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
end
|
||||
|
||||
structure CollisionTree =
|
||||
struct
|
||||
(* functions to check individual collisions *)
|
||||
fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) =
|
||||
ix < cfx andalso ifx > cx andalso iy < cfy andalso ify > cy
|
||||
|
||||
fun isCollidingPlus (ix, iy, iw, ih, cx, cy, cw, ch) =
|
||||
let
|
||||
val ifx = ix + iw
|
||||
val ify = iy + ih
|
||||
val cfx = cx + cw
|
||||
val cfy = cy + ch
|
||||
in
|
||||
isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy)
|
||||
end
|
||||
|
||||
fun isCollidingItem (iX, iY, iW, iH, checkWith) =
|
||||
let val {x = cX, y = cY, w = cW, h = cH} = checkWith
|
||||
in isCollidingPlus (iX, iY, iW, iH, cX, cY, cW, cH)
|
||||
end
|
||||
|
||||
fun visitTopLeft (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half
|
||||
val qmy = qY + half
|
||||
in
|
||||
iX >= qX andalso iX <= qmx andalso iY >= qY andalso iY <= qmy
|
||||
end
|
||||
|
||||
fun visitTopRight (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half
|
||||
val qmy = qY + half - 1
|
||||
|
||||
val qfx = qX + size
|
||||
in
|
||||
iX >= qmx andalso iX <= qfx andalso iY >= qY andalso iY <= qmy
|
||||
end
|
||||
|
||||
fun visitBottomLeft (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half - 1
|
||||
val qmy = qY + half
|
||||
|
||||
val qfy = qY + size
|
||||
in
|
||||
iX >= qX andalso iX <= qmx andalso iY >= qmy andalso iY <= qfy
|
||||
end
|
||||
|
||||
fun visitBottomRight (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half
|
||||
val qmy = qY + half
|
||||
|
||||
val qfx = qX + size
|
||||
val qfy = qY + size
|
||||
in
|
||||
iX >= qmx andalso iX <= qfx andalso iY >= qmy andalso iY <= qfy
|
||||
end
|
||||
|
||||
(* types for tree *)
|
||||
datatype 'a tree =
|
||||
NODE of {tl: 'a tree, tr: 'a tree, bl: 'a tree, br: 'a tree}
|
||||
| LEAF of {x: int, y: int, ex: int, ey: int, data: 'a}
|
||||
|
||||
type 'a t = {tree: 'a tree, size: int}
|
||||
|
||||
local
|
||||
fun loopYAxis (x, y, eX, eY, yAxis, col) =
|
||||
if y > eY orelse y >= Vector.length yAxis then
|
||||
@@ -197,7 +121,7 @@ struct
|
||||
end
|
||||
end
|
||||
|
||||
(* tree creation/insertion/query functions *)
|
||||
(* tree creation *)
|
||||
fun build (x, y, size, grid, bintree) =
|
||||
if x >= Vector.length grid orelse y >= Vector.length grid then
|
||||
bintree
|
||||
@@ -226,74 +150,39 @@ struct
|
||||
build (x + halfSize, y + halfSize, halfSize, grid, bintree)
|
||||
end
|
||||
|
||||
fun foldWithDuplicates (f, tree, acc) =
|
||||
case tree of
|
||||
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 insertItemIntoTree (item, acc) = BinTree.insert (item, acc)
|
||||
|
||||
fun toList qtree =
|
||||
foldWithDuplicates (fn (item, acc) => item :: acc, qtree, [])
|
||||
|
||||
local
|
||||
fun getClickPoint (clickPoints, pos) =
|
||||
let val idx = Int.min (pos, Vector.length clickPoints - 1)
|
||||
in Vector.sub (clickPoints, idx)
|
||||
end
|
||||
|
||||
fun loop
|
||||
fun folder
|
||||
( windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, acc
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
) =
|
||||
case squares of
|
||||
{x, y, ex, ey, data} :: tl =>
|
||||
let
|
||||
val ex = if ex = x then x + 1 else ex
|
||||
val ey = if ey = y then y + 1 else ey
|
||||
) ({x, ex, y, ey, data}, acc) =
|
||||
if data = 0 then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val ex = if ex = x then x + 1 else ex
|
||||
val ey = if ey = y then y + 1 else ey
|
||||
|
||||
val x = getClickPoint (xClickPoints, x)
|
||||
val y = getClickPoint (yClickPoints, y)
|
||||
val ex = getClickPoint (xClickPoints, ex)
|
||||
val ey = getClickPoint (yClickPoints, ey)
|
||||
val x = getClickPoint (xClickPoints, x)
|
||||
val y = getClickPoint (yClickPoints, y)
|
||||
val ex = getClickPoint (xClickPoints, ex)
|
||||
val ey = getClickPoint (yClickPoints, ey)
|
||||
|
||||
val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
|
||||
val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
|
||||
val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
|
||||
val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
|
||||
|
||||
val acc =
|
||||
if data <> 0 then
|
||||
Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0)
|
||||
:: acc
|
||||
else
|
||||
acc
|
||||
in
|
||||
loop
|
||||
( windowWidth
|
||||
, windowHeight
|
||||
, tl
|
||||
, acc
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
)
|
||||
end
|
||||
| [] => Vector.concat acc
|
||||
val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
|
||||
val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
|
||||
val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
|
||||
val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
|
||||
in
|
||||
Ndc.ltrbToVertexRgb (startX, startY, endX, endY, 0.0, 0.0, 0.0) :: acc
|
||||
end
|
||||
in
|
||||
fun toTriangles
|
||||
( windowWidth
|
||||
@@ -307,18 +196,18 @@ struct
|
||||
) =
|
||||
let
|
||||
val bintree = build (0, 0, size, squares, BinTree.empty)
|
||||
val squares = BinTree.toList bintree
|
||||
in
|
||||
loop
|
||||
|
||||
val f = folder
|
||||
( windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, []
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
)
|
||||
val vec = BinTree.foldr (f, bintree, [])
|
||||
in
|
||||
Vector.concat vec
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user