Various performance improvements

src/Dodge/Base.hs

@@ -16,6 +16,7 @@ import FoldableHelp
 
 import Control.Lens
 import qualified Control.Foldl as L
+import Data.Monoid
 import Data.Maybe
 --import Data.Bifunctor
 --import qualified Data.IntSet as IS
@@ -213,22 +214,52 @@ overlapCircWallsReturnWall p rad
   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
+collidePointAnyWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collidePointAnyWalls p1 p2 
+    = getFirst
+    . foldMap (First . findPoint . _wlLine)
+  where 
+    findPoint (x,y) = case intersectSegSeg p1 p2 x y of
+        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+        Nothing -> Nothing
+
 -- | 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)
-collideCircWalls p1 p2 rad ws 
-    = safeMinimumOn f 
+-- note that the "intersection" point is the center of the circle flush against the wall
+collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
+  where 
+    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
+    getp (Left p) = p
+    getp (Right (p,_)) = p
+    doReflection p (x,y) = case intersectSegSeg p1 p x y of
+        Nothing -> Nothing
+        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+    shiftByRad (a,b) =
+        (g $ a +.+ rad *.* normalizeV (a -.-b)
+        ,g $ b +.+ rad *.* normalizeV (b -.-a)
+        )
+      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.
+collideCircWalls'' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collideCircWalls'' p1 p2 rad ws 
+    = safeMinimumOn (dist p1 . fst) 
     $ IM.mapMaybe 
         (( \(x:y:_) -> fmap 
             ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
-            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))
+            . (+.+ normalizeV (vNormal (x -.- y)))
             ) 
             (intersectSegSeg p1 p2 x y)
          ) 
          . shiftByRad . _wlLine
         ) ws
   where 
-    f (a,_) = magV (p1 -.- a)
     shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
         [a +.+ rad *.* normalizeV (a -.-b)
         ,b +.+ rad *.* normalizeV (b -.-a)
@@ -356,7 +387,7 @@ nearestCrInTri
     -> World -> Maybe Creature
 nearestCrInTri p dir x w 
     = safeMinimumOn (dist p . _crPos)
-    $ IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
+    $ IM.filter (\cr -> pointInPolygon (_crPos cr) tri) $ _creatures w
  where 
     tri = 
         [p 
@@ -373,7 +404,7 @@ nearestCrInFront
     -> World -> Maybe Creature
 nearestCrInFront p dir x w 
     = safeMinimumOn (dist p . _crPos)
-    $ IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
+    $ IM.filter (\cr -> pointInPolygon (_crPos cr) rec) $ _creatures w
   where 
     rec = [p, pR, pR1, pL1, pL ]
     pR  = p +.+ rotateV (dir - pi*(3/8)) (V2 (x/2) 0)
@@ -382,7 +413,7 @@ nearestCrInFront p dir x w
     pL1 = pL +.+ rotateV dir (V2 (x/2) 0)
 {- | Test whether a creature is in a polygon.  -}
 crInPolygon :: Creature -> [Point2] -> Bool
-crInPolygon cr = errorPointInPolygon 3 (_crPos cr)
+crInPolygon cr = pointInPolygon (_crPos cr)
 
 {- | Transform coordinates from world position to screen coordinates.  -}
 worldPosToScreenNorm :: World -> Point2 -> Point2