Continue to refactor zoning to be more stream-based

src/Dodge/Item/Weapon/SonicGuns.hs

@@ -84,37 +84,38 @@ drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDe
 mvSonicWave :: World -> Particle -> (World, Maybe Particle)
 mvSonicWave w pt
     | _ptTimer pt <= 0 = (w,Nothing)
-    | otherwise = (w, Just pt')
-  where
-    mvPointDir (p,a) = case wallsHit p ep w of
-        [] -> Just ((ep, a), (True,True))
-        (hp,wl):_ -> reflectShockLine wl p hp ep
-      where
-        ep = p +.+ 5 *.* unitVectorAtAngle a
-    dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs)
-    dividePointDir xs = xs
-    f (p,a) (q,b)
-        | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)]
-        | otherwise = [(p,a)]
-    combineClose ((p,a):(q,b):pairs)
-        | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs)
-        | otherwise = (p,a) : combineClose ((q,b):pairs)
-      where
-        mixa = mixAngles 0.5 a b
-    combineClose pairs = pairs
-    pt' = pt & ptTimer -~ 10
-        -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir)
-        & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null) 
-            . concatMap (dosplit . map mvPointDir))
-    --    & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir))
-    dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
-    dosplit (x:xs) = case x of
-        Nothing -> [] : dosplit xs
-        Just (pair,(True,True))  -> overHead (pair:) $ dosplit xs
-        Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
-        Just (pair,(True,False)) -> [pair] : dosplit xs
-        Just (_,(False,False)) -> [] : dosplit xs
-    dosplit [] = [[]]
+    | otherwise = (w, Just $ pt & ptTimer -~ 1)
+--    | otherwise = (w, Just pt')
+--  where
+--    mvPointDir (p,a) = case wallsHit p ep w of
+--        [] -> Just ((ep, a), (True,True))
+--        (hp,wl):_ -> reflectShockLine wl p hp ep
+--      where
+--        ep = p +.+ 5 *.* unitVectorAtAngle a
+--    dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs)
+--    dividePointDir xs = xs
+--    f (p,a) (q,b)
+--        | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)]
+--        | otherwise = [(p,a)]
+--    combineClose ((p,a):(q,b):pairs)
+--        | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs)
+--        | otherwise = (p,a) : combineClose ((q,b):pairs)
+--      where
+--        mixa = mixAngles 0.5 a b
+--    combineClose pairs = pairs
+--    pt' = pt & ptTimer -~ 10
+--        -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir)
+--        & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null) 
+--            . concatMap (dosplit . map mvPointDir))
+--    --    & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir))
+--    dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
+--    dosplit (x:xs) = case x of
+--        Nothing -> [] : dosplit xs
+--        Just (pair,(True,True))  -> overHead (pair:) $ dosplit xs
+--        Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
+--        Just (pair,(True,False)) -> [pair] : dosplit xs
+--        Just (_,(False,False)) -> [] : dosplit xs
+--    dosplit [] = [[]]
 
 overHead :: (a -> a) -> [a] -> [a]
 overHead f (x:xs) = f x: xs

src/Dodge/Item/Weapon/UseEffect.hs

@@ -14,6 +14,7 @@ import LensHelp
 
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
+import qualified Streaming.Prelude as S
 {- | Creates an outwardly increasing circle that draws creatures, even those behind walls.  -}
 aSonarPulse :: Creature -> World -> World
 aSonarPulse = aRadarPulse crBlips (blipAt 8) (withAlpha 0.2 green)
@@ -122,9 +123,9 @@ itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
     f q = dist p q <= r && dist p q > r - 4
 
 wallBlips :: Point2 -> Float -> World -> [Point2]
-wallBlips p r w = mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
-        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
-                      ++ IM.elems (wallsAlongCirc p r w)
+wallBlips p r w = runIdentity . S.toList_ $ S.mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
+        $ S.map (over wlLine swp) (wallsAlongCirc' p r w)
+                      <> wallsAlongCirc' p r w
   where
     swp (a,b) = (b,a)