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

src/Dodge/Item/Weapon/Grenade.hs

@@ -52,7 +52,10 @@ moveGrenade pj w
     | _pjTimer pj <= 0 = w 
         & props %~ IM.delete pID 
         & _pjPayload pj (_prPos (_props w IM.! pID)) 
-    | otherwise = case collideCircWallsList oldPos newPos 4 $ wallsNearPoint' newPos w of
+                                                            -- this should maybe
+                                                            -- be wallsAlongLine
+                                                            -- or something vvv
+    | otherwise = case reflectCircWallsDamp 1 oldPos newPos 4 $ wallsNearPoint newPos w of
         Nothing -> w & props . ix pID %~ normalUpdate
         Just (p,v)  -> w
             & soundStart (Tap 0) p tapQuietS Nothing
@@ -159,6 +162,7 @@ throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x }
 --        _   -> w'
 --    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
 
+-- TODO hive out movement and share with moveGrenade
 moveRemoteBomb :: Int -> Int -> Int -> World -> World
 moveRemoteBomb itid time pID w 
     | time < -4 = updatePicture
@@ -182,7 +186,7 @@ moveRemoteBomb itid time pID w
     -- this is hacky, should use a version of collidePointWalls' that collides
     -- circles and walls
     invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
-    hitWl  = collideCircWallsList oldPos newPos 4 $ wallsNearPoint' newPos w
+    hitWl  = reflectCircWallsDamp 1 oldPos newPos 4 $ wallsNearPoint newPos w
     finalPos = maybe newPos (invShift . fst) hitWl
     setV v = set (props . ix pID . pjVel) v
     updateV = maybe id (setV . snd) hitWl