module Dodge.Wall.DamageEffect where

import Dodge.Base.Wall
import Dodge.Block
import Dodge.Data.World
import Dodge.Spark
import Dodge.Wall.Dust
import Geometry
import LensHelp

damageWallEffect :: Damage -> Wall -> World -> (World, Damage)
damageWallEffect dm wl = case _wlMaterial wl of
    Stone -> stoneWallDamage dm wl
    Glass -> glassWallDamage 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

-- there is quite a lot of duplication here, should be sorted out

stoneWallDamage :: Damage -> Wall -> World -> (World, Damage)
stoneWallDamage dm wl = case _dmType dm of
    LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
    PIERCING -> a d $ colSparkRandDir 0.2 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, dm & dmAmount .~ 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

glassWallDamage :: Damage -> Wall -> World -> (World, Damage)
glassWallDamage dm wl w =
    w & case _dmType dm of
        LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
        PIERCING -> a d $ dosplint . colSparkRandDir 0.2 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 ^? cWorld . lWorld . blocks . ix blid
    d :: Int
    d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
    a :: Int -> (World -> World) -> World -> (World, Damage)
    a x f w' = (f w', dm & dmAmount .~ 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, Damage)
crystalWallDamage dm wl = case _dmType dm of
    LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
    PIERCING -> a 0 $ colSparkRandDir 0.2 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, dm & dmAmount .~ 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, Damage)
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, dm & dmAmount .~ x)
    d = _dmAmount dm
    sp = _dmFrom dm
    p = _dmAt dm
    outTo = p +.+ squashNormalizeV (sp -.- p)