{- | Creation, update and destruction of destructible walls.  -}
module Dodge.LevelGen.Block 
    ( placeBlock
    , placeLineBlock
    )
    where
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Dodge.LevelGen.Pathing
import Dodge.Default.Wall
import Geometry
import qualified IntMapHelp as IM
import Color

import Control.Lens
import Data.List
import qualified Data.IntSet as IS

addBlock 
    :: [Point2]     -- ^ Block polygon
    -> Int          -- ^ First layer of health
    -> Color 
    -> Opacity         -- ^ Is the block see through?
    -> [Int]        -- ^ Extra layers of health
    -> World 
    -> World
addBlock (p:ps) hp col opacity hps w 
    | hp <= 0 && null hps = w
    | hp <= 0 = addBlock (p:ps) (head hps + hp) col opacity (tail hps) w
    | otherwise = w
        & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
        & walls  %~ IM.union panes
        & blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[]})
  where 
    blid = IM.newKey $ _blocks w
    lns = zip (p:ps) (ps ++ [p])
    i = IM.newKey $ _walls w
    is = [i.. i + length lns-1]
    panes = IM.fromList $ zipWith 
        (\j (a,b) -> (,) j defaultWall 
            { _wlLine = (a,b)
            , _wlID = j
            , _wlColor = col
            , _wlOpacity = opacity
            , _wlStructure = BlockPart blid
            , _wlFireThrough = True
            }
        ) 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"
        
placeBlock :: [Point2] -> Int -> Color -> Opacity -> [Int] -> World -> (Int,World)
placeBlock poly i c opac is w = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
  where 
    pairs = loopPairs poly
    wWithBlock = addBlock poly i c opac is w

{- | Splits a line into many four cornered blocks. -}
placeLineBlock 
    :: Wall     -- ^ Base pane
    -> Float    -- ^ Block width
    -> Float    -- ^ Block depth
    -> Point2   -- ^ Start point (symmetric)
    -> Point2   -- ^ End point (symmetric)
    -> World 
    -> (Int, World)
placeLineBlock basePane blockWidth depth a b w = (,) 0 
    $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
  where 
    psOnLine = divideLineOddNumPoints blockWidth a b
    halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
    blockCenPs = snd $ evenOddSplit psOnLine
    numBlocks = length blockCenPs
    is = [0.. numBlocks - 1]
    cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
    cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
    linesAt p = loopPairs $ cornersAt p
    wlid = IM.newKey $ _walls w
    blid = IM.newKey $ _blocks w
    insertBlock i = over blocks $ IM.insert (i+blid) Block 
        {_blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
    insertBlocks = flip (foldr insertBlock) is
    ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]
    visibilityAt i 
        | i == 0             = [False,True,True ,True]
        | i == numBlocks - 1 = [True ,True,False,True]
        | otherwise          = [False,True,False,True]
    shadowsAt i
        | i == 0             = ksAtI 1
        | i == numBlocks - 1 = ksAtI $ numBlocks - 2
        | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
    makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
    makePane i visStatus k ps = basePane
        {_wlID = k
        ,_wlStructure = BlockPart $ i + blid
        ,_wlLine = ps
        ,_wlDraw = visStatus
        }
    listWalls = concat $ zipWith makeWallAt blockCenPs is
    insertWall wl = over walls $ IM.insert (_wlID wl) wl