Zoning/streaming refactor

src/Dodge/Base/Collide.hs

@@ -27,8 +27,8 @@ module Dodge.Base.Collide
     , collidePointWalls'
 --    , collidePointWallsL
     , collidePointWallsFilt
-    , overlapCircWallsReturnWall
-    , overlapCircWallsReturnWall'
+    , overlapCircWalls
+    , overlapCircWallsClosest
     , collideCircCrsPoint
     , collideCircCreatures
     , collidePointCreatures
@@ -49,6 +49,7 @@ import FoldableHelp
 
 --import Data.List
 import Data.Maybe
+import Data.Function (on)
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
@@ -234,30 +235,10 @@ wallsOnLineHit p1 p2 = IM.mapMaybe f
     f wl = uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> (, wl)
 
 wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
-wallsOnCirc p r = IM.filter f
-  where 
-    f wl = uncurry circOnSeg (_wlLine wl) p r
+wallsOnCirc p r = IM.filter (uncurry (circOnSeg p r) . _wlLine)
 
 wallsOnCirc' :: Point2 -> Float -> [Wall] -> [Wall]
-wallsOnCirc' p r = filter f
-  where 
-    f wl = uncurry circOnSeg (_wlLine wl) p r
-
--- | Looks for overlap of a circle with walls.
--- If found, gives wall
-overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall
-overlapCircWallsReturnWall p rad
-    = L.fold (safeMinimumOnMaybeL (fmap (dist p) . f . _wlLine))
-  where 
-    f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b
-
--- | Looks for overlap of a circle with walls.
--- If found, gives wall
-overlapCircWallsReturnWall' :: Point2 -> Float -> Stream (Of Wall) Identity () -> Maybe Wall
-overlapCircWallsReturnWall' p rad
-    = runIdentity . L.purely S.fold_ (safeMinimumOnMaybeL (fmap (dist p) . f . _wlLine))
-  where 
-    f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b
+wallsOnCirc' p r = filter $ uncurry (circOnSeg p r) . _wlLine
 
 -- | Looks for any collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
@@ -332,6 +313,18 @@ collideCircWallsList p1 p2 rad
         ,b +.+ rad *.* normalizeV (b -.-a)
         ]
 
+overlapCircWalls :: Point2 -> Float -> Stream (Of Wall) Identity () 
+    -> Stream (Of (Point2,Wall)) Identity ()
+overlapCircWalls p r = S.mapMaybe dointersect
+  where
+    dointersect wl = f (_wlLine wl) <&> (,wl)
+    f (a,b) = intersectSegSeg p (p -.- r *.* vNormal (normalizeV (a -.- b))) a b
+
+overlapCircWallsClosest :: Point2 -> Float -> Stream (Of Wall) Identity () -> Maybe (Point2,Wall)
+overlapCircWallsClosest p r = runIdentity
+    . L.purely S.fold_ (L.minimumBy (compare `on` (dist p . fst)))
+    . overlapCircWalls p r
+
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
 collideCircWalls :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
@@ -414,7 +407,7 @@ collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
 {- | Test if a circle collides with any wall. 
  - Note no check on whether the wall is walkable. -}
 circOnSomeWall :: Point2 -> Float -> World -> Bool
-circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg' p rad) . _wlLine)
+circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine)
     . wallsNearPoint p
 --    = any (\(x,y) -> circOnSeg x y p rad) 
 --    . fmap _wlLine 
@@ -427,12 +420,12 @@ crsNearPoint d p = any (\c -> dist (_crPos c) p < (d + _crRad c)) . _creatures
 {- | Produce an unordered list of creatures on a line. -}
 crsOnLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
 crsOnLine p1 p2
-    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
+    = IM.filter (\cr -> segOnCirc p1 p2 (_crPos cr) (_crRad cr))
     . _creatures
 {- | Produce an unordered list of creatures on a wide line. -}
 crsOnThickLine :: Float -> Point2 -> Point2 -> World -> IM.IntMap Creature
 crsOnThickLine thickness p1 p2
-    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr + thickness))
+    = IM.filter (\cr -> segOnCirc p1 p2 (_crPos cr) (_crRad cr + thickness))
     . _creatures
 {- | Find 'Maybe' the closest creature to a point, within a circle.
  -}