Continue streaming refactor

src/Dodge/Base/Collide.hs

@@ -18,6 +18,7 @@ module Dodge.Base.Collide
     , wallsOnCirc
     , wallsOnCirc'
     , wallsOnLineHit
+    , collideCircWallsStream
     , collideCircWalls
     , collideCircWallsList
 --    , collideCircWalls'
@@ -320,6 +321,21 @@ overlapCircWalls p r = S.mapMaybe dointersect
     dointersect wl = f (_wlLine wl) <&> (,wl)
     f (a,b) = intersectSegSeg p (p -.- r *.* vNormal (normalizeV (a -.- b))) a b
 
+collideCircWallsStream :: Point2 -> Point2 -> Float -> Stream (Of Wall) Identity ()
+    -> (Point2, Maybe Wall)
+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 -> Stream (Of Wall) Identity () -> Maybe (Point2,Wall)
 overlapCircWallsClosest p r = runIdentity
     . L.purely S.fold_ (L.minimumBy (compare `on` (dist p . fst)))

src/Dodge/Item/Weapon/Launcher.hs

@@ -33,7 +33,6 @@ import qualified Data.Map.Strict as M
 import qualified SDL
 import Data.Maybe
 import Control.Lens
-import Control.Applicative
 
 launcher :: Item
 launcher = defaultWeapon 
@@ -333,10 +332,10 @@ moveRemoteShell cid itid pj w
     doExplosion = explodeRemoteRocket itid i $ stopSoundFrom (ShellSound i) w
 
 anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
-anythingHitCirc rad sp ep w = isJust $ hitCr <|> hitWl
+anythingHitCirc rad sp ep w = isJust hitCr || isJust (sequence hitWl)
   where
-    hitCr    = fst <$> collideCircCrsPoint sp ep rad (_creatures w)
+    hitCr    = collideCircCrsPoint sp ep rad (_creatures w)
-    hitWl    = fst <$> collideCircWallsList sp ep rad (wallsNearPoint' ep w) 
+    hitWl    = collideCircWallsStream sp ep rad $ wallsNearPoint ep w
                                                     -- this should probably be wallsOnLine or something
     
 explodeRemoteRocket 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -25,6 +25,7 @@ import LensHelp
 
 import Data.Foldable
 import Data.Tuple
+import qualified Streaming.Prelude as S
 aFlameParticle 
     :: Int      -- ^ Timer
     -> Point2   -- ^ Position
@@ -206,7 +207,13 @@ damageInArea crt wlt pt w = damwls damcrs
   where
     p = _ptPos pt
     damcrs = foldl' (flip $ \cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter crt $ _creatures w
-    damwls w' = foldl' (flip $ \wl -> fst . hiteff [(p,Right wl)]) w' $ filter wlt $ wallsNearPoint' p w
+    damwls w' = runIdentity
+        . S.fold_ 
+            (flip $ \wl -> fst . hiteff [(p,Right wl)]) 
+            w' 
+            id
+        . S.filter wlt
+        $ wallsNearPoint p w'
     hiteff = _ptHitEff pt pt
 
 -- | At writing the radius is half the size of the effect area

src/Dodge/Zone.hs

@@ -93,6 +93,7 @@ zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
 --zoneOfLineIntMap = ddaExt zoneSize
 zoneOfLineIntMap = ddaSq zoneSize
 
+zoneOfCirc :: Monad m => Point2 -> Float -> Stream (Of (V2 Int)) m ()
 zoneOfCirc p = S.map (uncurry V2) . S.each . zoneOfCircle p
 
 zoneOfCircle :: Point2 -> Float -> [(Int,Int)]
@@ -164,21 +165,7 @@ cloudsNearPoint p w = f (IM.lookup x (_znObjects $ _cloudsZone w) >>= IM.lookup
     f Nothing = []
     f (Just l) = l
 
--- possible BUG, was associated with thingsHitLongLine
+-- TODO check whether/when nubbing of walls is necessary
--- assumes _wallsZone is correct level generation
--- there is certainly a problem somewhere here: it may be in the zoning, or
--- within this function
---wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
-----{-# INLINE wallsAlongLine #-}
---wallsAlongLine a b w =
---    IM.foldlWithKey' g IM.empty kps
---  where 
---    g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _wallsZone w) s)) m
---    kps = zoneOfLineIntMap a b
---    f i m = case IM.lookup i m of 
---        Just val -> val
---        _        -> IM.empty
-
 wallsAlongLine :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
 wallsAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfLineStream sp ep
   where