Cleanup

src/Dodge/WallCreatureCollisions.hs

@@ -6,11 +6,11 @@ module Dodge.WallCreatureCollisions (
     crOnWall,
 ) where
 
+import qualified Data.IntSet as IS
 import Data.Foldable
 import Linear
 import Dodge.Creature.Radius
 import Control.Lens
-import Data.Maybe
 import Data.Monoid
 import Dodge.Base
 import Dodge.Data.Universe
@@ -26,21 +26,11 @@ noclipCheck cfig w c
     | otherwise = colCrWall w c
 
 colCrWall :: World -> Creature -> Creature
-colCrWall w c -- = cornpush . wallpush $ pushthrough c
-    | p1 == p2 = pushOrCrush ls c
-    | otherwise = cornpush . wallpush $ pushthrough c
---    | otherwise = wallpush $ pushthrough c
---    | otherwise = c'
+colCrWall w c = cornpush . wallpush $ pushthrough c
   where
     cornpush = crPos . _xy %~ pushOutFromCorners r ls'
-    --wallpush = crPos . _xy %~ pushOutFromWalls r ls'
     wallpush = pushCr' wls
     pushthrough = crPos . _xy %~ fst . flip (collidePoint p1) wls -- check push throughs
---    c' = c & crPos . _xy
---            %~ pushOutFromCorners r ls'
---                . pushOutFromWalls r ls'
---                . fst
---                . flip (collidePoint p1) wls -- check push throughs
     r = crRad (c ^. crType) + wallBuffer
     p1 = c ^. crOldPos . _xy
     p2 = c ^. crPos . _xy
@@ -52,38 +42,19 @@ colCrWall w c -- = cornpush . wallpush $ pushthrough c
 pushCr' :: [Wall] -> Creature -> Creature
 pushCr' wls cr 
     | dist ep sp > r 
-        && dist ep ap > r = ecr & crDamage <>~ [Crushing 1000 10]
-            & crPos . _xy +~ r *^ ep - ap
+        && dist ep ap > r = ecr & crDamage <>~ [Crushing 1000 0]
+            & crPos . _xy .~ ap
     | otherwise = ecr
   where
     ep = ecr ^. crPos . _xy
     ap = cr ^. crOldPos . _xy
     sp = cr ^. crPos . _xy
-    ecr = foldl' f (cr & crCrushTimers .~ mempty) wls
+    ecr = foldl' f (cr & crWallTouch .~ mempty) wls
     r = crRad (cr ^. crType)
     f acr wl = case pushOutFromWall r (acr ^. crPos . _xy) (wl ^. wlLine) of
-        Just p -> acr & crPos . _xy .~ p & crCrushTimers . at (_wlID wl) ?~ 0
+        Just p -> acr & crPos . _xy .~ p & crWallTouch %~ IS.insert (wl ^. wlID)
         Nothing -> acr
 
---apushCr :: [Wall] -> Creature -> Creature
---apushCr wls cr = case wallPushList r wls cp of
---a    [] -> cr
---a    [(p,wl)] -> cr & crPos . _xy .~ p
---a--    [(p1,w1),(p2,w2)] | dd p1 p2 >= 0 -> 
---a    [(p1,w1),(p2,w2)] -> 
---a        let v1 = p1 - cp
---a            v2 = p2 - cp
---a            mp = intersectLineLine p1 (p1 + vNormal v1) p2 (p2 + vNormal v2)
---a            --p = fromMaybe (cr ^. crOldPos . _xy) mp
---a            p = (cr ^. crOldPos . _xy)
---a        in  cr & crPos . _xy .~ p
---a--    [(p1,w1),(p2,w2)] -> cr & crPos . _xy .~ p1
---a    xs -> cr
---a  where
---a    dd p1 p2 = dotV (p1 - cp) (p2 - cp)
---a    r = crRad (cr ^. crType)
---a    cp = cr ^. crPos . _xy
-
 -- the amount to push creatures out from walls, extra to their radius
 wallBuffer :: Float
 wallBuffer = 0
@@ -116,18 +87,6 @@ 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
 
-pushOrCrush :: [(Point2, Point2)] -> Creature -> Creature
-pushOrCrush wls cr = case mapMaybe (pushOutFromWall (crRad (cr ^. crType)) cpos) wls of
-    [] -> cr
-    --(p : _) -> cr & crPos . _xy .~ p & crDamage <>~ [Crushing 1000 0]
-    (p : _) -> cr & crPos . _xy .~ p
-  where
-    --    (_:p:_)   -> cr
-    --        & crPos .~ p
-    --        & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )
-
-    cpos = cr ^. crPos . _xy
-
 -- note the inclusion of endpoints in circOnSeg
 crOnWall :: Creature -> World -> Bool
 crOnWall cr =