Define a foldr "safe" minimum

src/Dodge/Base/Collide.hs

@@ -74,7 +74,7 @@ furthestPointWalkable p1 p2 ws
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
 collidePointIndirect p1 p2 ws 
-    = safeMinimumOn (dist p1) 
+    = safeMinimumOnr (dist p1) 
     . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
     $ IM.filter (not . _wlIsSeeThrough) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 

src/Dodge/Update/Camera.hs

@@ -161,42 +161,32 @@ autoZoomCam w = over cameraZoom changeZoom w
 
 farWallDist :: Point2 -> World -> Float
 --{-# INLINE farWallDist #-}
-farWallDist cpos w = values'
-    --min (halfWidth w / (horizontalMax+50) ) (halfHeight w / (verticalMax+50) )
+farWallDist cpos w = getMin . uncurry (<>) $ bimap (toScale hw) (toScale hh) $ sconcat $ NEL.map distsMaybeTo viewTestValues
   where
-    horizontalMax = maximum $ map (horSize . h . (+.+) cpos . rotateV camRot) hRays
-    verticalMax   = maximum $ map (verSize . h . (+.+) cpos . rotateV camRot) vRays
-    wos = wallsOnScreen w
-    rv = rotateV camRot (V2 1 0)
-    rh = rotateV camRot (V2 0 1)
-    horSize = abs . dotV rv . (-.- cpos)
-    verSize = abs . dotV rh . (-.- cpos)
-    camRot = _cameraRot w
-    hRays = [V2 x y | y <- zs , x <- [-maxViewDistance,maxViewDistance]]
-    vRays = [V2 x y | x <- zs , y <- [-maxViewDistance,maxViewDistance]]
-    h p = fromMaybe p $ collidePointIndirect cpos p wos
-    zs = [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
-    zs' = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
-    hw = halfWidth w
-    hh = halfHeight w
-    d x = Min . (x /) . (+ 50) . fromMaybe maxViewDistance . fmap getMax . getAp
-    values' = getMin . uncurry (<>) $ bimap (d hw) (d hh) $ sconcat $ NEL.map vsAt zs'
-    --values = map (\x -> (valueAtWidth x, valueAtHeight x)) zs
-    viewDistAtHeight  = rotateV camRot . V2 maxViewDistance
-    viewDistAtWidth x = rotateV camRot $ V2 x maxViewDistance
-    vsAt x = (valueAtWidth x,valueAtHeight x)
+    distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
     valueAtHeight h  = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
       where
         x = viewDistAtHeight h
     valueAtWidth h  = cpih (cpos +.+ x) <> cpih (cpos -.- x)
       where
         x = viewDistAtWidth h
-    cpiv p = Ap $ fmap (Max . horSize) $ collidePointIndirect cpos p wos
-    cpih p = Ap $ fmap (Max . verSize) $ collidePointIndirect cpos p wos
+    cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
+    cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
+    horSize = abs . dotV rv . (-.- cpos)
+    verSize = abs . dotV rh . (-.- cpos)
+    rv = rotateV camRot (V2 1 0)
+    rh = rotateV camRot (V2 0 1)
+    viewDistAtHeight  = rotateV camRot . V2 maxViewDistance
+    viewDistAtWidth x = rotateV camRot $ V2 x maxViewDistance
+    wos = wallsOnScreen w
+    camRot = _cameraRot w
+    hw = halfWidth w
+    hh = halfHeight w
+    toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
+
+viewTestValues :: NEL.NonEmpty Float
+viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
 
-zs :: [Float]
-zs = [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
-    
 maxViewDistance :: Float
 maxViewDistance = 800
 

src/FoldableHelp.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TupleSections #-}
 module FoldableHelp
     ( safeMinimumOn
+    , safeMinimumOnr
     , safeMinimumOnMaybe
     , module Data.Foldable
     )
@@ -21,6 +22,14 @@ safeMinimumOn f = foldl' g Nothing
         | f x < f y = Just x
         | otherwise = Just y
     g Nothing y = Just y
+safeMinimumOnr :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a
+{-# INLINE safeMinimumOnr #-}
+safeMinimumOnr f = foldr g Nothing
+  where
+    g y (Just x)
+        | f x < f y = Just x
+        | otherwise = Just y
+    g y Nothing = Just y
 safeMinimumOnMaybe :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
 safeMinimumOnMaybe f ys = fst <$> go Nothing ys
   where