loop/src/Dodge/Particle/Bullet/HitEffect.hs

{- | Effects of bullets upon impact with walls or creatures.  -}
module Dodge.Particle.Bullet.HitEffect where
import Dodge.Data
import Dodge.Particle.Spark
import Dodge.Wall.Damage
import Dodge.WorldEvent
import Dodge.Particle.Bullet.Spawn
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave
import Dodge.Creature.Property
import Dodge.Wall.Reflect
import Geometry
import Picture
import LensHelp

import System.Random
import Control.Monad.State
-- | Basic bullet hit creature effect.
bulHitCr :: Particle -> Point2 -> Creature -> World -> World
bulHitCr bt p cr w 
    | crIsArmouredFrom p cr
        = colSpark 8 (_ptColor bt) p1 (argV (p1 -.- p)) $ addDamageArmoured w
    | otherwise = addDamage . bulletHitSound p $ w
  where
    sp = head $ _ptTrail bt
    bulVel = _ptVel 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
    cid = _crID cr
    p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)

bulletHitSound :: Point2 -> World -> World
bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
{- | 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 . bulletHitSound p $ w
  where
    sp = head $ _ptTrail bt
    bulVel = _ptVel 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
    cid = _crID cr
    newDir = squashNormalizeV (p -.- _crPos cr)
    pOut = p +.+ 2 *.* newDir
    reflectVel = magV bulVel *.* newDir
    addBouncer = instantParticles .:~ bouncer
    bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
                                      (_ptHitEff bt) (_ptWidth bt)
              ) {_ptTimer = _ptTimer bt - 1}
{- | Bullet pass through creatures.  -}
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
bulPenCr' bt p cr w = w
    & instantParticles .:~ piercer
    & bulletHitSound ep
    & creatures . ix cid . crState . crDamage .++~
        [Piercing 50 sp p ep
        ,Blunt    50  sp p ep
        ,TorqueDam 1 d1
        ,PushDam 1 $ 3 *.* (ep -.- sp)
        ] 
  where 
    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
    cid = _crID cr
    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
    piercer = (aBulAt Nothing id (Just (_ptColor bt)) (Just cid) p (_ptVel bt) (_btDrag bt)
                                      (_ptHitEff bt) (_ptWidth bt)
              ) {_ptTimer = _ptTimer 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 = w
    & creatures . ix cid . crState . crDamage .++~
        [Piercing 200 sp p ep
        ,Blunt    100  sp p ep
        ,TorqueDam 1 d1
        ,PushDam 1 $ 3 *.* (ep -.- sp)
        ] 
    & bulletHitSound ep
  where 
    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
    cid = _crID cr
    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
{- | Create a flamelet when hitting a creature.  -}
bulIncCr :: Particle -> Point2 -> Creature -> World -> World
bulIncCr bt p cr w = w
    & makeFlamelet p 20 v Nothing 3 20
    & bulletHitSound p
    & creatures . ix cid . crState . crDamage .:~ Piercing 60 sp p ep
  where   
    cid = _crID cr
    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
    v = evalState (randInCirc 1) $ _randGen w
{- | Creates a shockwave when hitting a creature.  -}
bulConCr :: Particle -> Point2 -> Creature -> World -> World
bulConCr bt p cr = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
    . makeShockwaveAt [] p 15 4 1 white
    . bulletHitSound p
  where   
    cid = _crID cr
    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
{- | Hitting wall effects: create a spark, damage blocks.  -}
bulHitWall :: Particle -> Point2 -> Wall -> World -> World
bulHitWall bt p = damageWall (Piercing 100 sp p ep)
  where 
    ep = sp +.+ _ptVel bt
    sp = head $ _ptTrail bt
{- | Bounce off walls, do damage to blocks.  -}
bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl 
    . over instantParticles (bouncer :)
  where 
    ep = sp +.+ _ptVel bt
    sp = head $ _ptTrail bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
              ) {_ptTimer = _ptTimer bt - 1}
    reflectVel = reflVelWall wl (_ptVel bt)
-- 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 = damageWall (Blunt 50 sp p ep) wl 
    . makeFlamelet pOut 20 reflectVel Nothing 3 20
  where   
    ep = sp +.+ _ptVel bt
    sp = head $ _ptTrail bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    wallV = uncurry (-.-) (_wlLine wl)
    reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
{- | Create a shockwave on wall-}
bulConWall
    :: Particle 
    -> Point2   -- ^ Impact point
    -> Wall 
    -> World 
    -> World
bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl .
    makeShockwaveAt [] p 15 4 1 white
  where   
    ep = sp +.+ _ptVel bt
    sp = head $ _ptTrail bt

hvBulHitWall
    :: Particle 
    -> Point2   -- ^ Impact point
    -> Wall 
    -> World 
    -> World
hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl 
    . damageWall (Blunt 100 sp p ep) wl  
    $ set randGen g $ foldr ($) w (sparks pOut sv)
  where 
    ep = sp +.+ _ptVel bt
    sp = head $ _ptTrail bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    (a, g) = randomR (-0.2,0.2) $ _randGen w
    sv = unitVectorAtAngle $ a + reflDirWall sp p wl
    cs'      = take 10 $ randomRs (0,11) $ _randGen w
    cs      = map (brightX 100 1.5 . numColor) cs'
    ts      = randomRs (4,8) $ _randGen w
    sparks pos vel = zipWith (\t c -> colSpark t c pos (argV vel)) ts cs