Introduce safeMinimumOn

src/Dodge/Base/Collide.hs

@@ -6,20 +6,44 @@ import Dodge.Data
 import Dodge.Base.Zone
 import Geometry
 
-import Data.List
+--import Data.List
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
+-- | A version of 'minimum' where the comparison is done on some extracted value.
+--   Returns Nothing if the list is empty. Only calls the function once per element.
+--
+-- > safeMinimumOn id [] == Nothing
+-- > safeMinimumOn length ["test","extra","a"] == Just "a"
+safeMinimumOn :: (Ord b) => (a -> b) -> [a] -> Maybe a
+safeMinimumOn _ [] = Nothing
+safeMinimumOn f (x:xs) = g x (f x) xs
+    where
+        g v _  [] = Just v
+        g v mv (y:ys) | my < mv = g y my ys
+                      | otherwise = g v mv ys
+            where my = f y
+
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w
+
+hitPointLines
+    :: Point2
+    -> Point2
+    -> [(Point2,Point2)]
+    -> Maybe (Point2,(Point2,Point2))
+hitPointLines p1 p2
+    = safeMinimumOn (dist p1 . fst)
+    . mapMaybe
+    (\(x,y) -> (, (x,y)) <$> (intersectSegSeg' p1 p2 x y))
+
 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
 reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
 reflectPointWalls p1 p2 ws 
-    = listToMaybe 
-    . sortOn (dist p1 . fst)
+    = safeMinimumOn (dist p1 . fst)
     . IM.elems 
     $ IM.mapMaybe 
         (( \(x,y) -> 
@@ -38,8 +62,7 @@ reflectPointWallsDamped
     -> IM.IntMap Wall 
     -> Maybe (Point2,Point2)
 reflectPointWallsDamped dfact p1 p2 ws 
-    = listToMaybe 
-    . sortOn (dist p1 . fst)
+    = safeMinimumOn (dist p1 . fst)
     . IM.elems 
     $ IM.mapMaybe 
         (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
@@ -60,16 +83,14 @@ collidePointWalkable p1 p2 ws
 furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
 furthestPointWalkable p1 p2 ws 
     = fromMaybe p2
-    . listToMaybe
-    . sortOn (dist p1) 
+    . safeMinimumOn (dist p1) 
     . IM.elems 
     $ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
 
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
 collidePointIndirect p1 p2 ws 
-    = listToMaybe 
-    . sortOn (dist p1) 
+    = safeMinimumOn (dist p1) 
     . IM.elems 
     . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) 
     $ IM.filter (not . _wlIsSeeThrough) ws
@@ -77,8 +98,7 @@ collidePointIndirect p1 p2 ws
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 collidePointFire p1 p2 ws 
-    = listToMaybe 
-    . sortOn (dist p1) 
+    = safeMinimumOn (dist p1) 
     . IM.elems 
     . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine ) 
     $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws