Remove more (dead) Streaming code

This commit is contained in:
2022-08-21 22:03:15 +01:00
parent cccab45650
commit c35dbf1ba8
12 changed files with 24 additions and 93 deletions
+8 -72
View File
@@ -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 =
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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 =
-7
View File
@@ -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
+2 -1
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+5 -4
View File
@@ -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
+1 -1
View File
@@ -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)
+2 -2
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -1,5 +1,5 @@
module Dodge.Zone.Update (
updateZoning,
--updateZoning,
) where
import Dodge.Data.Zoning