This commit is contained in:
2025-10-17 09:58:37 +01:00
parent 5ba642c20a
commit c533e88d24
+17 -16
View File
@@ -18,7 +18,6 @@ module Dodge.Base.Collide (
collideCircWalls,
overlapSegWalls,
overlapSegCrs,
-- bounceBall,
bouncePoint,
circOnSomeWall,
circOnAnyCr,
@@ -37,12 +36,12 @@ module Dodge.Base.Collide (
collide3,
) where
import Data.Monoid
import Control.Lens
import Control.Monad
import qualified Data.IntSet as IS
import Data.List (sortOn)
import Data.Maybe
import Data.Monoid
import Dodge.Base.Wall
import Dodge.Creature.Radius
import Dodge.Data.Object
@@ -261,10 +260,6 @@ collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
. shiftbyrad
. _wlLine
$ wl
-- shiftbyrad (a, b) =
-- ( a +.+ rad *.* normalizeV (a -.- b)
-- , b +.+ rad *.* normalizeV (b -.- a)
-- )
shiftbyrad (a, b) =
bimap
f
@@ -299,7 +294,12 @@ circOnAnyCr :: Point2 -> Float -> World -> Bool
{-# INLINE circOnAnyCr #-}
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
where
f cid bl = maybe False (\cr -> dist p (cr ^. crPos . _xy) < r + crRad (cr ^. crType)) (w ^? cWorld . lWorld . creatures . ix cid) || bl
f cid bl =
maybe
False
(\cr -> dist p (cr ^. crPos . _xy) < r + crRad (cr ^. crType))
(w ^? cWorld . lWorld . creatures . ix cid)
|| bl
-- | More general collision tests follow
hasLOS :: Point2 -> Point2 -> World -> Bool
@@ -325,13 +325,16 @@ hasLOSIndirect p1 p2 =
. collidePointTestFilter wlIsOpaque p1 p2
. wlsNearSeg p1 p2
isFlyable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isFlyable #-}
isFlyable p1 p2 =
not
. collidePointTestFilter (not . (^?! wlPathable)) p1 p2
. wlsNearSeg p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool
{-# INLINE isWalkable #-}
isWalkable p1 p2 w =
(not
. collidePointTestFilter (not . (^?! wlPathable)) p1 p2
. wlsNearSeg p1 p2 $ w)
&& not (getAny $ foldMap f (w ^. cWorld . chasms))
isWalkable p1 p2 w = isFlyable p1 p2 w && not (getAny $ foldMap f (w ^. cWorld . chasms))
where
f = foldMap (Any . isJust . uncurry (intersectSegSeg p1 p2)) . loopPairs
@@ -339,8 +342,8 @@ canSee :: Int -> Int -> World -> Bool
{-# INLINE canSee #-}
canSee i j w = hasLOS p1 p2 w
where
p1 = w ^?! cWorld . lWorld . creatures . ix i . crPos . _xy -- _crPos (_creatures (_cWorld w) IM.! i)
p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos . _xy -- _crPos (_creatures (_cWorld w) IM.! j) -- unsafe
p1 = w ^?! cWorld . lWorld . creatures . ix i . crPos . _xy
p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos . _xy
canSeeIndirect :: Int -> Int -> World -> Bool
{-# INLINE canSeeIndirect #-}
@@ -362,5 +365,3 @@ anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
(\cr -> intersectCircSegTest (cr ^. crPos . _xy) (rad + crRad (cr ^. crType)) sp ep)
(w ^? cWorld . lWorld . creatures . ix cid)
|| bl
-- this should probably be wallsOnLine or something