From 9adc7c81f483f434c6f02d88e44ed22002e5aea0 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 25 Mar 2022 08:33:54 +0000 Subject: [PATCH] Make damage application belong to hit object --- src/Dodge/Creature/Inanimate.hs | 2 +- src/Dodge/Creature/Lamp.hs | 2 +- src/Dodge/Creature/State.hs | 22 ++++++++------- src/Dodge/Data/DamageType.hs | 4 +-- src/Dodge/Default.hs | 32 +--------------------- src/Dodge/Floor.hs | 9 +++++- src/Dodge/Particle/Bullet/DestroyDamage.hs | 10 ++----- src/Dodge/Particle/Bullet/HitEffect.hs | 10 ++----- src/Dodge/WorldEvent/HitEffect.hs | 4 --- 9 files changed, 30 insertions(+), 65 deletions(-) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 16c26a23b..ff70ed244 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/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 diff --git a/src/Dodge/Creature/Lamp.hs b/src/Dodge/Creature/Lamp.hs index 1b769d98a..271d21be8 100644 --- a/src/Dodge/Creature/Lamp.hs +++ b/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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 0db10aa76..7a4eee020 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 241579dfd..8e3906448 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 45516c4ed..fb364f411 100644 --- a/src/Dodge/Default.hs +++ b/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} diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 7b3ff01f4..6e06e0f2f 100644 --- a/src/Dodge/Floor.hs +++ b/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] diff --git a/src/Dodge/Particle/Bullet/DestroyDamage.hs b/src/Dodge/Particle/Bullet/DestroyDamage.hs index 2b488224e..4aa989a43 100644 --- a/src/Dodge/Particle/Bullet/DestroyDamage.hs +++ b/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) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 36167382b..9555e6ce0 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 10636c236..88e74899c 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/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