{- | Controls a walls response to external damage.
 - Indestructible walls may still produce sparks, dust etc
 -}
module Dodge.Wall.Damage
    ( damageBlocksBy
    , damageWall
    ) where
import Dodge.Data
import Dodge.Wall.Reflect
import Dodge.Wall.Dust
import Dodge.Particle.Spark
import Geometry
import Color

import Control.Lens
damageWall :: DamageType -> Wall -> World -> World
damageWall dt wl = case _wlStructure wl of
    MachinePart mcid -> machines . ix mcid . mcDamage %~ (dt :)
    BlockPart blid   -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt)
    CreaturePart crid f -> f dt wl crid
    _   -> wallEff dt wl
{- | Damage effects on indestructible walls -}
-- TODO take into account damage amount for amount of dust/sparks?
wallEff :: DamageType -> Wall -> World -> World
wallEff dt wl = case dt of
    Lasering _ sp p _ -> colSpark 8 lSparkCol (outTo sp p) (reflDirWall sp p wl)
    Piercing _ sp p _ -> colSpark' 0.2 8 pSparkCol (outTo sp p) (reflDirWall sp p wl)
        . wlDustAt wl (outTo sp p)
    Blunt    _ sp p _ -> wlDustAt wl (outTo sp p)
    Explosive _ _ -> id
    Cutting {} -> id
    SparkDam {} -> id
    Flaming  {} -> id
    Electrical {} -> id
    Concussive {} -> id
    TorqueDam {} -> id
    PushDam {} -> id
    PoisonDam {} -> id
  where
    outTo sp p = p +.+ safeNormalizeV (sp -.- p)
    pSparkCol = brightX 100 1.5 white
    lSparkCol = V4 20 (-5) 0 1


damageBlockWith :: DamageType -> Block -> Block
damageBlockWith dt = case dt of
    Piercing dam _ _ _ -> blHPs %~ reduceHead dam
    Blunt    dam _ _ _ -> blHPs %~ reduceHead dam
    Cutting  dam _ _ _ -> blHPs %~ reduceHead dam
    Explosive dam _    -> blHPs %~ reduceHead dam
    Concussive dam _ _ _ _ -> blHPs %~ reduceHead dam
    Lasering {} -> id
    SparkDam {} -> id
    Flaming {} -> id
    Electrical {} -> id
    TorqueDam {} -> id
    PushDam {} -> id
    PoisonDam {} -> id

reduceHead :: Int -> [Int] -> [Int]
reduceHead y (x:xs) = x-y:xs
reduceHead _ _ = []

damageBlocksBy :: Int -> Wall -> World -> World
damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of
    Just blid -> blocks . ix blid . blHPs %~ reduceHeadBy x
    Nothing   -> id
  where
    reduceHeadBy y (z:zs) = z - y : zs
    reduceHeadBy _ [] = []
