{-
Creation, update and descruction of destructible walls.
 -}
module Dodge.LevelGen.Block where
import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.WorldEvent.Sound
import Dodge.LevelGen.Pathing
import Geometry
import Picture.Data

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

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 
 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) (_blShadows bl) $ w
  where
    f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl
    f bl          = hitSound' bl
    pos = _wlLine bl !! 0
    hitSound bl 
        | _wlIsSeeThrough bl = mkSoundBreakGlass pos
        | otherwise = soundMultiFrom sos soundid 25 0 
    hitSound' bl 
        | _wlIsSeeThrough bl = mkSoundSplinterGlass pos
        | 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 %~ 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 _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 +.+ foldr1 (+.+) (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 %~ flip (IM.foldr wallInZone) panes
            & walls     %~ IM.union panes
  where 
    lines = zip (p:ps) (ps ++ [p])
    i = newKey $ _walls w
    is = [i.. i + length lines-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 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)
        
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