{-# LANGUAGE BangPatterns #-}
module Dodge.LevelGen.Block where
import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic

import Dodge.LevelGen.Pathing

import Geometry
import Picture.Data

import Control.Lens

import Data.List

import Data.Function
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State

updateBlocks :: World -> World
updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) deadPanes 
                    $ over walls (\wls -> wls `seq` IM.filter (not . blockIsDead) wls)
                 degradeBlocks 
--                    w                
   where  degradeBlocks = deadBlocks `seq` foldr killBlock w deadBlocks
          removeFromZone :: Wall -> World -> World
          removeFromZone bl = over (wallsZone . ix x . ix y) (IM.delete (_wlID bl))
            where (x,y) = zoneOfPoint $ pHalf (_wlLine bl !! 0) (_wlLine bl !! 1)
          deadPanes = filter blockIsDead (IM.elems $ _walls w)
          deadBlocks = nubBy ((==) `on` _blIDs) deadPanes
          blockIsDead wl = case wl ^? blHP of Just x  -> x <= 0
                                              Nothing -> False

killBlock :: Wall -> World -> World
killBlock bl w =  f bl .
                  flip (foldr unshadow)
--                  flip (foldr (\i -> set (walls . ix i . blVisible) (True)))
                         (_blShadows bl)
                        $ w
    where
        f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl
        f bl          = hitSound' bl
        hitSound bl | _wlIsSeeThrough bl = soundMultiFrom sos (soundid+8) 25 0 
                    | otherwise = soundMultiFrom sos soundid 25 0 
        hitSound' bl | _wlIsSeeThrough bl = soundMultiFrom sos (soundid+4) 25 0 
                     | otherwise = soundMultiFrom sos soundid 25 0 
        sos = [BlockDegradeSound 0,BlockDegradeSound 1]
        (soundid,_) = randomR (29,32) $ _randGen w
        unshadow :: Int -> World -> World
        unshadow bid w = case w ^? walls . ix bid of 
                            Just b  -> let (x,y) = zoneOfPoint $ pHalf (_wlLine b !! 0) (_wlLine b !! 1)
                                       in  w & wallsZone . ix x . ix y . ix bid . blVisible %~ \_ -> 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 _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

pushPointTowardsBy :: RandomGen g => Float -> Point2 -> [Point2] -> State g Point2
pushPointTowardsBy x p ps = do
    xs <- sequence $ take (length ps) $ repeat $ state $ randomR (0, x / (fromIntegral $ length ps))
    let toAdd p' y = y *.* (p' -.- p)
    return $ p +.+ foldr1 (+.+) (zipWith toAdd ps xs)

shrinkPolygon :: RandomGen g => Float -> [Point2] -> State g [Point2]
shrinkPolygon x ps = sequence $ map (flip (pushPointTowardsBy x) ps) ps

addBlockNoShadow :: [Point2] -> Int -> Color -> Bool -> [Int] -> Bool -> World -> World
addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w 
    | hp <= 0 && degradability == [] = w
    | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
    | otherwise = over wallsZone (flip (IM.foldr wallInZone) blocks)
      $ over walls (IM.union blocks) w
--addBlock (p:p':ps) w = over walls (IM.insert i b) w
    where 
        shadowList | hasAllShadows = repeat True
                   | otherwise     = concat $ repeat [False,True]
        lines = zip (p:ps) (ps ++ [p])
        i = newKey $ _walls w
        is = [i.. i + length lines-1]
        blocks = IM.fromList $ zip is 
                  $ zipWith3 (\j (a,b) bool 
                                      -> Block { _wlLine = [a,b]
                                               , _wlID = j
                                            --   , _wlColor = greyN 0.5
                                               , _wlColor = col
                                               , _wlDraw = Nothing
                                               , _wlSeen = False
                                               , _blIDs = is
                                               , _blHP = hp
                                               , _wlIsSeeThrough = isSeeThrough
                                               , _blVisible = True
                                               , _blShadows = []
                                               , _blDegrades = degradability
                                               }
                             ) is lines shadowList
        wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize 
                          = insertIMInZone x y wlid wl
                      | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
          where (x,y) = zoneOfPoint $ (pHalf (_wlLine wl !! 0) (_wlLine wl !! 1))
                wlid  = _wlID wl
                ips = map zoneOfPoint $ divideLine (2*zoneSize) (_wlLine wl !! 0) (_wlLine wl !! 1)

addBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
addBlock (p:ps) hp col isSeeThrough degradability w 
    | hp <= 0 && degradability == [] = w
    | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
    | otherwise = over wallsZone (flip (IM.foldr wallInZone) blocks)
      $ over walls (IM.union blocks) w
--addBlock (p:p':ps) w = over walls (IM.insert i b) w
    where 
        lines = zip (p:ps) (ps ++ [p])
        i = newKey $ _walls w
        is = [i.. i + length lines-1]
        blocks = IM.fromList $ zip is 
                  $ zipWith (\j (a,b) -> Block { _wlLine = [a,b]
                                               , _wlID = j
                                            --   , _wlColor = greyN 0.5
                                               , _wlColor = col
                                               , _wlDraw = Nothing
                                               , _wlSeen = False
                                               , _blIDs = is
                                               , _blHP = hp
                                               , _wlIsSeeThrough = isSeeThrough
                                               , _blVisible = True
                                               , _blShadows = []
                                               , _blDegrades = degradability
                                               }
                             ) is lines
        wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize 
                          = insertIMInZone x y wlid wl
                      | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
          where (x,y) = zoneOfPoint $ (pHalf (_wlLine wl !! 0) (_wlLine wl !! 1))
                wlid  = _wlID wl
                ips = map zoneOfPoint $ divideLine (2*zoneSize) (_wlLine wl !! 0) (_wlLine wl !! 1)
        
putBlockWallPart :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
putBlockWallPart (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs
    where pairs = zip (p:ps) (ps ++ [p])
          wWithBlock = addBlockNoShadow (p:ps) i c b is False w

putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs
    where pairs = zip (p:ps) (ps ++ [p])
          wWithBlock = addBlock (p:ps) i c b is w