Better check for wall collisions when expanding creature

src/Dodge/WallCreatureCollisions.hs

@@ -3,6 +3,7 @@ module Dodge.WallCreatureCollisions
     ( colCrsWalls
     , colCrWall
     , pushCreatureOutFromWalls
+    , crOnWall
     ) where
 import Dodge.Data
 --import Dodge.Data.DamageType
@@ -30,7 +31,7 @@ colCrWall w c
   where 
 --    c'' = c' & crPos %~ pushOutFromWalls rad ls
     --c'  = c & crPos %~ pushOutFromWalls' rad (reverse ls)
-    c'  = c & crPos %~ pushOutFromCorners rad (reverse ls)
+    c'  = c & crPos %~ pushOutFromCorners rad ls
         . pushOutFromWalls rad ls 
         . flip (collidePointWalls p1) wls  -- check push throughs
     rad = _crRad c + wallBuffer
@@ -57,11 +58,11 @@ pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall
     Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls
     -- possible improvement: choose between the closer of p2 and "p3" to p1
 
-pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
-pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
-    Nothing -> p1
-    Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
-    -- possible improvement: choose between the closer of p2 and "p3" to p1
+--pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
+--pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
+--    Nothing -> p1
+--    Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
+--    -- possible improvement: choose between the closer of p2 and "p3" to p1
 
 pushOrCrush :: [(Point2,Point2)] -> Creature -> Creature
 pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
@@ -73,6 +74,14 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
   where
     cpos = _crPos cr
 
+-- note the inclusion of endpoints in circOnSeg
+crOnWall :: Creature -> World -> Bool
+crOnWall cr w = any (\(a,b) -> circOnSeg a b p r) wls
+  where
+    p = _crPos cr
+    r = _crRad cr
+    wls = fmap _wlLine . IM.filter (not . _wlWalkable) $ wallsNearPoint p w
+ 
 -- assumes that the wall is orientated
 -- assumes wall points are different
 pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
@@ -85,17 +94,17 @@ pushOutFromWall rad cp2 (wp1,wp2)
     wp2' = wp2 +.+ rad *.* norm
     newP = errorClosestPointOnLine 5 wp1' wp2' cp2
     isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
-pushOutFromWall' :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
-pushOutFromWall' rad cp2 (wp1,wp2) 
-    | isOnWall  = Just newP
-    | otherwise = Nothing
-  where 
-    norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
-    wp1' = wp1 +.+ rad *.* norm
-    wp2' = wp2 +.+ rad *.* norm
-    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
-    --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
-    isOnWall = circOnSeg wp1 wp2 cp2 rad
+--pushOutFromWall' :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
+--pushOutFromWall' rad cp2 (wp1,wp2) 
+--    | isOnWall  = Just newP
+--    | otherwise = Nothing
+--  where 
+--    norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
+--    wp1' = wp1 +.+ rad *.* norm
+--    wp2' = wp2 +.+ rad *.* norm
+--    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
+--    --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
+--    isOnWall = circOnSeg wp1 wp2 cp2 rad
 
 pushOutFromCorners :: Float -> [(Point2,Point2)] -> Point2 -> Point2
 pushOutFromCorners r ls p = foldr (intersectCirclePoint r) p (map fst ls)