Cleanup

src/Dodge/Data/Creature.hs

@@ -30,7 +30,7 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
-import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
 --import qualified IntMapHelp as IM
 
 data Creature = Creature
@@ -58,7 +58,7 @@ data Creature = Creature
     , _crIntention :: Intention
     , _crName :: String
     , _crDeathTimer :: Int
-    , _crCrushTimers :: IM.IntMap Int
+    , _crWallTouch :: IS.IntSet
     }
 
 data CrHP

src/Dodge/Default/Creature.hs

@@ -55,7 +55,7 @@ defaultCreature =
 --        , _crStatistics = CreatureStatistics 50 50 50
         , _crDeathTimer = 5  -- how long a creature remains standing 
                              -- after a killing blow has been dealt
-        , _crCrushTimers = mempty
+        , _crWallTouch = mempty
         }
 
 --defaultCreatureSkin :: CreatureType

src/Dodge/TestString.hs

@@ -34,10 +34,10 @@ import RandomHelp
 
 testStringInit :: Universe -> [String]
 --testStringInit u = [show $ u ^? uvWorld . input . mouseContext . mcoRotateDist]
-testStringInit u = fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crHP . _HP)
-    <> fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crPos . _xy)
+testStringInit u = --fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crHP . _HP)
+     fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crPos . _xy)
     <> fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crOldPos . _xy)
-    <> fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crCrushTimers)
+    <> fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . each . crWallTouch)
     <> fmap show (u ^.. uvWorld . cWorld . lWorld . debris . each . dbPos)
 --    (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcType . _McDamSensor . sensAmount)
 --    <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)

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 =