215 lines
7.7 KiB
Haskell
215 lines
7.7 KiB
Haskell
{- |
|
|
Effects of bullets upon impact with walls or creatures, and possibly force fields.
|
|
-}
|
|
module Dodge.Particle.Bullet.HitEffect
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Data.DamageType
|
|
import Dodge.Data.SoundOrigin
|
|
--import Dodge.Base
|
|
import Dodge.WorldEvent
|
|
import Dodge.Particle.Bullet.Spawn
|
|
import Dodge.WorldEvent.DamageBlock
|
|
import Dodge.SoundLogic
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.RandomHelp
|
|
import Dodge.WorldEvent.Shockwave
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Creature.Property
|
|
import Geometry
|
|
import Geometry.Vector3D
|
|
import Picture
|
|
|
|
import System.Random
|
|
import Control.Lens
|
|
import Control.Monad.State
|
|
--import Data.Maybe
|
|
--import qualified Data.IntMap.Strict as IM
|
|
--
|
|
-- | Basic bullet hit creature effect.
|
|
bulHitCr :: Particle -> Point2 -> Creature -> World -> World
|
|
bulHitCr bt p cr w
|
|
| crIsArmouredFrom p cr
|
|
= createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w
|
|
| otherwise = addDamage . makeHitSound . flashEff $ w
|
|
where
|
|
sp = head $ _btTrail' bt
|
|
bulVel = _btVel' bt
|
|
ep = sp +.+ bulVel
|
|
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
|
|
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
|
|
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
|
|
makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
|
|
flashEff = over worldEvents (bloodFlashAt p . )
|
|
cid = _crID cr
|
|
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
|
colID = _btColor' bt
|
|
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
|
|
{- | Bounce off armoured creatures, otherwise do damage. -}
|
|
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
|
|
bulBounceArmCr' bt p cr w
|
|
| crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
|
|
| otherwise = addDamage . makeHitSound . flashEff $ w
|
|
where
|
|
sp = head $ _btTrail' bt
|
|
bulVel = _btVel' bt
|
|
ep = sp +.+ bulVel
|
|
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
|
|
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
|
|
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
|
|
makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
|
|
flashEff = over worldEvents ((.) $ bloodFlashAt p)
|
|
cid = _crID cr
|
|
newDir = safeNormalizeV (p -.- _crPos cr)
|
|
pOut = p +.+ 2 *.* newDir
|
|
reflectVel = magV bulVel *.* newDir
|
|
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
|
|
bouncer = (aGenBulAt Nothing pOut reflectVel
|
|
(_btHitEffect' bt) (_btWidth' bt)
|
|
) {_btTimer' = _btTimer' bt - 1}
|
|
{- | Bullet pass through creatures. -}
|
|
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
|
|
bulPenCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
([Piercing 50 sp p ep
|
|
,Blunt 50 sp p ep
|
|
,TorqueDam 1 d1
|
|
,PushDam 1 $ 3 *.* (ep -.- sp)
|
|
]
|
|
++
|
|
)
|
|
$ soundMultiFrom [CrHitSound 0] ep hit1S (Just 10)
|
|
$ over worldEvents (addPiercer . )
|
|
w
|
|
where
|
|
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
|
cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
addPiercer = over particles (piercer :)
|
|
piercer = (aGenBulAt (Just cid) p (_btVel' bt)
|
|
(_btHitEffect' bt) (_btWidth' bt)
|
|
) {_btTimer' = _btTimer' bt - 1}
|
|
{- | Heavy bullet effects when hitting creature:
|
|
piercing, blunt, twisting and pushback damage all applied. -}
|
|
hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
|
|
hvBulHitCr bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
([Piercing 200 sp p ep
|
|
,Blunt 100 sp p ep
|
|
,TorqueDam 1 d1
|
|
,PushDam 1 $ 3 *.* (ep -.- sp)
|
|
]
|
|
++
|
|
)
|
|
$ soundMultiFrom [CrHitSound 0] ep hit1S (Just 10)
|
|
w
|
|
where
|
|
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
|
cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
{- | Create a flamelet when hitting a creature. -}
|
|
bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
|
|
bulIncCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
( Piercing 60 sp p ep : )
|
|
. soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
|
|
$ incFlamelets
|
|
w
|
|
where
|
|
cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
v = evalState (randInCirc 1) $ _randGen w
|
|
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20)
|
|
{- | Creates a shockwave when hitting a creature. -}
|
|
bulConCr' :: Particle -> Point2 -> Creature -> World -> World
|
|
bulConCr' bt p cr w
|
|
= over (creatures . ix cid . crState . crDamage)
|
|
( Piercing 60 sp p ep : )
|
|
. soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
|
|
$ mkwave
|
|
w
|
|
where
|
|
cid = _crID cr
|
|
sp = head $ _btTrail' bt
|
|
ep = sp +.+ _btVel' bt
|
|
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
|
|
{- | Hitting wall effects: create a spark, damage blocks. -}
|
|
bulHitWall :: Particle -> Point2 -> Wall -> World -> World
|
|
bulHitWall bt p wl w = damageBlocksBy 5 wl
|
|
. smokeCloudAt dustcol 20 200 1 (addZ 20 pOut)
|
|
. createSparkCol 8 theCol pOut (reflectDir wl)
|
|
$ set randGen g
|
|
w
|
|
where
|
|
dustcol = _wlColor wl & _4 .~ 1
|
|
theCol = brightX 100 1.5 white
|
|
sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
(a, g) = randomR (-0.2,0.2) $ _randGen w
|
|
reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
|
|
{- | Bounce off walls, do damage to blocks. -}
|
|
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
|
|
bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w
|
|
where
|
|
sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
bouncer = (aGenBulAt Nothing pOut reflectVel
|
|
(_btHitEffect' bt) (_btWidth' bt)
|
|
) {_btTimer' = _btTimer' bt - 1}
|
|
wallV = uncurry (-.-) (_wlLine wl)
|
|
reflectVel = reflectIn wallV (_btVel' bt)
|
|
addBouncer = ( over particles (bouncer : ) . )
|
|
-- the hack is to get around the fact that the particles list gets reset after
|
|
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
|
|
-- this list
|
|
|
|
{- | Create flamelet on wall. -}
|
|
bulIncWall'
|
|
:: Particle
|
|
-> Point2 -- Impact point
|
|
-> Wall
|
|
-> World
|
|
-> World
|
|
bulIncWall' bt p wl w = damageBlocksBy 5 wl $ incFlamelets w
|
|
where
|
|
sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
wallV = uncurry (-.-) (_wlLine wl)
|
|
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
|
|
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20)
|
|
{- | Create a shockwave on wall-}
|
|
bulConWall'
|
|
:: Particle
|
|
-> Point2 -- ^ Impact point
|
|
-> Wall
|
|
-> World
|
|
-> World
|
|
bulConWall' _ p wl = damageBlocksBy 1 wl .
|
|
over worldEvents ( makeShockwaveAt [] p 15 4 1 white . )
|
|
|
|
hvBulHitWall'
|
|
:: Particle
|
|
-> Point2 -- ^ Impact point
|
|
-> Wall
|
|
-> World
|
|
-> World
|
|
hvBulHitWall' bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
|
|
where
|
|
sp = head $ _btTrail' bt
|
|
pOut = p +.+ safeNormalizeV (sp -.- p)
|
|
(a, g) = randomR (-0.2,0.2) $ _randGen w
|
|
reflectDir wall = a +
|
|
argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
|
|
sv = unitVectorAtAngle $ reflectDir x
|
|
cs' = take 10 $ randomRs (0,11) $ _randGen w
|
|
cs = map (brightX 100 1.5 . numColor) cs'
|
|
ds = randomRs (-0.7,0.7) $ _randGen w
|
|
ts = randomRs (4,8) $ _randGen w
|
|
sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds
|
|
|
|
bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
|
|
bulHitFF' _ _ _ = id
|