73 lines
2.7 KiB
Haskell
73 lines
2.7 KiB
Haskell
module Dodge.Creature.Damage where
|
|
import Dodge.Data
|
|
import Dodge.Creature.Property
|
|
import Dodge.Particle.Spark
|
|
import Dodge.Particle.Bullet.Spawn
|
|
import Color
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
import Control.Monad.State
|
|
import System.Random
|
|
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 -> (World->World,Creature) -> (World -> World, Creature)
|
|
applyDamageEffect dm de (f,cr) = case de of
|
|
PushDamage push pushexp pushRad -> (f, 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 -> (f, cr
|
|
& crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
|
|
)
|
|
TorqueDamage rot -> (f, cr & crDir +~ rot)
|
|
BounceBullet bt | crIsArmouredFrom p cr -> (f . (instantParticles .:~ bouncer), cr) -- TODO
|
|
where
|
|
bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
|
|
(_ptHitEff bt) (_ptWidth bt)
|
|
) {_ptTimer = _ptTimer bt - 1}
|
|
pOut = p +.+ 2 *.* newDir
|
|
reflectVel = magV bulVel *.* newDir
|
|
newDir = squashNormalizeV (p -.- _crPos cr)
|
|
bulVel = _ptVel bt
|
|
DamageSpawn f -> (instantParticles .:~ thepart, cr)
|
|
where
|
|
thepart = evalState (f (Left cr) dm) $ mkStdGen 0
|
|
where
|
|
fromDir = _dmFrom dm
|
|
p = _dmAt dm
|
|
|
|
applyIndividualDamage :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
|
|
applyIndividualDamage (f,cr) dm = applyDamageEffect dm (_dmEffect dm) (f . f', cr')
|
|
where
|
|
(f',cr') = applyIndividualDamage' (f,cr) dm
|
|
|
|
-- & applyDamageEffect dm (_dmEffect 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
|
|
|
|
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)
|
|
where
|
|
p = _dmAt dm
|
|
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
|