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 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 = _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
    colID = _btColor' bt
    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 $ _btTrail' 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 = worldEvents %~ ( over particles (bouncer :) . )
    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt)
                                      (_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 instantParticles (piercer :)
    w
  where 
    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
    cid = _crID cr
    sp = head $ _btTrail' bt
    ep = sp +.+ _ptVel bt
    piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag 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 +.+ _ptVel 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 +.+ _ptVel 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
    = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
    . over worldEvents (makeShockwaveAt [] p 15 4 1 white .)
    . bulletHitSound p
  where   
    cid = _crID cr
    sp = head $ _btTrail' 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 $ _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 +.+ _ptVel bt
    sp = head $ _btTrail' bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    bouncer = (aGenBulAt Nothing pOut reflectVel 0.5 (_btHitEffect' bt) (_btWidth' bt)
              ) {_btTimer' = _btTimer' bt - 1}
    reflectVel = reflVelWall wl (_ptVel 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 +.+ _ptVel bt
    sp = head $ _btTrail' bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    wallV = uncurry (-.-) (_wlLine wl)
    reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel 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 +.+ _ptVel 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 +.+ _ptVel bt
    sp = head $ _btTrail' 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