loop/src/Dodge/Wall/DamageEffect.hs

module Dodge.Wall.DamageEffect where
import Dodge.Data
import Dodge.Bullet
import Dodge.Spark
import Dodge.Base.Wall
import Dodge.Wall.Dust
import Dodge.Block
import Geometry
import LensHelp

import Control.Monad.State
--import Data.Maybe

defaultWallDamage :: Damage -> Wall -> World -> (World,Int)
defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial wl of
    Stone   -> stoneWallDamage dm wl
    Glass   -> windowWallDamage dm wl
    Dirt    -> dirtWallDamage dm wl
    Crystal -> crystalWallDamage dm wl
    Metal   -> stoneWallDamage dm wl
    Wood    -> stoneWallDamage dm wl
    Electronics -> stoneWallDamage dm wl
    Flesh -> stoneWallDamage dm wl

stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
stoneWallDamage dm wl = case _dmType dm of
    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
    PIERCING    -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
    BLUNT       -> a d $ wlDustAt wl outTo
    SHATTERING  -> a d $ muchWlDustAt wl outTo
    CRUSHING    -> a d id
    EXPLOSIVE   -> a d id
    CUTTING     -> a d id
    SPARKING    -> a 0 id
    FLAMING     -> a 0 id
    ELECTRICAL  -> a 0 id
    CONCUSSIVE  -> a d id
    TORQUEDAM   -> a 0 id
    PUSHDAM     -> a 0 id
    POISONDAM   -> a 0 id
    ENTERREMENT -> a 0 id
  where
    a x f w = (f w,x)
    d = _dmAmount dm
    sp = _dmFrom dm
    p = _dmAt dm
    outTo = p +.+ squashNormalizeV (sp -.- p)
    pSparkCol = V4 5 1 0.5 2
    lSparkCol = V4 20 (-5) 0 1

windowWallDamage :: Damage -> Wall -> World -> (World,Int)
windowWallDamage dm wl w = w & case _dmType dm of
    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
    PIERCING    -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
    BLUNT       -> a d $ dosplint . wlDustAt wl outTo
    SHATTERING  -> a d $ dosplint . muchWlDustAt wl outTo
    CRUSHING    -> a d dosplint
    EXPLOSIVE   -> a d dosplint
    CUTTING     -> a d dosplint
    SPARKING    -> a 0 id
    FLAMING     -> a 0 id
    ELECTRICAL  -> a 0 id
    CONCUSSIVE  -> a 0 dosplint
    TORQUEDAM   -> a 0 id
    PUSHDAM     -> a 0 id
    POISONDAM   -> a 0 id
    ENTERREMENT -> a 0 id
  where
    mbl = do 
        blid <- wl ^? wlStructure . wsBlock
        w ^? blocks . ix blid
    d :: Int
    d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
    a :: Int -> (World -> World) -> World -> (World,Int)
    a x f w' = (f w',x)
    dosplint = maybe id splinterBlock mbl
    sp = _dmFrom dm
    p = _dmAt dm
    outTo = p +.+ squashNormalizeV (sp -.- p)
    pSparkCol = V4 5 1 0.5 2
    lSparkCol = V4 20 (-5) 0 1

crystalWallDamage :: Damage -> Wall -> World -> (World,Int)
crystalWallDamage dm wl = case _dmType dm of
    LASERING    -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
    PIERCING    -> a 0 $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
    BLUNT       -> a 0 $ wlDustAt wl outTo
    SHATTERING  -> a d $ muchWlDustAt wl outTo
    CRUSHING    -> a 0 id
    EXPLOSIVE   -> a 0 id
    CUTTING     -> a 0 id
    SPARKING    -> a 0 id
    FLAMING     -> a 0 id
    ELECTRICAL  -> a 0 id
    CONCUSSIVE  -> a 0 id
    TORQUEDAM   -> a 0 id
    PUSHDAM     -> a 0 id
    POISONDAM   -> a 0 id
    ENTERREMENT -> a 0 id
  where
    a x f w = (f w,x)
    d = _dmAmount dm
    sp = _dmFrom dm
    p = _dmAt dm
    outTo = p +.+ squashNormalizeV (sp -.- p)
    pSparkCol = V4 5 1 0.5 2
    lSparkCol = V4 20 (-5) 0 1

dirtWallDamage :: Damage -> Wall -> World -> (World,Int)
dirtWallDamage dm wl = case _dmType dm of
    LASERING    -> a d $ wlDustAt wl outTo
    PIERCING    -> a d $ wlDustAt wl outTo
    BLUNT       -> a d $ wlDustAt wl outTo
    SHATTERING  -> a d $ muchWlDustAt wl outTo
    CRUSHING    -> a d $ wlDustAt wl outTo
    EXPLOSIVE   -> a d $ muchWlDustAt wl outTo
    CUTTING     -> a d $ muchWlDustAt wl outTo
    SPARKING    -> a 0 id
    FLAMING     -> a 0 id
    ELECTRICAL  -> a 0 id
    CONCUSSIVE  -> a d id
    TORQUEDAM   -> a 0 id
    PUSHDAM     -> a 0 id
    POISONDAM   -> a 0 id
    ENTERREMENT -> a 0 id
  where
    a x f w = (f w,x)
    d = _dmAmount dm
    sp = _dmFrom dm
    p = _dmAt dm
    outTo = p +.+ squashNormalizeV (sp -.- p)

wallDamageEffect :: Damage -> Wall -> World -> World
wallDamageEffect dm wl w = case _dmEffect dm of
    BounceBullet bt -> w & instantBullets .:~ thebouncer
      where
        reflectVel = reflVelWall wl (_buVel bt)
        thebouncer = aBulAt Nothing --id 
            pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) BasicBulletTrajectory
            & buTimer .~ _buTimer bt - 1
        pOut = p +.+ squashNormalizeV (sp -.- p)
        p = _dmAt dm
        sp = _dmFrom dm
    DamageSpawn f -> w & instantParticles .:~ thepart
        & randGen .~ g
      where
        (thepart,g) = runState (f (Right wl) dm) $ _randGen w
    _ -> w