From 2b39152060e53972e8e42babc5ee8a7748168ac3 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 7 Jun 2025 10:28:17 +0100 Subject: [PATCH] Remove DamageEffect --- src/Dodge/Bullet.hs | 2 +- src/Dodge/Creature/Action/Blink.hs | 2 +- src/Dodge/Creature/Damage.hs | 34 +++++++++++++++--------------- src/Dodge/Creature/Impulse.hs | 2 +- src/Dodge/DamageCircle.hs | 4 ++-- src/Dodge/Data/Damage.hs | 21 +----------------- src/Dodge/Flame.hs | 2 +- src/Dodge/Item/Weapon/Shatter.hs | 2 +- src/Dodge/Laser/Update.hs | 2 +- src/Dodge/Machine/Update.hs | 7 +++++- src/Dodge/Prop/Moving.hs | 2 +- src/Dodge/Shockwave/Update.hs | 6 ++---- src/Dodge/Spark.hs | 7 +++--- src/Dodge/Spark/Draw.hs | 2 +- src/Dodge/Update.hs | 2 +- src/Dodge/Update/Cloud.hs | 2 +- 16 files changed, 41 insertions(+), 58 deletions(-) diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 60a460257..616a3a289 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -27,7 +27,7 @@ updateBullet w bu buDamages :: Bullet -> [Damage] buDamages bu = case _buPayload bu of BulBall {} -> [] - BulPlain x -> [Damage PIERCING x 0 0 0 $ PushBackDamage 2] + BulPlain x -> [Damage PIERCING x 0 0 0] BulFlak -> [] BulFrag -> [] BulGas -> [] diff --git a/src/Dodge/Creature/Action/Blink.hs b/src/Dodge/Creature/Action/Blink.hs index 8d5d63fa7..1120e9171 100644 --- a/src/Dodge/Creature/Action/Blink.hs +++ b/src/Dodge/Creature/Action/Blink.hs @@ -68,7 +68,7 @@ unsafeBlinkAction cr w w & blinkActionFail cr & cWorld . lWorld . creatures . ix cid . crState . csDamage - .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect + .:~ Damage ENTERREMENT 10000 mwp mwp mwp where success = fromMaybe True $ do wl <- snd $ collidePointWallsFilter (const True) mwp cpos w diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 7b1d9e697..0ab229aad 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -1,7 +1,6 @@ module Dodge.Creature.Damage (applyCreatureDamage) where import Dodge.Creature.Material -import Dodge.Creature.Mass import Data.List import Dodge.Creature.Test import Dodge.Data.World @@ -26,26 +25,27 @@ defaultApplyDamage ds cr w = poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10 doPoisonDam = crHP -~ poisonDam -applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World -applyDamageEffect dm de cr = case de of - PushDamage push pushexp pushRad -> - cWorld . lWorld . creatures . ix (_crID 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 (_crType cr))) ** pushexp - PushBackDamage pback -> - cWorld . lWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / crMass (_crType cr)) *.* (_dmTo dm -.- fromDir) - TorqueDamage rot -> - cWorld . lWorld . creatures . ix (_crID cr) . crDir +~ rot - NoDamageEffect -> id - where - fromDir = _dmFrom dm +--applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World +--applyDamageEffect dm de cr = case de of +-- PushDamage push pushexp pushRad -> +-- cWorld . lWorld . creatures . ix (_crID 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 (_crType cr))) ** pushexp +-- PushBackDamage pback -> +-- cWorld . lWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / crMass (_crType cr)) *.* (_dmTo dm -.- fromDir) +-- TorqueDamage rot -> +-- cWorld . lWorld . creatures . ix (_crID cr) . crDir +~ rot +-- NoDamageEffect -> id +-- where +-- fromDir = _dmFrom dm --p = _dmAt dm applyIndividualDamage :: Creature -> World -> Damage -> World -applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm +--applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm +applyIndividualDamage cr w dm = applyIndividualDamage' cr w dm applyIndividualDamage' :: Creature -> World -> Damage -> World applyIndividualDamage' cr w dm = case _dmType dm of diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 5d63238df..45fa0d2d6 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -87,6 +87,6 @@ followImpulse cr w imp = case imp of rr a = randomR (- a, a) $ _randGen w hitCr i = ( cWorld . lWorld . creatures . ix i . crState . csDamage - .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) (PushBackDamage 5) + .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i)-- (PushBackDamage 5) ) . soundStart (CrSound cid) cpos hitS Nothing diff --git a/src/Dodge/DamageCircle.hs b/src/Dodge/DamageCircle.hs index b5d1dd6bd..9c93f0f2e 100644 --- a/src/Dodge/DamageCircle.hs +++ b/src/Dodge/DamageCircle.hs @@ -18,9 +18,9 @@ damageCircle r sp dt da w = --addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam wlstodam = wlsHitRadial sp r w - wldam p = Damage dt da sp p (sp +.+ r *.* normalizeV (p -.- sp)) NoDamageEffect + wldam p = Damage dt da sp p (sp +.+ r *.* normalizeV (p -.- sp)) addcreaturedamages crs = foldl' (damageCrCircle crdam) crs crstodam - crdam p cr = Damage dt da sp p (_crPos cr) NoDamageEffect + crdam p cr = Damage dt da sp p (_crPos cr) crstodam = crsHitRadial sp r w damageWlCircle :: diff --git a/src/Dodge/Data/Damage.hs b/src/Dodge/Data/Damage.hs index 58514e4ff..e0f503f2e 100644 --- a/src/Dodge/Data/Damage.hs +++ b/src/Dodge/Data/Damage.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} @@ -18,33 +18,14 @@ import Data.Aeson.TH import Dodge.Data.Damage.Type import Geometry.Data -data DamageEffect - = PushDamage - { _dePush :: Float - , _dePushExp :: Float - , _dePushRadius :: Float - } - | TorqueDamage {_deTorque :: Float} - | PushBackDamage {_dePushBack :: Float} - | NoDamageEffect - deriving (Eq, Ord, Show, Read) --Generic, Flat) - data Damage = Damage { _dmType :: DamageType , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 - , _dmEffect :: DamageEffect } deriving (Eq, Ord, Show, Read) --Generic, Flat) -isElectrical :: Damage -> Bool -isElectrical dm = case _dmType dm of - ELECTRICAL -> True - _ -> False - makeLenses ''Damage -makeLenses ''DamageEffect -deriveJSON defaultOptions ''DamageEffect deriveJSON defaultOptions ''Damage diff --git a/src/Dodge/Flame.hs b/src/Dodge/Flame.hs index e28e519aa..a543303e8 100644 --- a/src/Dodge/Flame.hs +++ b/src/Dodge/Flame.hs @@ -39,7 +39,7 @@ aFlameParticle t pos vel = } simpleDamFL :: DamageType -> Int -> Flame -> Point2 -> [Damage] -simpleDamFL dt amount bt p = [Damage dt amount sp p ep NoDamageEffect] +simpleDamFL dt amount bt p = [Damage dt amount sp p ep] where sp = _flPos bt bulVel = _flVel bt diff --git a/src/Dodge/Item/Weapon/Shatter.hs b/src/Dodge/Item/Weapon/Shatter.hs index c42e2e029..621db8aca 100644 --- a/src/Dodge/Item/Weapon/Shatter.hs +++ b/src/Dodge/Item/Weapon/Shatter.hs @@ -35,4 +35,4 @@ shatterWall w sp ep p wl = (_wlMaterial wl) (_wlColor wl) p - & damageWall (Damage SHATTERING 1000 sp p ep NoDamageEffect) wl + & damageWall (Damage SHATTERING 1000 sp p ep) wl diff --git a/src/Dodge/Laser/Update.hs b/src/Dodge/Laser/Update.hs index 7855e039a..424806420 100644 --- a/src/Dodge/Laser/Update.hs +++ b/src/Dodge/Laser/Update.hs @@ -16,7 +16,7 @@ updateLaser w pt = ( case _lpType pt of DamageLaser dam -> damThingHitWith - (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) + (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3) sp xp thHit diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 35042d7c0..c8bd981ac 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -56,7 +56,7 @@ updateTurret rotSpeed mc w = where dodamage = cWorld . lWorld . machines . ix mcid - %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect]) + %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0]) . (mcHP -~ dam) ) elecDamBranch @@ -77,6 +77,11 @@ updateTurret rotSpeed mc w = | closeFireAngle = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20 | otherwise = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1) +isElectrical :: Damage -> Bool +isElectrical dm = case _dmType dm of + ELECTRICAL -> True + _ -> False + mcUseItem :: Machine -> World -> World mcUseItem mc = fromMaybe id $ do tu <- mc ^? mcType . _McTurret diff --git a/src/Dodge/Prop/Moving.hs b/src/Dodge/Prop/Moving.hs index 9ee6f6ba6..1b5781854 100644 --- a/src/Dodge/Prop/Moving.hs +++ b/src/Dodge/Prop/Moving.hs @@ -23,7 +23,7 @@ fallSmallBounceDamage pr w = dodamage' cr | dist (_crPos cr) p < crRad (cr ^. crType) + 5 = cr & crState . csDamage - .:~ Damage CRUSHING (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect + .:~ Damage CRUSHING (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) (p -.- v) p (p +.+ v) | otherwise = cr fallSmallBounce :: Prop -> World -> World diff --git a/src/Dodge/Shockwave/Update.hs b/src/Dodge/Shockwave/Update.hs index 79b83cd33..d6c88d5c7 100644 --- a/src/Dodge/Shockwave/Update.hs +++ b/src/Dodge/Shockwave/Update.hs @@ -23,7 +23,6 @@ moveShockwave w sw is = _swInvulnerableCrs sw r = _swRad sw p = _swPos sw - push = _swPush sw dam = _swDam sw t = _swTimer sw tFraction = fromIntegral t / fromIntegral (_swMaxTime sw) @@ -31,7 +30,7 @@ moveShockwave w sw doDams w' = over (cWorld . lWorld . creatures) (IM.map damCr) $ foldl' - (flip $ damageWall (Damage EXPLOSIVE 1000 p p p NoDamageEffect)) + (flip $ damageWall (Damage EXPLOSIVE 1000 p p p)) w' hitBlocks hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w @@ -46,7 +45,6 @@ moveShockwave w sw (cpos -.- v) cpos (cpos +.+ v) - (PushBackDamage (25 * push)) where cpos = _crPos cr v = normalizeV (cpos -.- p) @@ -69,7 +67,7 @@ moveInverseShockwave w sw | dist (_crPos cr) p >= rad + crRad (cr ^. crType) = cr | otherwise = cr & crState . csDamage - .:~ Damage CONCUSSIVE 1 (cpos +.+ v) cpos (cpos -.- v) (PushBackDamage 25) + .:~ Damage CONCUSSIVE 1 (cpos +.+ v) cpos (cpos -.- v) where cpos = _crPos cr v = normalizeV (cpos -.- p) diff --git a/src/Dodge/Spark.hs b/src/Dodge/Spark.hs index f3761ae0d..89fdc4300 100644 --- a/src/Dodge/Spark.hs +++ b/src/Dodge/Spark.hs @@ -20,15 +20,14 @@ updateSpark :: World -> Spark -> (World, Maybe Spark) updateSpark w sk | magV (_skVel sk) < 1 = (w, Nothing) | otherwise = case thingHit sp ep w of - Nothing -> (w, Just $ sk & skPos .~ ep & skVel .*.*~ 0.9 & skOldPos .~ sp) + Nothing -> (w, Just $ sk & skPos .~ ep & skVel *~ 0.9 & skOldPos .~ sp) Just (hp, hthing) -> - --( sparkDam sk sp ep (hp, hthing) w ( sparkDam' sk sp ep (hp, hthing) w , Just $ sk & skPos .~ hp & skOldPos .~ sp & skVel .~ 0 ) where sp = _skPos sk - ep = sp +.+ _skVel sk + ep = sp + _skVel sk sparkDam' :: Spark -> @@ -40,7 +39,7 @@ sparkDam' :: sparkDam' sk sp ep mayEiCrWl = case mayEiCrWl of (hitp, eicrwl) -> damageCrWl (thedam hitp) eicrwl where - thedam hitp = Damage (sparkToDamage sk) 10 sp hitp ep NoDamageEffect + thedam hitp = Damage (sparkToDamage sk) 10 sp hitp ep -- NoDamageEffect sparkToDamage :: Spark -> DamageType sparkToDamage sp = case _skType sp of diff --git a/src/Dodge/Spark/Draw.hs b/src/Dodge/Spark/Draw.hs index 223b7cc33..0c93be99c 100644 --- a/src/Dodge/Spark/Draw.hs +++ b/src/Dodge/Spark/Draw.hs @@ -15,4 +15,4 @@ skColor :: Spark -> Color skColor sk = case _skType sk of ElectricSpark -> brightX 100 1.5 cyan FireSpark -> V4 20 (-5) 0 1 - NormalSpark -> V4 2 1.5 0.5 2 + NormalSpark -> V4 1.5 1 0.2 2 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index a7cbcc6fe..ac5ba7185 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -576,7 +576,7 @@ updateTeslaArc w pt ) | ArcStep lp' ld' _ <- last thearc = (lp', rp ld') damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl - thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect + thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) where q = 5 *.* unitVectorAtAngle dir diff --git a/src/Dodge/Update/Cloud.hs b/src/Dodge/Update/Cloud.hs index 19e775619..6afd2091f 100644 --- a/src/Dodge/Update/Cloud.hs +++ b/src/Dodge/Update/Cloud.hs @@ -14,6 +14,6 @@ cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w) dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs doDam cr = cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage - .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect + .:~ Damage POISONDAM 1 clpos clpos clpos f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < crRad (cr ^. crType) + _clRad c + 10 clpos = stripZ $ _clPos c