Remove DamageEffect

This commit is contained in:
2025-06-07 10:28:17 +01:00
parent 500772f2f9
commit 2b39152060
16 changed files with 41 additions and 58 deletions
+1 -1
View File
@@ -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 -> []
+1 -1
View File
@@ -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
+17 -17
View File
@@ -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
+1 -1
View File
@@ -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
+2 -2
View File
@@ -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 ::
+1 -20
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+6 -1
View File
@@ -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
+1 -1
View File
@@ -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
+2 -4
View File
@@ -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)
+3 -4
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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