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.Data.DamageType
import Dodge.Data.SoundOrigin
import Dodge.Wall.Damage
import Dodge.WorldEvent
import Dodge.Particle.Bullet.Spawn
import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound
import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave
import Dodge.Creature.State.Data
import Dodge.Creature.Property
import Dodge.Wall.Reflect
import Geometry
--import Geometry.Vector3D
import Picture

import System.Random
import Control.Lens
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 colID p1 (argV (p1 -.- p)) $ addDamageArmoured w
    | otherwise = addDamage . bulletHitSound p $ 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 ++)
    cid = _crID cr
    colID = _btColor' bt
    p1 = p +.+ 2 *.* safeNormalizeV (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 $ _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 ++)
    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)
            ] 
            ++
           )
    $ bulletHitSound ep
    $ 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)
            ] 
            ++
           )
    $ bulletHitSound ep
    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 : )
    $ bulletHitSound p
    $ 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)
           ( Blunt 10 sp p ep : )
    $ bulletHitSound p
    $ (worldEvents %~ (makeShockwaveAt [] p 15 4 1 white . ))
    w
  where   
    cid = _crID cr
    sp = head $ _btTrail' bt
    ep = sp +.+ _btVel' 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 +.+ _btVel' bt
    sp = head $ _btTrail' 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 worldEvents addBouncer
  where 
    ep = sp +.+ _btVel' bt
    sp = head $ _btTrail' bt
    pOut = p +.+ safeNormalizeV (sp -.- p)
    bouncer = (aGenBulAt Nothing pOut reflectVel (_btHitEffect' bt) (_btWidth' bt)
              ) {_btTimer' = _btTimer' bt - 1}
    reflectVel = reflVelWall wl (_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 =  damageWall (Blunt 50 sp p ep) wl . incFlamelets
  where   
    ep = sp +.+ _btVel' bt
    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 bt p wl = damageWall (Blunt 10 sp p ep) wl .
    over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
  where   
    ep = sp +.+ _btVel' bt
    sp = head $ _btTrail' 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 +.+ _btVel' bt
    sp = head $ _btTrail' bt
    pOut = p +.+ safeNormalizeV (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