diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 332545a2b..8c878956b 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -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