Refactor

src/Dodge/Base/Collide.hs

@@ -5,6 +5,7 @@ module Dodge.Base.Collide
     , collidePointWallsWall
     , collidePointWallsFilterStream
     , reflectPointWallsDamp
+    , reflectCircWallsDamp
     , hasButtonLOS
     , reflectPointWalls
     , ssfold
@@ -72,15 +73,16 @@ hasButtonLOS p1 p2 = not
     . collidePointTestFilter (not . _wlTouchThrough) p1 p2
     . wallsAlongLine p1 p2
 
---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)
+reflectCircWallsDamp :: Float -> Point2 -> Point2 -> Float -> Stream (Of Wall) Identity ()
+    -> Maybe (Point2,Point2)
+reflectCircWallsDamp x sp ep r w = do
+    wl <- mwl
+    return (p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
+        , reflVelWallDamp x wl (ep -.- sp)
+        )
+  where
+    (p, mwl) = collideCircWallsStream sp ep r w
+
 reflectPointWallsDamp :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2,Point2)
 reflectPointWallsDamp t x sp ep w = do
     wl <- mwl
@@ -321,6 +323,7 @@ overlapCircWalls p r = S.mapMaybe dointersect
     dointersect wl = f (_wlLine wl) <&> (,wl)
     f (a,b) = intersectSegSeg p (p -.- r *.* vNormal (normalizeV (a -.- b))) a b
 
+-- note that this does not push the circle away from the wall at all
 collideCircWallsStream :: Point2 -> Point2 -> Float -> Stream (Of Wall) Identity ()
     -> (Point2, Maybe Wall)
 collideCircWallsStream sp ep rad = runIdentity