diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs new file mode 100644 index 000000000..7ea322c49 --- /dev/null +++ b/src/Dodge/Creature/Damage.hs @@ -0,0 +1,51 @@ +module Dodge.Creature.Damage where +import Dodge.Data +import Dodge.SoundLogic +import Dodge.Creature.Property +import Dodge.Particle.Spark +import Color +import Geometry + +import Control.Lens +import Data.List + +defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature) +defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (id,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 = crHP -~ 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 :: (World -> World, Creature) -> Damage -> (World -> World, Creature) +applyIndividualDamage (f,cr) dm = case _dmType dm of + Piercing -> applyPiercingDamage cr dm & _1 %~ (. f) + _ -> (f , newcr ) + where + newcr = cr + & crHP -~ _dmAmount dm + & applyDamageEffect dm (_dmEffect dm) + +applyPiercingDamage :: Creature -> Damage -> (World -> World, Creature) +applyPiercingDamage cr dm + | crIsArmouredFrom p cr = (colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) , cr) + | otherwise = (id,cr & crHP -~ _dmAmount dm & applyDamageEffect dm (_dmEffect dm)) + where + p = _dmAt dm + p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)