Various performance improvements

src/Dodge/Base/Collide.hs

@@ -90,17 +90,50 @@ collideDirectionIndirect d p1 p2 wls
   where
     p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
 
+collidePointUpToIndirect
+    :: Point2   -- ^start point
+    -> Point2   -- ^end point
+    -> IM.IntMap Wall 
+    -> Point2
+{-# INLINE collidePointUpToIndirect #-}
+collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter (not . _wlIsSeeThrough)
+  where
+    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+
+collidePointUpToIndirectMinDist
+    :: Point2   -- ^start point
+    -> Point2   -- ^end point
+    -> Float    -- ^minimal possible distance
+    -> IM.IntMap Wall 
+    -> Point2
+{-# INLINE collidePointUpToIndirectMinDist #-}
+collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter (not . _wlIsSeeThrough)
+  where
+    f x wl = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+    prop p3 = dist p1 p3 < md
+
+-- from haskell-cafe
+-- short circuit a fold when a given property is satisfied
+-- the fold builds a function that is then called on a0
+ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
+{-# INLINABLE ssfold #-}
+ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
+
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
-collidePointIndirect  p1 p2
+collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter (not . _wlIsSeeThrough)
+  where
+    f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
+    test p | p == p2 = Nothing
+           | otherwise = Just p
+
+collidePointIndirect' :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
+{-# INLINE collidePointIndirect' #-}
+collidePointIndirect'  p1 p2
     = L.fold
     . L.prefilter (not . _wlIsSeeThrough)
     . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
     $ L.minimumOn (dist p1)
---collidePointIndirect p1 p2
---    = safeMinimumOn (dist p1) 
---    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
---    . IM.filter (not . _wlIsSeeThrough)
 
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
@@ -120,8 +153,10 @@ collidePointFireVision p1 p2 ws
         Just _  -> not $ _wlIsSeeThrough wl
         Nothing -> True
 
+-- the reason for using the dashed version is the hope that this will short
+-- circuit
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
-hasLOSIndirect p1 p2 w = case collidePointIndirect p1 p2 $ wallsAlongLine p1 p2 w of 
+hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2 w of 
     Just _ -> False
     Nothing -> True