Refactor more collisions to use streaming

src/Dodge/Base/Collide.hs

@@ -22,7 +22,7 @@ module Dodge.Base.Collide
     , collidePointWalls
     , collidePointWallsNorm
     , collidePointWalls'
-    , collidePointWallsL
+--    , collidePointWallsL
     , collidePointWallsFilt
     , overlapCircWallsReturnWall
     , collideCircCrsPoint
@@ -48,6 +48,8 @@ import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import qualified FoldlHelp as L
 import Data.Monoid
+import Streaming
+import qualified Streaming.Prelude as S
 
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
@@ -119,11 +121,11 @@ reflectPointWalls p1 p2
 pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 pointHitsWalls p1 p2 
     = any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
--- | Test if there something blocking a walk
-collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
-collidePointWalkable p1 p2 ws 
-    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    $ IM.filter (not . fromMaybe True . (^? wlPathable)) ws
+
+collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> Stream (Of Wall) Identity () -> Bool
+collidePointTestFilter t sp ep = runIdentity 
+    . S.any_ (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
+    . S.filter t
 
 --furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
 --furthestPointWalkable p1 p2 ws 
@@ -228,10 +230,9 @@ hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2
     Nothing -> True
 
 isWalkable :: Point2 -> Point2 -> World -> Bool
-isWalkable p1 p2 w = not 
-    $ collidePointWalkable p1 p2 
-    $ _walls w
---    $ wallsAlongLine p1 p2 w
+isWalkable p1 p2 = not 
+    . collidePointTestFilter (not . (^?! wlPathable)) p1 p2 
+    . wallsAlongLineStream p1 p2
 
 canSee :: Int -> Int -> World -> Bool
 canSee i j w = hasLOS p1 p2 w
@@ -377,10 +378,10 @@ collidePointWalls' p1 p2 = foldl' findPoint p2 . fmap _wlLine
   where
     findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p)
 
-collidePointWallsL :: Point2 -> Point2 -> L.Fold Wall Point2
-collidePointWallsL p1 p2 = L.Fold findPoint p2 id
-  where
-    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p) . _wlLine
+--collidePointWallsL :: Point2 -> Point2 -> L.Fold Wall Point2
+--collidePointWallsL p1 p2 = L.Fold findPoint p2 id
+--  where
+--    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p) . _wlLine
 
 collidePointWallsFilt :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
 {-# INLINE collidePointWallsFilt #-}