Improve door crushing

src/Dodge/WallCreatureCollisions.hs

@@ -1,6 +1,7 @@
 -- | Deals with moving creature wall collisions.
 module Dodge.WallCreatureCollisions (colCrsWalls) where
 
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Data.Foldable
 import qualified Data.IntSet as IS
@@ -28,19 +29,23 @@ colCrWall w c = cornpush . wallpush $ pushthrough c
     r = crRad (c ^. crType) + wallBuffer
     p1 = c ^. crOldPos . _xy
     p2 = c ^. crPos . _xy
-    ls = _wlLine <$> wls
+    ls = _wlLine <$> IM.elems wls
     ls' = filter (uncurry $ isLHS p1) ls
-    wls = filter notff $ wlsNearCirc p2 r w
+    wls = IM.filter notff $ wlsNearCirc p2 (2*r) w
     notff x = x ^. wlMaterial /= ForceField
 
-pushCr :: [Wall] -> Creature -> Creature
+-- might want to check angled crushing
+pushCr :: IM.IntMap Wall -> Creature -> Creature
 pushCr wls cr
-    | dist ep sp > r && dist ep ap > r =
+    | (dist ep sp > r && dist ep ap > r)
+        || wlsCrush twls
+            =
         ecr
             & crDamage <>~ [Crushing 1000 0]
             & crPos . _xy .~ ap
     | otherwise = ecr
   where
+    twls = IM.elems $ IM.restrictKeys wls (ecr ^. crWallTouch)
     ep = ecr ^. crPos . _xy
     ap = cr ^. crOldPos . _xy
     sp = cr ^. crPos . _xy
@@ -50,6 +55,15 @@ pushCr wls cr
         Just p -> acr & crPos . _xy .~ p & crWallTouch %~ IS.insert (wl ^. wlID)
         Nothing -> acr
 
+wlsCrush :: [Wall] -> Bool
+wlsCrush [] = False
+wlsCrush (x:xs) = any (wlWlCrush x) xs || wlsCrush xs
+
+wlWlCrush :: Wall -> Wall -> Bool
+wlWlCrush w1 w2 = angleVV (f w1) (f w2) > 0.75 * pi
+  where
+    f = uncurry (-) . (^. wlLine)
+
 -- the amount to push creatures out from walls, extra to their radius
 wallBuffer :: Float
 wallBuffer = 0