Clarify circle segment intersection

This commit is contained in:
2025-10-11 11:13:35 +01:00
parent 49fb982877
commit 4949d98789
4 changed files with 28 additions and 21 deletions
+5 -5
View File
@@ -53,15 +53,16 @@ import Geometry
collidePoint :: Point2 -> Point2 -> [Wall] -> (Point2, Maybe Wall)
{-# INLINE collidePoint #-}
collidePoint sp ep = foldl' findPoint (ep, Nothing)
collidePoint sp ep = foldl' f (ep, Nothing)
where
findPoint (p, mwl) wl = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
f (p, mwl) wl
= maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
overlapSegCrs :: Point2 -> Point2 -> [Creature] -> [(Point2, Creature)]
{-# INLINE overlapSegCrs #-}
overlapSegCrs sp ep =
mapMaybe
(\cr -> (,cr) <$> listToMaybe (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep))
(\cr -> (,cr) <$> fst (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep))
doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
{-# INLINE doBounce #-}
@@ -126,10 +127,9 @@ collide3 sp ep w =
-- Just (hitpoint,normaltosurface)
collide3Walls :: Point3 -> World -> (Point3, MPO) -> (Point3, MPO)
collide3Walls sp w e@(ep, _) = foldl' f e wls
collide3Walls sp w e@(ep, _) = foldl' f e $ wlsNearSeg (xyV3 sp) (xyV3 ep) w
where
f x wl = collide3Wall sp wl x
wls = wlsNearSeg (xyV3 sp) (xyV3 ep) w
collide3Floors ::
Point3 ->