diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index d3d370ff6..1184f9004 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -13,17 +13,12 @@ -} module Dodge.Base.Collide ( collidePoint, - collideSegCrs, - collidePointWallsFilterStream, + collidePointWallsFilter, collidePointTestFilter, overlapSegWalls, overlapSegCrs, - overlap1SegCrs, bounceBall, bouncePoint, - sortStreamOn, - minStreamOn, - collideCircWallsStream, circOnSomeWall, circOnAnyCr, overlapCircWalls, @@ -49,16 +44,6 @@ import Dodge.Zoning import FoldableHelp import Geometry import qualified IntMapHelp as IM -import qualified Streaming.Prelude as S -import StreamingHelp - ---collidePoint :: Point2 -> Point2 --- -> StreamOf Wall --- -> (Point2, Maybe Wall) ---{-# INLINE collidePoint #-} ---collidePoint sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id --- where --- findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl collidePoint :: Point2 -> @@ -70,39 +55,15 @@ collidePoint sp ep = foldl' findPoint (ep, Nothing) where findPoint (p, mwl) wl = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl -overlap1SegCrs :: +overlapSegCrs :: Point2 -> Point2 -> [Creature] -> [(Point2, Creature)] -{-# INLINE overlap1SegCrs #-} -overlap1SegCrs sp ep = - mapMaybe - (\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep)) - -overlapSegCrs :: - Point2 -> - Point2 -> - StreamOf Creature -> - StreamOf ([Point2], Creature) {-# INLINE overlapSegCrs #-} overlapSegCrs sp ep = - S.mapMaybe - (\cr -> f cr $ intersectCircSeg (_crPos cr) (_crRad cr) sp ep) - where - f _ [] = Nothing - f cr ps = Just (ps, cr) - -collideSegCrs :: - Point2 -> - Point2 -> - StreamOf Creature -> - (Point2, Maybe Creature) -{-# INLINE collideSegCrs #-} -collideSegCrs sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id - where - findPoint (p, mcr) cr = - maybe (p, mcr) (,Just cr) $ listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp p) + mapMaybe + (\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep)) doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2) {-# INLINE doBounce #-} @@ -124,7 +85,7 @@ 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 #-} -bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilterStream t sp ep +bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilter t sp ep -- this COULD be written in terms of collidePointWallsFilterStream, TODO test -- whether this is actually faster @@ -142,9 +103,9 @@ collidePointTestFilter t sp ep = -- . S.any_ (isJust . uncurry (intersectSegSeg sp ep) . _wlLine) -- . S.filter t -collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall) -{-# INLINE collidePointWallsFilterStream #-} -collidePointWallsFilterStream t sp ep = +collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall) +{-# INLINE collidePointWallsFilter #-} +collidePointWallsFilter t sp ep = collidePoint sp ep . filter t . wlsNearSeg sp ep @@ -225,31 +186,6 @@ collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing) where f = (+.+) (rad *.* normalizeV (vNormal $ a -.- b)) --- | note that this does not push the circle away from the wall at all -collideCircWallsStream :: - Point2 -> - Point2 -> - Float -> - StreamOf Wall -> - (Point2, Maybe Wall) -{-# INLINE collideCircWallsStream #-} -collideCircWallsStream sp ep rad = runIdentity . S.fold_ findPoint (ep, Nothing) id - where - findPoint (p, mwl) wl = - maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) - . shiftbyrad - . _wlLine - $ wl - shiftbyrad (a, b) = - bimap - f - f - ( a +.+ rad *.* normalizeV (a -.- b) - , b +.+ rad *.* normalizeV (b -.- a) - ) - where - f = (+.+) (rad *.* normalizeV (vNormal $ a -.- b)) - overlapCircWallsClosest :: Point2 -> Float -> [Wall] -> Maybe (Point2, Wall) {-# INLINE overlapCircWallsClosest #-} overlapCircWallsClosest p r = diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 6178d204d..beef6b15b 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -17,7 +17,7 @@ import Geometry import qualified IntMapHelp as IM import LensHelp import qualified ListHelp as List -import StreamingHelp +import Data.Bifunctor updateBullet :: World -> Bullet -> (World, Maybe Bullet) updateBullet w bu = case _buDelayFraction bu of diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 0dfd89717..eac196d33 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -209,7 +209,7 @@ unsafeBlinkAction cr w .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect where success = fromMaybe True $ do - wl <- snd $ collidePointWallsFilterStream (const True) mwp cpos w + wl <- snd $ collidePointWallsFilter (const True) mwp cpos w return (isLHS mwp `uncurry` _wlLine wl) distR = 120 distortionBulge = diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index d79f43c78..daf4e9b34 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -24,7 +24,6 @@ import Dodge.Data.SoundOrigin import Geometry.Data import SDL (MouseButton, Scancode) import Sound.Data -import StreamingHelp import System.Random data World = World @@ -59,10 +58,4 @@ data WorldHammer | DoubleMouseHam deriving (Eq, Ord, Show, Read, Enum, Bounded) -type HitEffect' = - Flame -> - StreamOf (Point2, Either Creature Wall) -> - World -> - (World, Maybe Flame) - makeLenses ''World diff --git a/src/Dodge/Data/Zoning.hs b/src/Dodge/Data/Zoning.hs index 74158a76b..4adfd27ce 100644 --- a/src/Dodge/Data/Zoning.hs +++ b/src/Dodge/Data/Zoning.hs @@ -1,7 +1,8 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} -module Dodge.Data.Zoning where +module Dodge.Data.Zoning + where import Control.Lens import qualified Data.IntSet as IS diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 1bf7ca6d0..5905e98ef 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -206,7 +206,7 @@ aTractorBeam _ cr w = w & cWorld . tractorBeams .:~ tractorBeamAt spos outpos di spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir xpos = cpos +.+ 400 *.* unitVectorAtAngle dir dir = _crDir cr - outpos = fst $ collidePointWallsFilterStream (const True) cpos xpos w + outpos = fst $ collidePointWallsFilter (const True) cpos xpos w power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam diff --git a/src/Dodge/Item/Weapon/Shatter.hs b/src/Dodge/Item/Weapon/Shatter.hs index 41897eff4..13e54328e 100644 --- a/src/Dodge/Item/Weapon/Shatter.hs +++ b/src/Dodge/Item/Weapon/Shatter.hs @@ -13,7 +13,7 @@ shootShatter :: Item -> Creature -> World -> World shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ sequence $ - collidePointWallsFilterStream canshatter sp ep w + collidePointWallsFilter canshatter sp ep w where canshatter wl = case _wlOpacity wl of Opaque -> True diff --git a/src/Dodge/LoadSeed.hs b/src/Dodge/LoadSeed.hs index e8c116a83..75671664e 100644 --- a/src/Dodge/LoadSeed.hs +++ b/src/Dodge/LoadSeed.hs @@ -1,11 +1,12 @@ -module Dodge.LoadSeed - where +module Dodge.LoadSeed where + +import Data.Functor import System.Directory import Text.Read loadSeed :: IO (Maybe Int) -loadSeed = maybeReadFile "saveSlot/seed" >>= (return . (>>= readMaybe)) - +loadSeed = maybeReadFile "saveSlot/seed" <&> (>>= readMaybe) + maybeReadFile :: String -> IO (Maybe String) maybeReadFile fpath = do fexists <- doesFileExist fpath diff --git a/src/Dodge/Tesla/Arc/Default.hs b/src/Dodge/Tesla/Arc/Default.hs index b96ec68b9..ec5b9324c 100644 --- a/src/Dodge/Tesla/Arc/Default.hs +++ b/src/Dodge/Tesla/Arc/Default.hs @@ -35,7 +35,7 @@ defaultArcStep itparams w (ArcStep p dir _) = do mwl = listToMaybe . sortOn (dist p . fst) - . mapMaybe (\q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w) + . mapMaybe (\q -> sequence $ collidePointWallsFilter (const True) p (center +.+ q) w) -- collidePointWallsWall and wlsnearpoint $ polyCirc 6 csize f (q, wl) = ArcStep q dir (WlID $ _wlID wl) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index cc762d1d4..ed162f742 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -227,8 +227,8 @@ getViewpoints p w = gameRoomViewpoints :: Point2 -> GameRoom -> [Point2] {-# INLINE gameRoomViewpoints #-} gameRoomViewpoints p gr = - (_grViewpoints gr) - <> map extend ((_grViewpointsEx gr) <> map addDir (_grLinkDirs gr)) + _grViewpoints gr + <> map extend (_grViewpointsEx gr <> map addDir (_grLinkDirs gr)) where extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p) addDir a = p +.+ unitVectorAtAngle a diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index a4a8c18bc..74d885ad9 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -44,7 +44,7 @@ crsHit sp ep w | sp == ep = mempty | otherwise = sortOn (dist sp . fst) - . overlap1SegCrs sp ep + . overlapSegCrs sp ep . mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList . crixsNearSeg sp ep diff --git a/src/Dodge/Zone/Update.hs b/src/Dodge/Zone/Update.hs index 727bebb4e..f54c79c35 100644 --- a/src/Dodge/Zone/Update.hs +++ b/src/Dodge/Zone/Update.hs @@ -1,5 +1,5 @@ module Dodge.Zone.Update ( - updateZoning, + --updateZoning, ) where import Dodge.Data.Zoning