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

fix compile errors after previous commit (which involved reimplementing the quad tree to eliminate the possibility of a class of bugs I was experiencing; the problem was that the quad bounds were being passed recursively in different functions, but the long argument list in these functions made it difficult to see where the mismatch was)

Browse Source
This commit is contained in:
Humza Shahid
2025-01-27 23:41:59 +00:00
parent 6369be21fa
commit 9b7d7a1396
12 changed files with 264 additions and 333 deletions
Download Patch File Download Diff File Expand all files Collapse all files

142
fcore/enemy-behaviour.sml
View File

@@ -8,11 +8,10 @@ struct
val searchHeight = 10
val searchWidth = Constants.moveEnemyBy
in
QuadHelp.hasCollisionAt
(x, y, searchWidth, searchHeight, wallTree)
QuadTree.hasCollisionAt (x, y, searchWidth, searchHeight, ~1, wallTree)
orelse
QuadHelp.hasCollisionAt
(x, y, searchWidth, searchHeight, platformTree)
QuadTree.hasCollisionAt
(x, y, searchWidth, searchHeight, ~1, platformTree)
end
(* same function takes either wallTree or platformTree and returns true
@@ -29,7 +28,7 @@ struct
val width = Constants.enemySize
val height = Platform.platHeight
in
QuadHelp.hasCollisionAt (ex, ey, width, height, tree)
QuadTree.hasCollisionAt (ex, ey, width, height, ~1, tree)
end
fun getPatrollPatches (enemy: enemy, wallTree, platformTree, acc) =
@@ -62,22 +61,17 @@ struct
val searchWidth = Constants.moveEnemyBy
val searchHeight = Constants.enemySize - 5
val hasWallAhead = QuadHelp.hasCollisionAt
( searchStartX
, y
, searchWidth
, searchHeight
, wallTree
)
val hasWallAhead = QuadTree.hasCollisionAt
(searchStartX, y, searchWidth, searchHeight, ~1, wallTree)
in
if
hasWallAhead
then EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else if canWalkAhead (searchStartX, y, wallTree, platformTree) then
if hasWallAhead then
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else if canWalkAhead (searchStartX, y, wallTree, platformTree) then
(* invert direction if moving further left
* will result in falling down *)
* will result in falling down *)
acc
else EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
end
| MOVE_RIGHT =>
let
@@ -88,22 +82,17 @@ struct
val searchWidth = Constants.moveEnemyBy
val searchHeight = Constants.enemySize - 5
val hasWallAhead = QuadHelp.hasCollisionAt
( searchStartX
, y
, searchWidth
, searchHeight
, wallTree
)
val hasWallAhead = QuadTree.hasCollisionAt
(searchStartX, y, searchWidth, searchHeight, ~1, wallTree)
in
if
hasWallAhead
then EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else if canWalkAhead (searchStartX, y, wallTree, platformTree) then
if hasWallAhead then
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else if canWalkAhead (searchStartX, y, wallTree, platformTree) then
(* invert direction if moving further right
* will result in falling down *)
* will result in falling down *)
acc
else EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
end
| STAY_STILL => acc
end
@@ -119,9 +108,9 @@ struct
in
(* platY < highestY is correct because lowest number = highest
* in * this case *)
if platY < highestY andalso checkY <= platY then
if platY < highestY andalso checkY <= platY then
getHighestPlatform (tl, platforms, platY, id, checkY)
else
else
getHighestPlatform (tl, platforms, highestY, highestID, checkY)
end
| [] => highestID
@@ -133,8 +122,8 @@ struct
val searchWidth = Constants.playerSize
val searchHeight = Constants.worldHeight - y
val collisions = QuadHelp.getCollisions
(x, y, searchWidth, searchHeight, platformTree)
val collisions = QuadTree.getCollisions
(x, y, searchWidth, searchHeight, ~1, platformTree)
val checkY = y + Constants.playerSize
val wh = Constants.worldHeight
@@ -151,8 +140,8 @@ struct
val y = y + Constants.enemySize
val collisions = QuadHelp.getCollisions
(x, y, searchWidth, searchHeight, platformTree)
val collisions = QuadTree.getCollisions
(x, y, searchWidth, searchHeight, ~1, platformTree)
val wh = Constants.worldHeight
in
getHighestPlatform (collisions, platforms, wh, ~1, y)
@@ -191,12 +180,12 @@ struct
ON_GROUND => EnemyPatch.W_Y_AXIS (JUMPING 0) :: acc
| FALLING => EnemyPatch.W_Y_AXIS (JUMPING 0) :: acc
| _ => acc
else
(* have to travel either left or right before jumping *)
if ecx < platX then
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else (* have to travel either left or right before jumping *) if
ecx < platX
then
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
acc
end
@@ -234,12 +223,12 @@ struct
ON_GROUND => EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM :: acc
| FALLING => EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM :: acc
| _ => acc
else
(* have to travel either left or right before jumping *)
if ecx < platX then
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else (* have to travel either left or right before jumping *) if
ecx < platX
then
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
acc
end
@@ -282,7 +271,7 @@ struct
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
end
else
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
end
else
(* platform is below or at same y coordinat as enemy
@@ -296,8 +285,8 @@ struct
in
if yDiff >= xDiff then
(* can reach next platform by simply dropping and moving right *)
EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM :: EnemyPatch.W_X_AXIS
MOVE_RIGHT :: acc
EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM
:: EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
else
let
val jumpAmt =
@@ -356,7 +345,7 @@ struct
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
end
else
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
end
else
(* platform is below or at same y coordinat as enemy
@@ -370,8 +359,8 @@ struct
in
if yDiff >= xDiff then
(* can reach next platform by simply dropping and moving right *)
EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM :: EnemyPatch.W_X_AXIS
MOVE_LEFT :: acc
EnemyPatch.W_Y_AXIS DROP_BELOW_PLATFORM
:: EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
let
val jumpAmt =
@@ -413,7 +402,7 @@ struct
getJumpPatches (nextPlatform, platformTree, enemy, acc)
else if canDrop then
getDropPatches (nextPlatform, platformTree, enemy, acc)
else
else
let
(* if can neither jump or drop to next platform vertically
* then remaining options are either jumping to the right or left.
@@ -439,16 +428,14 @@ struct
val efx = ex + Constants.enemySize
in
if isBetween (px, ex, pfx) andalso isBetween (px, efx, pfx) then
acc
else
acc
else
let
val startDiff = abs (px - ex)
val endDiff = abs (pfx - efx)
in
if startDiff > endDiff then
EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else
EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
if startDiff > endDiff then EnemyPatch.W_X_AXIS MOVE_LEFT :: acc
else EnemyPatch.W_X_AXIS MOVE_RIGHT :: acc
end
end
@@ -471,35 +458,25 @@ struct
in
if ey < py - 65 then
(* set to falling *)
EnemyPatch.W_NEXT_PLAT_ID ~1 ::
EnemyPatch.W_Y_AXIS FALLING ::
acc
EnemyPatch.W_NEXT_PLAT_ID ~1 :: EnemyPatch.W_Y_AXIS FALLING :: acc
else
acc
end
fun getLandingPatches (newPlatformID, platforms, enemy, acc) =
case #yAxis enemy of
JUMPING _ =>
getJumpLandingPatches (enemy, newPlatformID, platforms, acc)
| _ =>
getFallingPatches (enemy, newPlatformID, platforms, acc)
JUMPING _ => getJumpLandingPatches (enemy, newPlatformID, platforms, acc)
| _ => getFallingPatches (enemy, newPlatformID, platforms, acc)
fun getFollowPatches
fun getFollowPatches
(player: player, enemy, wallTree, platformTree, platforms, acc) =
let
(* todo: possibly get pID and eID of player/enemy in a different way *)
val pID = getPlatformBelowPlayer (player, platformTree, platforms)
val pID =
if pID = ~1 then
#platID player
else pID
val pID = if pID = ~1 then #platID player else pID
val eID = getPlatformBelowEnemy (enemy, platformTree, platforms)
val eID =
if eID = ~1 then
#platID enemy
else eID
val eID = if eID = ~1 then #platID enemy else eID
in
if eID = ~1 orelse pID = ~1 then
(* without checking that neither of these are ~1
@@ -521,7 +498,14 @@ struct
val acc = EnemyPatch.W_NEXT_PLAT_ID nextPlatformID :: acc
in
getPathToNextPlatform
(nextPlatformID, platforms, platformTree, enemy, eID, pID, acc)
( nextPlatformID
, platforms
, platformTree
, enemy
, eID
, pID
, acc
)
end
| [] => getPatrollPatches (enemy, wallTree, platformTree, acc)
end

6
fcore/enemy-patch.sml
View File

@@ -44,10 +44,12 @@ struct
case patch of
W_HEALTH health =>
mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_X x => mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_X x =>
mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_X_AXIS xAxis =>
mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_Y y => mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_Y y =>
mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_Y_AXIS yAxis =>
mkEnemy (id, health, x, y, xAxis, yAxis, variant, platID, nextPlatID)
| W_PLAT_ID platID =>

16
fcore/enemy.sml
View File

@@ -4,8 +4,7 @@ struct
fun withDefaultYAxis (enemy: enemy) =
case #yAxis enemy of
ON_GROUND =>
EnemyPatch.withPatch (enemy, EnemyPatch.W_Y_AXIS FALLING)
ON_GROUND => EnemyPatch.withPatch (enemy, EnemyPatch.W_Y_AXIS FALLING)
| _ => enemy
fun helpExists (pos, id, collisions) =
@@ -35,8 +34,8 @@ struct
val size = Constants.enemySize
val hasCollision = QuadHelp.hasCollisionAt
(x, y, size, size, projectileTree)
val hasCollision = QuadTree.hasCollisionAt
(x, y, size, size, ~1, projectileTree)
in
if hasCollision then
if health = 1 then
@@ -181,12 +180,17 @@ struct
val size = Constants.enemySize
val acc = QuadHelp.insert (x, y, size, size, id, acc)
val acc = QuadTree.insert (x, y, size, size, id, acc)
in
helpGenerateTree (pos + 1, enemyVec, acc)
end
fun generateTree enemyVec = helpGenerateTree (0, enemyVec, QuadTree.empty)
fun generateTree enemyVec =
helpGenerateTree
( 0
, enemyVec
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
fun helpFind (findNum, vec: enemy vector, low, high) =
(* should only be called when we know enemy already exists in vec *)

24
fcore/game-type.sml
View File

@@ -188,10 +188,26 @@ struct
val plat18 = {id = 18, x = 155, y = 499, width = 199}
val plat19 = {id = 19, x = 155, y = 399, width = 199}
val platforms = Vector.fromList
[plat1, plat2, plat3, plat4, plat5, plat6, plat7, plat8, plat9, plat10,
plat11, plat12, plat13
, plat14, plat15, plat16, plat17, plat18,
plat19]
[ plat1
, plat2
, plat3
, plat4
, plat5
, plat6
, plat7
, plat8
, plat9
, plat10
, plat11
, plat12
, plat13
, plat14
, plat15
, plat16
, plat17
, plat18
, plat19
]
val platformTree = Platform.generateTree platforms
val enemy1 =

57
fcore/physics.sml
View File

@@ -84,7 +84,7 @@ struct
val ww = Constants.worldWidth
val wh = Constants.worldHeight
in
QuadHelp.hasCollisionAt (x, y, width, height, tree)
QuadTree.hasCollisionAt (x, y, width, height, ~1, tree)
end
fun standingOnAreaID (x, y, tree) =
@@ -109,10 +109,10 @@ struct
val wh = Constants.worldHeight
val _ = print "START getItemID\n"
val r =
QuadHelp.getItemID (x, y, width, height, tree)
val r = QuadTree.getItemID (x, y, width, height, tree)
val _ = print "FINISH getItemID\n"
in r
in
r
end
fun getWallPatches (x, y, walls, wallTree, acc) =
@@ -125,8 +125,7 @@ struct
(* check collision with wall to the left *)
val acc =
let
val leftWallID = QuadHelp.getItemID
(x - 1, y, 1, 1, wallTree)
val leftWallID = QuadTree.getItemID (x - 1, y, 1, 1, wallTree)
in
if leftWallID <> ~1 then
let
@@ -144,8 +143,7 @@ struct
(* check collision with wall to the right *)
val acc =
let
val rightWallID = QuadHelp.getItemID
(x + size - 1, y, 1, 1, wallTree)
val rightWallID = QuadTree.getItemID (x + size - 1, y, 1, 1, wallTree)
in
if rightWallID <> ~1 then
let
@@ -160,7 +158,7 @@ struct
end
(* check collision with wall below *)
val downWallID = QuadHelp.getItemID
val downWallID = QuadTree.getItemID
(x + moveBy + 1, y + size, 1, 1, wallTree)
in
if downWallID <> ~1 then
@@ -193,22 +191,24 @@ struct
val acc =
if platID <> ~1 then
(print ("platID: " ^ Int.toString platID ^ "\n"); case yAxis of
JUMPING _ =>
(* pass through, allowing player to jump above the platform *)
acc
| _ =>
let
(* default case:
* player will land on platform and stay on the ground there. *)
val {y = platY, ...}: GameType.platform =
Vector.sub (platforms, platID - 1)
( print ("platID: " ^ Int.toString platID ^ "\n")
; case yAxis of
JUMPING _ =>
(* pass through, allowing player to jump above the platform *)
acc
| _ =>
let
(* default case:
* player will land on platform and stay on the ground there. *)
val {y = platY, ...}: GameType.platform =
Vector.sub (platforms, platID - 1)
val newY = platY - Fn.entitySize
val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
in
acc
end)
val newY = platY - Fn.entitySize
val acc = Fn.W_Y_AXIS ON_GROUND :: Fn.W_Y newY :: acc
in
acc
end
)
else
acc
@@ -221,11 +221,10 @@ struct
* then set new yAxis to FALLING
* so we do not drop below any platforms again
* *)
if
QuadHelp.hasCollisionAt
(x, y, size, size, platformTree)
then acc
else Fn.W_Y_AXIS FALLING :: acc
if QuadTree.hasCollisionAt (x, y, size, size, ~1, platformTree) then
acc
else
Fn.W_Y_AXIS FALLING :: acc
| _ => acc
val acc = getWallPatches (x, y, walls, wallTree, acc)

10
fcore/platform.sml
View File

@@ -11,13 +11,17 @@ struct
else
let
val {id, x, y, width} = Vector.sub (platVec, pos)
val acc = QuadHelp.insert
(x, y, width, platHeight, id, acc)
val acc = QuadTree.insert (x, y, width, platHeight, id, acc)
in
helpGenerateTree (pos + 1, platVec, acc)
end
fun generateTree platVec = helpGenerateTree (0, platVec, QuadTree.empty)
fun generateTree platVec =
helpGenerateTree
( 0
, platVec
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
fun helpFind (findNum, vec, low, high) =
let

8
fcore/player-enemy.sml
View File

@@ -47,8 +47,8 @@ struct
(case attacked of
NOT_ATTACKED =>
let
val enemyCollisions = QuadHelp.getCollisions
(x, y, size, size, enemyTree)
val enemyCollisions = QuadTree.getCollisions
(x, y, size, size, ~1, enemyTree)
val player =
Player.enemyCollisionReaction
@@ -72,8 +72,8 @@ struct
if amt = Constants.attackedLimit then
(* if reached limit, detect enemies again *)
let
val enemyCollisions = QuadHelp.getCollisions
(x, y, size, size, enemyTree)
val enemyCollisions = QuadTree.getCollisions
(x, y, size, size, ~1, enemyTree)
val player =
Player.exitAttackedAndCheckEnemies

9
fcore/player.sml
View File

@@ -320,8 +320,9 @@ struct
let
val player = #player game
val _ = print ("(playerX, playerY) = (" ^Int.toString (#x player) ^ ", " ^
Int.toString (#y player) ^ ")\n")
val _ = print
("(playerX, playerY) = (" ^ Int.toString (#x player) ^ ", "
^ Int.toString (#y player) ^ ")\n")
val patches = getProjectilePatches player
val player = PlayerPatch.withPatches (player, patches)
@@ -430,8 +431,8 @@ struct
val ww = Constants.worldWidth
val wh = Constants.worldHeight
val enemyCollisions = QuadHelp.getCollisions
(x, y, size, size, enemyTree)
val enemyCollisions = QuadTree.getCollisions
(x, y, size, size, ~1, enemyTree)
in
Vector.fromList enemyCollisions
end

8
fcore/projectile.sml
View File

@@ -11,13 +11,17 @@ struct
val size = projectileSizeInt
val {x, y, facing = _} = Vector.sub (projectiles, pos)
val acc = QuadHelp.insert (x, y, size, size, pos, acc)
val acc = QuadTree.insert (x, y, size, size, pos, acc)
in
helpGenerateTree (pos + 1, projectiles, acc)
end
fun generateTree projectiles =
helpGenerateTree (0, projectiles, QuadTree.empty)
helpGenerateTree
( 0
, projectiles
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
fun helpGetProjectileVec
(pos, projectiles, width, height, ratio, xOffset, yOffset, acc) =

305
fcore/quad-tree.sml
View File

@@ -8,21 +8,15 @@ sig
| QUERY_ON_RIGHT_SIDE
| QUERY_ON_BOTTOM_SIDE
val insert: int * int * int * int *
int * t -> t
val insert: int * int * int * int * int * t -> t
val getCollisions: int * int * int * int *
int * t -> int list
val getCollisions: int * int * int * int * int * t -> int list
val helpGetCollisions: int * int * int * int *
int * int list * t
-> int list
val helpGetCollisions: int * int * int * int * int * int list * t -> int list
val hasCollisionAt: int * int * int * int *
int * t -> bool
val hasCollisionAt: int * int * int * int * int * t -> bool
val getItemID: int * int * int * int *
t -> int
val getItemID: int * int * int * int * t -> int
val create: int * int -> t
end
@@ -34,29 +28,20 @@ struct
type item = QuadTreeType.item
fun create (width, height) =
LEAF {
items = Vector.fromList [],
x = 0,
y = 0,
w = width,
h = 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
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
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
@@ -82,7 +67,7 @@ struct
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
@@ -99,7 +84,7 @@ struct
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
@@ -116,7 +101,7 @@ struct
val ifx = iX + iW
val ify = iY + iH
val qmx = qX + hw
val qmy = qY + hh
@@ -145,13 +130,7 @@ struct
val hw = w div 2
val hh = h div 2
in
LEAF {
items = items,
x = x,
y = y,
w = hw,
h = hh
}
LEAF {items = items, x = x, y = y, w = hw, h = hh}
end
fun mkTopRight (x, y, w, h, items) =
@@ -161,13 +140,7 @@ struct
val hh = h div 2
val x = x + hw
in
LEAF {
items = items,
x = x,
y = y,
w = hw,
h = hh
}
LEAF {items = items, x = x, y = y, w = hw, h = hh}
end
fun mkBottomLeft (x, y, w, h, items) =
@@ -177,13 +150,7 @@ struct
val hh = h div 2
val y = y + hh
in
LEAF {
items = items,
x = x,
y = y,
w = hw,
h = hh
}
LEAF {items = items, x = x, y = y, w = hw, h = hh}
end
fun mkBottomRight (x, y, w, h, items) =
@@ -194,17 +161,21 @@ struct
val x = x + hw
val y = y + hh
in
LEAF {
items = items,
x = x,
y = y,
w = hw,
h = hh
}
LEAF {items = items, x = x, y = y, w = hw, h = hh}
end
fun splitLeaf (x, y, w, h, tl: item list, tr: item list, bl: item list, br:
item list, elements, pos) =
fun splitLeaf
( x
, y
, w
, h
, tl: item list
, tr: item list
, bl: item list
, br: item list
, elements
, pos
) =
if pos < 0 then
let
val tl = mkTopLeft (x, y, w, h, tl)
@@ -247,22 +218,29 @@ struct
fun insert (iX, iY, iW, iH, itemID, tree: t) =
case tree of
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
let
(* we are not necessarily inserting into all nodes.
* If isCollidingPlus returns false recursively,
* we return the same node back. *)
val tl = insert (iX, iY, iW, iH, itemID, topLeft)
val tr = insert (iX, iY, iW, iH, itemID, topRight)
val bl = insert (iX, iY, iW, iH, itemID, bottomLeft)
val br = insert (iX, iY, iW, iH, itemID, bottomRight)
in
NODE {topLeft = tl, topRight = tr, bottomLeft = bl, bottomRight = br
, x = x, y = y, w = w, h = h
}
end
else
tree
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
let
(* we are not necessarily inserting into all nodes.
* If isCollidingPlus returns false recursively,
* we return the same node back. *)
val tl = insert (iX, iY, iW, iH, itemID, topLeft)
val tr = insert (iX, iY, iW, iH, itemID, topRight)
val bl = insert (iX, iY, iW, iH, itemID, bottomLeft)
val br = insert (iX, iY, iW, iH, itemID, bottomRight)
in
NODE
{ topLeft = tl
, topRight = tr
, bottomLeft = bl
, bottomRight = br
, x = x
, y = y
, w = w
, h = h
}
end
else
tree
| LEAF {items, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
if Vector.length items + 1 > maxSize then
@@ -284,18 +262,7 @@ struct
val br = if vbr then [item] else []
in
splitLeaf
( x
, y
, w
, h
, tl
, tr
, bl
, br
, items
, pos
)
splitLeaf (x, y, w, h, tl, tr, bl, br, items, pos)
end
else
(* can insert itemID in items vector *)
@@ -305,19 +272,23 @@ struct
in
LEAF {items = items, x = x, y = y, w = w, h = h}
end
else
else
(* bounds of new item don't fit inside leaf so return old tree *)
tree
fun isColliding (iX, iY, iW, iH, itemID, checkWith: item) =
let
val {itemID = checkID, startX = cX, startY = cY, width = cW, height = cH, ...} = checkWith
val
{ itemID = checkID
, startX = cX
, startY = cY
, width = cW
, height = cH
, ...
} = checkWith
in
iX < cX + cW andalso
iX + iW > cX andalso
iY < cY + cH andalso
iY + iH > cY andalso
itemID <> checkID
iX < cX + cW andalso iX + iW > cX andalso iY < cY + cH
andalso iY + iH > cY andalso itemID <> checkID
end
fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) =
@@ -338,93 +309,46 @@ struct
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
let
val acc = getCollisionsAll
(iX, iY, iW, iH, itemID, acc, topLeft)
val acc = getCollisionsAll (iX, iY, iW, iH, itemID, acc, topLeft)
val acc = getCollisionsAll
(iX, iY, iW, iH, itemID, acc, topRight)
val acc = getCollisionsAll (iX, iY, iW, iH, itemID, acc, topRight)
val acc = getCollisionsAll
(iX, iY, iW, iH, itemID, acc, bottomLeft)
val acc = getCollisionsAll (iX, iY, iW, iH, itemID, acc, bottomLeft)
in
getCollisionsAll
(iX, iY, iW, iH, itemID, acc, bottomRight)
getCollisionsAll (iX, iY, iW, iH, itemID, acc, bottomRight)
end
else
acc
| LEAF {items, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
getCollisionsVec (iX, iY, iW, iH, itemID, 0, items, acc)
else acc
fun helpGetCollisions
( iX
, iY
, iW
, iH
, itemID
, acc
, tree: t
) =
case tree of
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
let
val acc =
helpGetCollisions
(iX, iY, iW, iH, itemID, acc, topLeft)
val acc =
helpGetCollisions
(iX, iY, iW, iH, itemID, acc, topRight)
val acc =
helpGetCollisions
( iX
, iY
, iW
, iH
, itemID
, acc
, bottomLeft
)
in
helpGetCollisions
( iX
, iY
, iW
, iH
, itemID
, acc
, bottomRight
)
end
else
acc
| LEAF {items, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
getCollisionsVec
(iX, iY, iW, iH, itemID, 0, items, acc)
else
acc
fun getCollisions
( itemX
, itemY
, itemWidth
, itemHeight
, itemID
, tree
) =
helpGetCollisions
( itemX
, itemY
, itemWidth
, itemHeight
, itemID
, []
, tree
)
fun helpGetCollisions (iX, iY, iW, iH, itemID, acc, tree: t) =
case tree of
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
let
val acc = helpGetCollisions (iX, iY, iW, iH, itemID, acc, topLeft)
val acc = helpGetCollisions (iX, iY, iW, iH, itemID, acc, topRight)
val acc = helpGetCollisions
(iX, iY, iW, iH, itemID, acc, bottomLeft)
in
helpGetCollisions (iX, iY, iW, iH, itemID, acc, bottomRight)
end
else
acc
| LEAF {items, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
getCollisionsVec (iX, iY, iW, iH, itemID, 0, items, acc)
else
acc
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
@@ -481,38 +405,25 @@ struct
let
val item = Vector.sub (elements, pos)
in
isColliding (iX, iY, iW, iH, itemID, item) orelse
hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
isColliding (iX, iY, iW, iH, itemID, item)
orelse hasCollisionAtVec (iX, iY, iW, iH, itemID, pos + 1, elements)
end
fun hasCollisionAt
( iX
, iY
, iW
, iH
, itemID
, tree
) =
fun hasCollisionAt (iX, iY, iW, iH, itemID, tree) =
case tree of
NODE {topLeft, topRight, bottomLeft, bottomRight, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
hasCollisionAt
(iX, iY, iW, iH, itemID, topLeft)
orelse
hasCollisionAt
(iX, iY, iW, iH, itemID, topRight)
orelse
hasCollisionAt
(iX, iY, iW, iH, itemID, bottomLeft)
orelse
hasCollisionAt
(iX, iY, iW, iH, itemID, bottomRight)
else
hasCollisionAt (iX, iY, iW, iH, itemID, topLeft)
orelse hasCollisionAt (iX, iY, iW, iH, itemID, topRight)
orelse hasCollisionAt (iX, iY, iW, iH, itemID, bottomLeft)
orelse hasCollisionAt (iX, iY, iW, iH, itemID, bottomRight)
else
false
| LEAF {items, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
hasCollisionAtVec (iX, iY, iW, iH, itemID, 0, items)
else false
else
false
fun getItemIDVec (iX, iY, iW, iH, pos, elements) =
if pos = Vector.length elements then
@@ -545,7 +456,7 @@ struct
end
else
~1
| LEAF {items, x, y, w, h} =>
| LEAF {items, x, y, w, h} =>
if isCollidingPlus (iX, iY, iW, iH, x, y, w, h) then
getItemIDVec (iX, iY, iW, iH, 0, items)
else

10
fcore/wall.sml
View File

@@ -6,13 +6,17 @@ struct
else
let
val {id, x, y, width, height} = Vector.sub (wallVec, pos)
val acc = QuadHelp.insert
(x, y, width, height, id, acc)
val acc = QuadTree.insert (x, y, width, height, id, acc)
in
helpGenerateTree (pos + 1, wallVec, acc)
end
fun generateTree wallVec = helpGenerateTree (0, wallVec, QuadTree.empty)
fun generateTree wallVec =
helpGenerateTree
( 0
, wallVec
, QuadTree.create (Constants.worldWidth, Constants.worldHeight)
)
fun helpGetDrawVecWider
(pos, wallVec, acc, winWidth, winHeight, ratio, yOffset) =

2
ffi/export.h
View File

@@ -157,6 +157,8 @@ typedef Pointer Objptr;
extern "C" {
#endif
MLLIB_PUBLIC(void mltonKeyCallback (Int32 x0, Int32 x1, Int32 x2, Int32 x3);)
MLLIB_PUBLIC(void mltonFramebufferSizeCallback (Real32 x0, Real32 x1);)
#undef MLLIB_PRIVATE
#undef MLLIB_PUBLIC