Refactor wall zoning, remove streaming

src/Dodge/WorldEvent/Shockwave.hs

@@ -4,6 +4,7 @@ module Dodge.WorldEvent.Shockwave
     , drawShockwave
     , mvShockwave
     ) where
+import Dodge.Zoning.Wall
 import Dodge.Data
 import Dodge.Wall.Damage
 import Dodge.Base
@@ -12,7 +13,7 @@ import Geometry
 import Picture
 import LensHelp
 
---import Data.Foldable
+import Data.Foldable
 import qualified IntMapHelp as IM
 import qualified Streaming.Prelude as S
 -- currently very effective against walls
@@ -63,13 +64,11 @@ mvShockwave is w pt
     tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
     rad = r - (3/4) * r * tFraction
     doDams w' = over creatures (IM.map damCr) 
-        . runIdentity
-        $ S.fold_
+        $ foldl'
             (flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
             w'
-            id
             hitBlocks
-    hitBlocks = S.map snd . overlapCircWalls p rad $ wlsInsideCirc p rad w 
+    hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w 
         -- this is not expansive enough
     damCr cr 
         | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr  = cr

src/Dodge/WorldEvent/ThingsHit.hs

@@ -11,11 +11,13 @@ module Dodge.WorldEvent.ThingsHit
     , wlsHitRadial
     )
     where
+import Dodge.Zoning.Wall
 import Dodge.Zoning.Creature
 import Dodge.Data
 import Dodge.Base
 import Dodge.Zone
 import Geometry
+import qualified ListHelp as List
 
 import Control.Lens
 import Data.Maybe
@@ -31,10 +33,19 @@ thingsHit
     :: Point2    -- ^ Line start point
     -> Point2    -- ^ Line end point
     -> World 
-    -> StreamOf (Point2, Either Creature Wall)
-thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)  
-    (S.map (second Left)  (S.each $ crsHit sp ep w))
-    (S.map (second Right) (wlsHit sp ep w))
+    -> [(Point2, Either Creature Wall)]
+thingsHit sp ep w = List.mergeOn (dist sp . fst)  
+    (map (second Left)  (crsHit sp ep w))
+    (map (second Right) (wlsHit sp ep w))
+--{- List those objects that appear on a line.  -}
+--thingsHit
+--    :: Point2    -- ^ Line start point
+--    -> Point2    -- ^ Line end point
+--    -> World 
+--    -> StreamOf (Point2, Either Creature Wall)
+--thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)  
+--    (S.map (second Left)  (S.each $ crsHit sp ep w))
+--    (S.map (second Right) (wlsHit sp ep w))
 
 crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
 crsHit sp ep w
@@ -48,13 +59,20 @@ crsHit sp ep w
 
 thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool) 
     -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
-thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
+thingHitFilt fcr fwl sp ep = listToMaybe . filter (f . snd) . thingsHit sp ep
   where
     f (Left cr) = fcr cr
     f (Right wl) = fwl wl
 
+--thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool) 
+--    -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
+--thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
+--  where
+--    f (Left cr) = fcr cr
+--    f (Right wl) = fwl wl
+
 thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
-thingHit sp ep = runIdentity . S.head_ . thingsHit sp ep
+thingHit sp ep = listToMaybe . thingsHit sp ep
 
 {- List objects that appear on a line.
 Can filter out a creature.  -}
@@ -63,26 +81,51 @@ thingsHitExceptCr
     -> Point2    -- ^ Line start point
     -> Point2    -- ^ Line end point
     -> World 
-    -> StreamOf (Point2, Either Creature Wall)
+    -> [(Point2, Either Creature Wall)]
 thingsHitExceptCr Nothing    sp ep = thingsHit sp ep
-thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
+thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
   where 
     crNotCid (_,Left cr) = _crID cr /= cid
     crNotCid _ = True
+--{- List objects that appear on a line.
+--Can filter out a creature.  -}
+--thingsHitExceptCr 
+--    :: Maybe Int -- ^ A possible creature ID
+--    -> Point2    -- ^ Line start point
+--    -> Point2    -- ^ Line end point
+--    -> World 
+--    -> StreamOf (Point2, Either Creature Wall)
+--thingsHitExceptCr Nothing    sp ep = thingsHit sp ep
+--thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
+--  where 
+--    crNotCid (_,Left cr) = _crID cr /= cid
+--    crNotCid _ = True
 
-wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
+wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
 wlsHit sp ep
     | sp == ep  = const mempty
-    | otherwise = sortStreamOn (dist sp . fst)
+    | otherwise = sortOn (dist sp . fst)
         . overlapSegWalls sp ep
         . wlsNearSeg sp ep
+--wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
+--wlsHit sp ep
+--    | sp == ep  = const mempty
+--    | otherwise = sortStreamOn (dist sp . fst)
+--        . overlapSegWalls sp ep
+--        . wlsNearSeg sp ep
 
-wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
-wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
+wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
+wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
   where
     f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
       where
         v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
+--wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
+--wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
+--  where
+--    f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
+--      where
+--        v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
 
 crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
 crsHitRadial p r = mapMaybe f . crsNearCirc p r