Make damage application belong to hit object

src/Dodge/Creature/Inanimate.hs

@@ -59,7 +59,7 @@ explosiveBarrel = defaultInanimate
     }
 updateBarrel :: Creature -> World -> World
 updateBarrel cr
-    | _crHP cr > 0 = creatures . ix (_crID cr) %~ doDamage
+    | _crHP cr > 0 = creatures . ix (_crID cr) %~ (snd . doDamage)
     | otherwise    = creatures . at (_crID cr) .~ Nothing
 
 -- should generate the sparks externally using new random generators

src/Dodge/Creature/Lamp.hs

@@ -62,7 +62,7 @@ updateLamp h i cr w
         & creatures . at cid .~ Nothing
     | otherwise = w 
         & lightSources . ix i . lsParam . lsPos .~ addZ h cpos
-        & creatures . ix cid %~ doDamage
+        & creatures . ix cid %~ (snd . doDamage)
   where
     cpos = _crPos cr
     cid  = _crID cr

src/Dodge/Creature/State.hs

@@ -47,14 +47,16 @@ stateUpdate :: (Creature -> World -> (World -> World, Creature))
     -> Creature -> World -> World
 stateUpdate = stateUpdateDamage doDamage
 
-stateUpdateDamage :: (Creature -> Creature) 
+stateUpdateDamage :: (Creature -> (World -> World,Creature)) 
     -> (Creature -> World -> (World -> World, Creature)) 
 --    -> CRUpdate
     -> Creature -> World -> World
-stateUpdateDamage damageupdate u cr w = case u (updateMovement cr) w of
-    (f, upcr) -> mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f $ w
-        & creatures . at (_crID cr) .~  (stepReloading . damageupdate <$> crOrCorpse upcr)
+stateUpdateDamage damageupdate u cr w =  
+    mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f . g $ w
+        & creatures . at (_crID cr) .~  (stepReloading <$> crOrCorpse upcr')
   where
+    (f,upcr) = u (updateMovement cr) w
+    (g,upcr') = damageupdate upcr
     mvcrhammerup = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp
     crOrCorpse cr' 
         | cr' ^. crHP > 0 = Just cr'
@@ -80,13 +82,13 @@ setOldPos cr = cr
     & crOldPos .~ _crPos cr
     & crOldDir .~ _crDir cr
 
-clearDamage :: Creature -> Creature
-clearDamage = crState . crDamage .~ []
+clearDamage :: Creature -> (World-> World,Creature)
+clearDamage cr = (id,cr&crState . crDamage .~ [])
 
-doDamage :: Creature -> Creature
-doDamage cr = set (crState . crDamage) [] 
-    . over (crState . crPastDamage) (advancePastDamages dams)
-    $ snd $ _crApplyDamage cr dams cr
+doDamage :: Creature -> (World -> World, Creature)
+doDamage cr = set (_2 . crState . crDamage) [] 
+    . over (_2 . crState . crPastDamage) (advancePastDamages dams)
+    $ _crApplyDamage cr dams cr
   where 
     dams = _crDamage $ _crState cr
 

src/Dodge/Data/DamageType.hs

@@ -35,14 +35,14 @@ data DamageEffect
     | TorqueDamage { _deTorque :: Float }
     | PushBackDamage {_dePushBack :: Point2 }
     | NoDamageEffect
-  deriving (Eq,Ord,Show)
+--  deriving (Eq,Ord,Show)
 
 data Damage = Damage 
     { _dmType :: DamageType
     , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 
     , _dmEffect :: DamageEffect
     }
-  deriving (Eq,Ord,Show)
+--  deriving (Eq,Ord,Show)
 
 isElectrical :: Damage -> Bool
 isElectrical dm = case _dmType dm of

src/Dodge/Default.hs

@@ -10,6 +10,7 @@ import Dodge.Data
 import Dodge.SoundLogic
 import Dodge.Picture.Layer
 import Dodge.Wall.Delete
+import Dodge.Creature.Damage
 import Geometry
 import Picture
 import ShapePicture
@@ -19,7 +20,6 @@ import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
-import Data.List
 --import Data.Monoid
 defaultCreature :: Creature
 defaultCreature = Creature
@@ -186,36 +186,6 @@ defaultConsumable = Item
     , _itTargeting = NoTargeting
     , _itValue = defaultItemValue
     }
-defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
-defaultApplyDamage ds cr = (id, doPoisonDam $ foldl' (flip $ \d c -> snd $ applyIndividualDamage d c) cr ds')
-  where 
-    (ps,ds') = partition isPoison ds
-    isPoison Damage{_dmType=PoisonDam} = True
-    isPoison _ = False
-    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
-    doPoisonDam = over crHP (\hp -> hp - poisonDam)
-
-applyDamageEffect :: Damage -> DamageEffect -> Creature -> Creature
-applyDamageEffect dm de cr = case de of
-    NoDamageEffect -> cr
-    PushDamage push pushexp pushRad -> cr 
-        & crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) 
-      where
-        pushAmount
-            | dist (_crPos cr) fromDir == 0 = 0
-            | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
-    PushBackDamage pback -> cr
-        & crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
-    TorqueDamage rot -> cr & crDir +~ rot
-  where
-    fromDir = _dmFrom dm
-
-applyIndividualDamage :: Damage -> Creature -> (World -> World, Creature)
-applyIndividualDamage dm cr = ( id
-    , cr
-      & crHP -~ _dmAmount dm
-      & applyDamageEffect dm (_dmEffect dm)
-    )
 
 defaultFlIt :: FloorItem
 defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}

src/Dodge/Floor.hs

@@ -11,9 +11,10 @@ import Dodge.Room
 --import Dodge.Data.DamageType
 --import Dodge.Placement.Instance.Button
 import Dodge.Tree
+import Dodge.PlacementSpot
 import Dodge.Annotation
 --import Dodge.Placement.Instance.Sensor
---import Dodge.Creature
+import Dodge.Creature
 --import Dodge.LevelGen.Data
 --import Dodge.LevelGen.Switch
 --import Dodge.Item.Weapon.Launcher
@@ -22,6 +23,7 @@ import Dodge.Annotation
 --import Dodge.Room.RunPast
 --import MonadHelp
 import Data.Tree
+import LensHelp
 --import Color
 --import Dodge.Wire
 
@@ -36,6 +38,11 @@ import System.Random
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithDoors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
+    , [SpecificRoom $ return . return . UseAll $ roomRectAutoLinks 400 400
+        & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit chaseCrit)
+                , spNoID anyUnusedSpot (PutCrit armourChaseCrit)
+                ]
+    ]
 --    , [AnoApplyInt 100 healthTest]
     , [SpecificRoom $ return . UseAll <$> tanksRoom [] []]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]

src/Dodge/Particle/Bullet/DestroyDamage.hs

@@ -8,21 +8,19 @@ import Dodge.SoundLogic
 import Geometry
 import LensHelp
 
--- TODO cleanup wrt destroyOnImpact etc
 bulletDestroyDamage :: DamageType
     -> Int  -- | damage amount
     -> Particle 
     -> [(Point2, Either Creature Wall)] 
     -> World 
     -> (World, Maybe Particle)
-bulletDestroyDamage dt amount = destroyOnImpact (bulDamageCr dt amount) 
+bulletDestroyDamage dt amount = destroyOnImpact 
+    (bulDamageCr dt amount) 
     (bulDamageWall dt amount)
 
-{- | Create a particle when hitting a creature.  -}
 bulDamageCr :: DamageType -> Int
     -> Particle -> Point2 -> Creature -> World -> World
 bulDamageCr dt amount bt p cr w = w
-    & bulletHitSound' p
     & creatures . ix cid . crState . crDamage .:~ Damage dt amount sp p ep NoDamageEffect
   where   
     cid = _crID cr
@@ -41,7 +39,3 @@ bulDamageWall dt amount bt p wl w = w
   where   
     ep = sp +.+ _ptVel bt
     sp = head $ _ptTrail bt
-
--- this is a duplicate! anyway, sound should be made by the hit creature
-bulletHitSound' :: Point2 -> World -> World
-bulletHitSound' p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -13,7 +13,6 @@ import Dodge.Particle.Spark
 import Dodge.Wall.Damage
 import Dodge.WorldEvent
 import Dodge.Particle.Bullet.Spawn
-import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.Creature.Property
 import Dodge.Wall.Reflect
@@ -33,7 +32,7 @@ crArmourSplit normalf armourf bt p cr
     | otherwise             = normalf bt p cr
 
 basicHitCr :: Particle -> Point2 -> Creature -> World -> World
-basicHitCr bt p cr = addDamage . bulletHitSound p
+basicHitCr bt p cr = addDamage 
   where
     sp = head $ _ptTrail bt
     bulVel = _ptVel bt
@@ -74,10 +73,9 @@ bounceArmour bt p cr = addBouncer . addDamageArmoured
 
 -- | Basic bullet hit creature effect.
 bulHitCr :: Particle -> Point2 -> Creature -> World -> World
-bulHitCr = crArmourSplit basicHitCr basicHitArmour
+bulHitCr = basicHitCr
+--bulHitCr = crArmourSplit basicHitCr basicHitArmour
 
-bulletHitSound :: Point2 -> World -> World
-bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
 {- | Bounce off armoured creatures, otherwise do damage.  -}
 bulBounceArmCr :: Particle -> Point2 -> Creature -> World -> World
 bulBounceArmCr = crArmourSplit basicHitCr bounceArmour
@@ -87,7 +85,6 @@ hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
 hvBulHitCr bt p cr w = w
     & creatures . ix cid . crState . crDamage .++~
         damageGamut 200 100 d1 sp p ep
-    & bulletHitSound ep
   where 
     (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     cid = _crID cr
@@ -114,7 +111,6 @@ bulDestroyCr :: (Point2 -> State StdGen Particle)
     -> Particle -> Point2 -> Creature -> World -> World
 bulDestroyCr f bt p cr w = w
     & instantParticles .:~ (pt & ptPos .~ p)
-    & bulletHitSound p
     & creatures . ix cid . crState . crDamage .:~ Damage Piercing 60 sp p ep NoDamageEffect
     & randGen .~ g
   where   

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,6 +1,5 @@
 module Dodge.WorldEvent.HitEffect
     ( destroyOnImpact
-    , noEff
     , penWalls
     ) where
 import Dodge.Data
@@ -59,6 +58,3 @@ penWalls crEff wlEff pt hitThings w = case hitThings of
     ((p,Right wl):hs) | _wlFireThrough wl 
                     -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
     ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
-
-noEff :: a -> b -> c -> d -> d
-noEff _ _ _ = id