Fix more edge cases in circle collision

src/Dodge/Base/Collide.hs

@@ -18,7 +18,7 @@ module Dodge.Base.Collide (
     collideCircWalls,
     overlapSegWalls,
     overlapSegCrs,
-    bounceBall,
+--    bounceBall,
     bouncePoint,
     circOnSomeWall,
     circOnAnyCr,
@@ -75,15 +75,15 @@ doBounce x sp ep (p, mwl) =
         , reflVelWallDamp x wl (ep -.- sp)
         )
 
-bounceBall ::
-    Float ->
-    Point2 ->
-    Point2 ->
-    Float ->
-    [Wall] ->
-    Maybe (Point2, Point2)
-{-# INLINE bounceBall #-}
-bounceBall x sp ep r = doBounce x sp ep . collideCircWalls sp ep r
+--bounceBall ::
+--    Float ->
+--    Point2 ->
+--    Point2 ->
+--    Float ->
+--    [Wall] ->
+--    Maybe (Point2, Point2)
+--{-# INLINE bounceBall #-}
+--bounceBall x sp ep r = doBounce x sp ep . collideCircWalls sp ep r
 
 bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2, Point2)
 {-# INLINE bouncePoint #-}
@@ -146,6 +146,11 @@ overlapCircWalls p r = mapMaybe dointersect
     dointersect wl = f (_wlLine wl) <&> (,wl)
     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)
+    || any (uncurry (circOnSeg ep r) . _wlLine) (wlsNearPoint ep w)
+
 -- | note that this does not push the circle away from the wall at all
 collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
 {-# INLINE collideCircWalls #-}
@@ -241,7 +246,8 @@ 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 || isJust (sequence hitWl)
+anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
   where
     x = rad *.* normalizeV (ep - sp)
     xsp = sp - x
@@ -253,6 +259,6 @@ anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
             (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
             (w ^? cWorld . lWorld . creatures . ix cid)
             || bl
-    hitWl = collideCircWalls sp ep rad $ wlsNearSeg xsp xep w
+--    hitWl = collideCircWalls sp ep rad $ wlsNearSeg xsp xep w
 
 -- this should probably be wallsOnLine or something