89 lines
3.1 KiB
Haskell
89 lines
3.1 KiB
Haskell
module Dodge.Creature.Damage where
|
|
import Dodge.Data
|
|
import Dodge.Creature.Test
|
|
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
|
|
|
|
applyNoDamage :: [Damage] -> Creature -> World -> World
|
|
applyNoDamage _ _ = id
|
|
|
|
applyCreatureDamage :: [Damage] -> Creature -> World -> World
|
|
applyCreatureDamage dms cr = case _crMaterial cr of
|
|
Flesh -> defaultApplyDamage dms cr
|
|
Crystal -> id
|
|
_-> defaultApplyDamage dms cr
|
|
|
|
defaultApplyDamage :: [Damage] -> Creature -> World -> World
|
|
defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
|
|
& creatures . ix (_crID cr) %~ doPoisonDam
|
|
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 -> World -> World
|
|
applyDamageEffect dm de cr w = case de of
|
|
PushDamage push pushexp pushRad -> w
|
|
& 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 cr))**pushexp
|
|
PushBackDamage pback -> w
|
|
& creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
|
|
TorqueDamage rot -> w
|
|
& creatures . ix (_crID cr) . crDir +~ rot
|
|
BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
|
|
where
|
|
bouncer = (aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt)
|
|
(_buHitEff bt) (_buWidth bt)
|
|
) {_buTimer = _buTimer bt - 1}
|
|
pOut = p +.+ 2 *.* newDir
|
|
reflectVel = magV bulVel *.* newDir
|
|
newDir = squashNormalizeV (p -.- _crPos cr)
|
|
bulVel = _buVel bt
|
|
BounceBullet _ -> w
|
|
DamageSpawn f -> w & instantParticles .:~ thepart
|
|
& randGen .~ g
|
|
where
|
|
(thepart,g) = runState (f (Left cr) dm) $ _randGen w
|
|
DamageSpawn' f -> w & instantBullets .:~ thepart
|
|
& randGen .~ g
|
|
where
|
|
(thepart,g) = runState (f (Left cr) dm) $ _randGen w
|
|
NoDamageEffect -> w
|
|
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' :: Creature -> World -> Damage -> World
|
|
applyIndividualDamage' cr w dm = case _dmType dm of
|
|
PIERCING -> applyPiercingDamage cr dm w
|
|
_ -> w & damageHP cr (_dmAmount dm)
|
|
|
|
applyPiercingDamage :: Creature -> Damage -> World -> World
|
|
applyPiercingDamage cr dm
|
|
| crIsArmouredFrom p cr = colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p))
|
|
| otherwise = damageHP cr $ _dmAmount dm
|
|
where
|
|
p = _dmAt dm
|
|
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
|
|
|
|
damageHP :: Creature -> Int -> World -> World
|
|
damageHP cr x = creatures . ix (_crID cr) %~
|
|
( (crHP -~ x)
|
|
. (crPastDamage +~ x)
|
|
)
|