{- | Creation, update and destruction of destructible walls.  -}
module Dodge.LevelGen.Block where
import Dodge.Data
import Dodge.Data.SoundOrigin
import Dodge.Base
import Dodge.Zone
import Dodge.SoundLogic
import Dodge.SoundLogic.LoadSound
import Dodge.WorldEvent.Sound
import Dodge.LevelGen.Pathing
import Dodge.RandomHelp
import Geometry
import qualified IntMapHelp as IM
import Color

import Control.Lens
import Control.Monad.State
import Data.List
import Data.Maybe
import Data.Function
import System.Random

updateBlocks :: World -> World
updateBlocks w 
    = (\w' -> seq (_wallsZone w') w') 
    $ flip (foldl' $ flip removeFromZone) deadPanes 
    $ over walls (\wls -> wls `seq` IM.filter (not . blockIsDead) wls) degradeBlocks 
 where  
    degradeBlocks = deadBlocks `seq` foldl' (flip killBlock) w deadBlocks
    removeFromZone :: Wall -> World -> World
    removeFromZone bl = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID bl))
      where 
        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine bl)
    deadPanes = filter blockIsDead (IM.elems $ _walls w)
    deadBlocks = nubBy ((==) `on` _blIDs) deadPanes
    blockIsDead wl = case wl ^? blHP of 
        Just x  -> x <= 0
        Nothing -> False
{- | Destroy a block.
Plays destruction sound and sets to be displayed other walls that were shadowed by this wall. -}
killBlock :: Wall -> World -> World
killBlock bl w =  f bl . flip (foldl' $ flip unshadow) (_blShadows bl) $ w
  where
    f :: Wall -> World -> World
    f bl'
        | isJust (bl ^? blDegrades . ix 0) = degradeBlock bl' . breakHitSound bl
        | otherwise = hitSound' bl'
    pos = fst $ _wlLine bl
    breakHitSound bl' 
        | _wlIsSeeThrough bl' = mkSoundBreakGlass pos
        | otherwise = soundMultiFrom sos (fst $ _wlLine bl') impactSound Nothing
    hitSound' bl' 
        | _wlIsSeeThrough bl' = mkSoundSplinterGlass pos
        | otherwise = soundMultiFrom sos (fst $ _wlLine bl') impactSound Nothing
    sos = [BlockDegradeSound 0,BlockDegradeSound 1]
    impactSound = evalState (takeOne [impact1S,impact2S,impact3S,impact4S]) $ _randGen w
    unshadow :: Int -> World -> World
    unshadow bid w' = case w' ^? walls . ix bid of 
        Just b -> 
            let (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine b)
            in w & wallsZone . znObjects . ix x . ix y . ix bid . blVisible %~ const True
                 & walls . ix bid . blVisible %~ const True
        Nothing -> w

degradeBlock :: Wall -> World -> World
degradeBlock bl w = 
    let blid = _wlID bl
        bls = map (\i -> _walls w IM.! i) (_blIDs $ _walls w IM.! blid)
        ps = reverse $ orderPolygon $ nub $ concatMap ((\(a,b) -> [a,b]) . _wlLine) bls
        (newPs,g) = runState (shrinkPolygon 0.5 ps) $ _randGen w
        (x:xs) = _blDegrades bl
    in addBlock newPs (x + _blHP bl) (_wlColor bl) (_wlIsSeeThrough bl) xs $ set randGen g w

{-
This does not have clear behaviour in my mind, and should probably be replaced with something more obvious...
 -}
pushPointTowardsBy 
    :: RandomGen g 
    => Float 
    -> Point2 
    -> [Point2] 
    -> State g Point2
pushPointTowardsBy x p ps = do
    xs <- replicateM (length ps) $ state $ randomR (0, x / fromIntegral (length ps))
    let toAdd p' y = y *.* (p' -.- p)
    return $ p +.+ foldl1' (+.+) (zipWith toAdd ps xs)

shrinkPolygon 
    :: RandomGen g 
    => Float        -- ^ Shrink parameter
    -> [Point2] 
    -> State g [Point2]
shrinkPolygon x ps = mapM (flip (pushPointTowardsBy x) ps) ps

addBlock 
    :: [Point2]     -- ^ Block polygon
    -> Int          -- ^ First layer of health
    -> Color 
    -> Bool         -- ^ Is the block see through?
    -> [Int]        -- ^ Extra layers of health
    -> World 
    -> World
addBlock (p:ps) hp col isSeeThrough degradability w 
    | hp <= 0 && null degradability = w
    | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
    | otherwise = w  
        & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
        & walls     %~ IM.union panes
  where 
    lns = zip (p:ps) (ps ++ [p])
    i = IM.newKey $ _walls w
    is = [i.. i + length lns-1]
    panes = IM.fromList $ zip is $ zipWith 
        (\j (a,b) -> Block 
            { _wlLine = (a,b)
            , _wlID = j
            , _wlColor = col
            , _wlSeen = False
            , _blIDs = is
            , _blHP = hp
            , _wlIsSeeThrough = isSeeThrough
            , _blVisible = True
            , _blShadows = []
            , _blDegrades = degradability
            }
        ) is lns
    wallInZone wl 
        | uncurry dist (_wlLine wl) <= 2*zoneSize 
            = insertIMInZone x y wlid wl
        | otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl)) ips
      where 
        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
        wlid  = _wlID wl
        ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
        
-- TODO add block list to world
putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> (Int,World)
putBlock (p:ps) i c b is w = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
  where 
    pairs = zip (p:ps) (ps ++ [p])
    wWithBlock = addBlock (p:ps) i c b is w
putBlock _ _ _ _ _ _ = error "Trying to put a block with incomplete polygon"