{- | Effects of bullets upon impact with walls or creatures. -} module Dodge.Particle.Bullet.HitEffect where import Dodge.Data import Dodge.Particle.Spark 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 = 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 +.+ _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