Improve wall squashing further

src/Dodge/Base/Collide.hs

@@ -34,6 +34,7 @@ module Dodge.Base.Collide (
     collide3,
 ) where
 
+import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
@@ -186,11 +187,11 @@ wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y)
 
 -- this COULD be written in terms of collidePointWallsFilterStream, TODO test
 -- whether this is actually faster
-collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> [Wall] -> Bool
+collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Bool
 {-# INLINE collidePointTestFilter #-}
 collidePointTestFilter t sp ep =
     any (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
-        . filter t
+        . IM.filter t
 
 ---- this COULD be written in terms of collidePointWallsFilterStream, TODO test
 ---- whether this is actually faster
@@ -209,9 +210,9 @@ collidePointWallsFilter t sp ep = collidePoint sp ep . IM.filter t . wlsNearSeg
 -- {-# INLINE overlapSegWalls #-}
 -- overlapSegWalls sp ep = S.mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)
 
-overlapSegWalls :: Point2 -> Point2 -> [Wall] -> [(Point2, Wall)]
+overlapSegWalls :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall)
 {-# INLINE overlapSegWalls #-}
-overlapSegWalls sp ep = mapMaybe $
+overlapSegWalls sp ep = IM.mapMaybe $
     \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)
 
 visibleWalls :: Point2 -> Point2 -> World -> [(Point2, Wall)]
@@ -219,8 +220,8 @@ visibleWalls :: Point2 -> Point2 -> World -> [(Point2, Wall)]
 visibleWalls sp ep =
     takeUntil (wlIsOpaque . snd)
         . sortOn (dist sp . fst)
-        . overlapSegWalls sp ep
         . IM.elems
+        . overlapSegWalls sp ep
         . wlsNearSeg sp ep
 
 allVisibleWalls :: World -> [(Point2, Wall)]
@@ -298,7 +299,6 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
 hasLOS p1 p2 =
     not
         . collidePointTestFilter (const True) p1 p2
-        . IM.elems
         . wlsNearSeg p1 p2
 
 hasButtonLOS :: Point2 -> Point2 -> World -> Bool
@@ -315,7 +315,7 @@ hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 hasLOSIndirect p1 p2 =
     not
         . collidePointTestFilter wlIsOpaque p1 p2
-        . IM.elems
+--        . IM.elems
         . wlsNearSeg p1 p2
 
 canSee :: Int -> Int -> World -> Bool