More streaming refactoring

src/Dodge/Base/Collide.hs

@@ -16,8 +16,10 @@ module Dodge.Base.Collide
     , wlIsOpaque
     , wlIsSeeThrough
     , wallsOnCirc
+    , wallsOnCirc'
     , wallsOnLineHit
     , collideCircWalls
+    , collideCircWallsList
 --    , collideCircWalls'
     , circOnSomeWall
     , collidePointWalls
@@ -26,6 +28,7 @@ module Dodge.Base.Collide
 --    , collidePointWallsL
     , collidePointWallsFilt
     , overlapCircWallsReturnWall
+    , overlapCircWallsReturnWall'
     , collideCircCrsPoint
     , collideCircCreatures
     , collidePointCreatures
@@ -235,6 +238,11 @@ wallsOnCirc p r = IM.filter f
   where 
     f wl = uncurry circOnSeg (_wlLine wl) p r
 
+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
@@ -243,6 +251,14 @@ overlapCircWallsReturnWall p rad
   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
+
 -- | Looks for any collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
 -- note that in this version the circle can overlap the wall
@@ -296,6 +312,25 @@ collidePointWallsFilt t p1 p2 = collidePointWalls' p1 p2 . IM.filter t
 --        )
 --      where
 --        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
+-- | Looks for first collision of a circle with walls.
+-- If found, gives point and reflection velocity, reflection damped in normal.
+collideCircWallsList :: Point2 -> Point2 -> Float -> [Wall] -> Maybe (Point2,Point2)
+collideCircWallsList p1 p2 rad
+    = safeMinimumOn (dist p1 . fst) 
+    . mapMaybe 
+        (( \(x:y:_) -> fmap 
+            ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
+            . (+.+ normalizeV (vNormal (x -.- y)))
+            ) 
+            (intersectSegSeg p1 p2 x y)
+         ) 
+         . shiftByRad . _wlLine
+        )
+  where 
+    shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
+        [a +.+ rad *.* normalizeV (a -.-b)
+        ,b +.+ rad *.* normalizeV (b -.-a)
+        ]
 
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
@@ -379,11 +414,12 @@ 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
-    = any (\(x,y) -> circOnSeg x y p rad) 
-    . fmap _wlLine 
-    . IM.elems 
+circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg' p rad) . _wlLine)
     . wallsNearPoint p
+--    = any (\(x,y) -> circOnSeg x y p rad) 
+--    . fmap _wlLine 
+--    . IM.elems 
+--    . wallsNearPoint p
 {- | Adds the distance to the creature radius, tests whether the center is in
 the circle of this size centered at the point -}
 crsNearPoint :: Float -> Point2 -> World -> Bool