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

{- |
Effects of bullets upon impact with walls or creatures, and possibly force fields.
 -}
module Dodge.Particle.Bullet.HitEffect
    where
import Dodge.Data
--import Dodge.Base
import Dodge.WorldEvent
import Dodge.Particle.Bullet.Spawn
import Dodge.WorldEvent.DamageBlock
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave
import Dodge.Creature.State.Data
import Dodge.Creature.Property
import Geometry
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] 15 10 0
    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] 15 10 0
    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] 15 10 0
    $ 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] 15 10 0
    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] 15 10 0
    $ 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] 15 10 0
    $ 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 x w = damageBlocksBy 5 x
    $ createSparkCol 8 theCol pOut (reflectDir x)
    $ set randGen g
    w
  where 
    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
{- | Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.  -}
basicBulletEffect :: HitEffect
basicBulletEffect = destroyOnImpact bulHitCr bulHitWall' bulHitFF'