Tweak gibs

src/Dodge/Base/Collide.hs

@@ -2,8 +2,10 @@
 {- | Basic collision detection for a moving point -}
 module Dodge.Base.Collide
     ( hasLOS
+    , collidePointWallsWall
     , hasButtonLOS
     , reflectPointWalls
+    , reflectPointWallsDamp
     , ssfold
     , collidePointUpToIndirectMinDist
     , canSeeIndirect
@@ -13,6 +15,7 @@ module Dodge.Base.Collide
     ) where
 import Dodge.Data
 import Dodge.Zone
+import Dodge.Wall.Reflect
 import Geometry
 import FoldableHelp
 
@@ -42,19 +45,36 @@ hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2
 --    . mapMaybe
 --    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
 
+reflectPointWallsDamp :: Float -> Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
+reflectPointWallsDamp x p1 p2 = fmap (f p1 p2) . collidePointWallsWall p1 p2 
+  where
+    f a b (p,wl) = ( p +.+ errorNormalizeV 139 (vNormal (uncurry (-.-) $ _wlLine wl))
+        , reflVelWallDamp x wl (b-.-a)
+        )
+
+-- | Looks for first collision of a point with walls.
+-- If found, gives point and wall.
+-- (This can probably be improved, eg by folding over the walls and on finding a
+-- wall moving the end point to the collision point, but the returns in speed
+-- are probably minimal)
+collidePointWallsWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Wall)
+collidePointWallsWall p1 p2 
+    = safeMinimumOn (dist p1 . fst)
+    . IM.mapMaybe ( \wl -> uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> ( , wl ) ) 
+
 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
 reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
-reflectPointWalls p1 p2 ws 
+reflectPointWalls p1 p2
     = safeMinimumOn (dist p1 . fst)
-    $ IM.mapMaybe 
+    . IM.mapMaybe
         (( \(x,y) -> 
             fmap ( (, reflectIn (x -.- y) (p2 -.- p1)) 
                  . (+.+ errorNormalizeV 39 (vNormal (x -.- y)))
                  ) 
                  (intersectSegSeg p1 p2 x y)
          ) 
-        . _wlLine) ws
+        . _wlLine)
 ---- | Looks for first collision of a point with walls.
 ---- If found, gives point and reflection velocity, reflection damped in normal.
 --reflectPointWallsDamped