From 7138a05cd38da6a0ece9c9356535934b55f7452d Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Wed, 29 Jan 2025 07:07:54 +0000 Subject: [PATCH] move quad tree helper functions which are useful in quad-tree.sml and will be useful in quad-tree-fold.sml, to quad-tree-type.sml, so quad-tree.sml only exports public API suitable for users --- fcore/quad-tree-fold.sml | 1 + fcore/quad-tree-type.sml | 103 +++++++++++++++++++++++++---- fcore/quad-tree.sml | 135 --------------------------------------- oms.mlb | 1 + 4 files changed, 93 insertions(+), 147 deletions(-) create mode 100644 fcore/quad-tree-fold.sml diff --git a/fcore/quad-tree-fold.sml b/fcore/quad-tree-fold.sml new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/fcore/quad-tree-fold.sml @@ -0,0 +1 @@ + diff --git a/fcore/quad-tree-type.sml b/fcore/quad-tree-type.sml index 12fce83..5be770f 100644 --- a/fcore/quad-tree-type.sml +++ b/fcore/quad-tree-type.sml @@ -15,12 +15,17 @@ sig } | LEAF of {items: item vector, x: int, y: int, w: int, h: int} - datatype quadrant = - TOP_LEFT - | TOP_RIGHT - | BOTTOM_LEFT - | BOTTOM_RIGHT - | PARENT_QUADRANT + val isColliding: int * int * int * int * int * int * int * int -> bool + + val isCollidingPlus: int * int * int * int * int * int * int * int -> bool + + val visitTopLeft: int * int * int * int * int * int * int * int -> bool + + val visitTopRight: int * int * int * int * int * int * int * int -> bool + + val visitBottomLeft: int * int * int * int * int * int * int * int -> bool + + val visitBottomRight: int * int * int * int * int * int * int * int -> bool end structure QuadTreeType :> QUAD_TREE_TYPE = @@ -40,10 +45,84 @@ struct } | LEAF of {items: item vector, x: int, y: int, w: int, h: int} - datatype quadrant = - TOP_LEFT - | TOP_RIGHT - | BOTTOM_LEFT - | BOTTOM_RIGHT - | PARENT_QUADRANT + 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 visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) = + let + val hw = qW div 2 + val hh = qH div 2 + + val ifx = iX + iW + val ify = iY + iH + + val qmx = qX + hw + val qmy = qY + hh + + val qfx = qX + qW + val qfy = qY + qH + in + isColliding (iX, iY, ifx, ify, qX, qY, qmx, qmy) + end + + fun visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH) = + let + val hw = qW div 2 + val hh = qH div 2 + + val ifx = iX + iW + val ify = iY + iH + + val qmx = qX + hw + val qmy = qY + hh + + val qfx = qX + qW + val qfy = qY + qH + in + isColliding (iX, iY, ifx, ify, qmx, qY, qfx, qmy) + end + + fun visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH) = + let + val hw = qW div 2 + val hh = qH div 2 + + val ifx = iX + iW + val ify = iY + iH + + val qmx = qX + hw + val qmy = qY + hh + + val qfx = qX + qW + val qfy = qY + qH + in + isColliding (iX, iY, ifx, ify, qX, qmy, qmx, qfy) + end + + fun visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH) = + let + val hw = qW div 2 + val hh = qH div 2 + + val ifx = iX + iW + val ify = iY + iH + + val qmx = qX + hw + val qmy = qY + hh + + val qfx = qX + qW + val qfy = qY + qH + in + isColliding (iX, iY, ifx, ify, qmx, qmy, qfx, qfy) + end end diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index 9e3a58b..9ff2232 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -2,12 +2,6 @@ signature QUAD_TREE = sig type t - datatype collision_side = - QUERY_ON_LEFT_SIDE - | QUERY_ON_TOP_SIDE - | QUERY_ON_RIGHT_SIDE - | QUERY_ON_BOTTOM_SIDE - val insert: int * int * int * int * int * t -> t val getCollisions: int * int * int * int * int * t -> int list @@ -30,87 +24,6 @@ struct fun create (width, height) = LEAF {items = Vector.fromList [], x = 0, y = 0, w = width, h = height} - 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 visitTopLeft (iX, iY, iW, iH, qX, qY, qW, qH) = - let - val hw = qW div 2 - val hh = qH div 2 - - val ifx = iX + iW - val ify = iY + iH - - val qmx = qX + hw - val qmy = qY + hh - - val qfx = qX + qW - val qfy = qY + qH - in - isColliding (iX, iY, ifx, ify, qX, qY, qmx, qmy) - end - - fun visitTopRight (iX, iY, iW, iH, qX, qY, qW, qH) = - let - val hw = qW div 2 - val hh = qH div 2 - - val ifx = iX + iW - val ify = iY + iH - - val qmx = qX + hw - val qmy = qY + hh - - val qfx = qX + qW - val qfy = qY + qH - in - isColliding (iX, iY, ifx, ify, qmx, qY, qfx, qmy) - end - - fun visitBottomLeft (iX, iY, iW, iH, qX, qY, qW, qH) = - let - val hw = qW div 2 - val hh = qH div 2 - - val ifx = iX + iW - val ify = iY + iH - - val qmx = qX + hw - val qmy = qY + hh - - val qfx = qX + qW - val qfy = qY + qH - in - isColliding (iX, iY, ifx, ify, qX, qmy, qmx, qfy) - end - - fun visitBottomRight (iX, iY, iW, iH, qX, qY, qW, qH) = - let - val hw = qW div 2 - val hh = qH div 2 - - val ifx = iX + iW - val ify = iY + iH - - val qmx = qX + hw - val qmy = qY + hh - - val qfx = qX + qW - val qfy = qY + qH - in - isColliding (iX, iY, ifx, ify, qmx, qmy, qfx, qfy) - end - fun mkItem (id, startX, startY, width, height) : item = { itemID = id , startX = startX @@ -350,54 +263,6 @@ struct fun getCollisions (itemX, itemY, itemWidth, itemHeight, itemID, tree) = helpGetCollisions (itemX, itemY, itemWidth, itemHeight, itemID, [], tree) - (* no variant to represent 'no collision' case - * because caller should only try getting collision side - * after checking that there is any collision. *) - datatype collision_side = - QUERY_ON_LEFT_SIDE - | QUERY_ON_TOP_SIDE - | QUERY_ON_RIGHT_SIDE - | QUERY_ON_BOTTOM_SIDE - - (* getCollisionSide function ported from this answer: - * https://stackoverflow.com/a/56607347 - * *) - fun getCollisionSide (iX, iY, iW, iH, checkWith: item) = - let - val iFinishX = iX + iW - val iFinishY = iY + iH - val iHalfW = iW div 2 - val iHalfH = iH div 2 - val iCentreX = iX + iHalfW - val iCentreY = iY + iHalfH - - val {startX = cX, startY = cY, width = cW, height = cH, ...} = checkWith - - val cFinishX = cX + cW - val cFinishY = cY + cH - val cHalfW = cW div 2 - val cHalfH = cH div 2 - val cCentreX = cX + cHalfW - val cCentreY = cY + cHalfH - - val diffX = iCentreX - cCentreX - val diffY = iCentreY - cCentreY - - val minXDist = iHalfW + cHalfW - val minYDist = iHalfH + cHalfH - - val depthX = if diffX > 0 then minXDist - diffX else (~minXDist) - diffX - - val depthY = if diffY > 0 then minYDist - diffY else (~minYDist) - diffY - in - if abs depthX < abs depthY then - if depthX > 0 then QUERY_ON_LEFT_SIDE else QUERY_ON_RIGHT_SIDE - else if depthY > 0 then - QUERY_ON_TOP_SIDE - else - QUERY_ON_BOTTOM_SIDE - end - fun hasCollisionAtVec (iX, iY, iW, iH, itemID, pos, elements) = if pos = Vector.length elements then false diff --git a/oms.mlb b/oms.mlb index 6270485..d8547de 100644 --- a/oms.mlb +++ b/oms.mlb @@ -5,6 +5,7 @@ fcore/constants.sml fcore/quad-tree-type.sml fcore/quad-tree.sml +fcore/quad-tree-fold.sml fcore/bin-search.sml fcore/bin-vec.sml