justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Replace buggy circle seg intersection with a simpler test

Browse Source
This commit is contained in:
justin
2024-12-26 21:53:18 +00:00
parent 91ba6ee148
commit 0ef28c132e
29 changed files with 528 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+8 -4
View File
@@ -147,9 +147,13 @@ overlapCircWalls p r = mapMaybe dointersect
f (a, b) = intersectSegSeg p (p +.+ r *.* normalizeV ((0.5 *.* (a +.+ b)) -.- p)) a b
circHitWall :: Point2 -> Point2 -> Float -> World -> Bool
circHitWall sp ep r w = any (uncurry (intersectSegSegTest sp ep) . _wlLine)
(wlsNearSeg sp ep w)
circHitWall sp ep r w = any (uncurry (intersectSegSegTest xsp xep) . _wlLine)
(wlsNearSeg xsp xep w)
|| circOnSomeWall ep r w
where
x = r *.* normalizeV (ep - sp)
xsp = sp - x
xep = ep + x
-- | note that this does not push the circle away from the wall at all
collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
@@ -241,7 +245,6 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
--anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
where
x = rad *.* normalizeV (ep - sp)
@@ -251,7 +254,8 @@ anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
f cid bl =
maybe
False
(\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
--(\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
(\cr -> intersectCircSegTest (_crPos cr) (rad + _crRad cr) sp ep)
(w ^? cWorld . lWorld . creatures . ix cid)
|| bl
-- hitWl = collideCircWalls sp ep rad $ wlsNearSeg xsp xep w