diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 8cec530a8..718acbdad 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -15,12 +15,8 @@ module Dodge.Base.Collide , collidePointTestFilter , bounceBall , bouncePoint - , ssfold - , collidePointUpToIndirectMinDist - , wlIsOpaque - , wlIsSeeThrough - , wallsOnCirc - , wallsOnCirc' +-- , wallsOnCirc +-- , wallsOnCirc' , wallsOnLineHit , collideCircWallsStream , collideCircWalls @@ -120,37 +116,12 @@ allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) where vPos = _cameraViewFrom w -collidePointUpToIndirectMinDist - :: Point2 -- ^start point - -> Point2 -- ^end point - -> Float -- ^minimal possible distance - -> IM.IntMap Wall - -> Point2 -{-# INLINE collidePointUpToIndirectMinDist #-} -collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter wlIsOpaque - where - f x wl = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl - prop p3 = dist p1 p3 < md - --- from haskell-cafe --- short circuit a fold when a given property is satisfied --- the fold builds a function that is then called on a0 -ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a -{-# INLINABLE ssfold #-} -ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0 - wallsOnLineHit :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall) wallsOnLineHit p1 p2 = IM.mapMaybe f where f wl = uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> (, wl) -wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall -wallsOnCirc p r = IM.filter (uncurry (circOnSeg p r) . _wlLine) - -wallsOnCirc' :: Point2 -> Float -> [Wall] -> [Wall] -wallsOnCirc' p r = filter $ uncurry (circOnSeg p r) . _wlLine - -- | Looks for any collision of a circle with walls. -- If found, gives point and reflection velocity, reflection damped in normal. -- note that in this version the circle can overlap the wall diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index f66d8822b..38112e338 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -1,7 +1,7 @@ module Dodge.Debug.Picture where import Dodge.Data import Dodge.Base.Window -import Dodge.Base.Collide +import Dodge.Base.Wall import Geometry import Picture diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index a49c7da33..fbdf4d7a0 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -3,7 +3,7 @@ module Dodge.Render.Walls ) where import Dodge.Data import Dodge.Zone -import Dodge.Base.Collide +import Dodge.Base.Wall import Geometry import ShapePicture diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 87e4e3c11..a34d68d19 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -110,8 +110,8 @@ moveInverseShockwave w pt r = _ptRad pt t = _ptTimer pt rad = r - 0.1 * r * fromIntegral (10 - t) - dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks - hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w + dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks +-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w damCr cr | dist (_crPos cr) p >= rad + _crRad cr = cr | otherwise = cr & crState . csDamage .:~ diff --git a/src/FoldableHelp.hs b/src/FoldableHelp.hs index bd604f1da..4ad1da0ae 100644 --- a/src/FoldableHelp.hs +++ b/src/FoldableHelp.hs @@ -7,6 +7,7 @@ module FoldableHelp , safeMinMaybeL , filter3 , takeUntil + , ssfold , module Data.Foldable ) where @@ -91,3 +92,11 @@ filter3 t1 t2 t3 = L.fold $ (,,) -} takeUntil :: Foldable t => (a -> Bool) -> t a -> [a] takeUntil p = foldr (\x xs -> x : if p x then [] else xs) [] + +-- from haskell-cafe +-- short circuit a fold when a given property is satisfied +-- the fold builds a function that is then called on a0 +ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a +{-# INLINABLE ssfold #-} +ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0 +