{- | Creation, update and destruction of destructible walls.  -}
module Dodge.Placement.PlaceSpot.Block 
    ( placeBlock
    , placeLineBlock
    )
    where
import Dodge.Data
import Dodge.Path
import Dodge.Block.Debris
--import Dodge.LevelGen.LevelStructure
import Dodge.Base
import Dodge.Zone
import Geometry
import qualified IntMapHelp as IM

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

addBlock 
    :: [Point2]     -- ^ Block polygon
    -> Wall         -- ^ Base Pane
    -> Int          -- ^ First layer of health
    -> [Int]        -- ^ Extra layers of health
    -> BlockMaterial
    -> World 
    -> World
addBlock (p:ps) wl hp hps bm w 
    | hp <= 0 && null hps = w
    | hp <= 0 = addBlock (p:ps) wl (head hps + hp) (tail hps) bm 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=[], _blMaterial = bm
                , _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
                , _blDeath = makeBlockDebris bm}
  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 wl 
            { _wlLine = (a,b)
            , _wlID = j
            , _wlStructure = BlockPart blid
            }
        ) 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 -> Wall -> [Int] -> BlockMaterial -> World -> (Int,World)
placeBlock poly i wl is bm w 
    = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
  where 
    pairs = loopPairs poly
    wWithBlock = addBlock poly wl i is bm w

{- | Splits a line into many four cornered blocks. -}
placeLineBlock 
    :: Wall     -- ^ Base pane
    -> BlockMaterial
    -> Float    -- ^ Block width
    -> Float    -- ^ Block depth
    -> Point2   -- ^ Start point (symmetric)
    -> Point2   -- ^ End point (symmetric)
    -> World 
    -> (Int, World)
placeLineBlock basePane bm blockWidth depth a b gw = ( 0 
    , removePathsCrossing a b (foldr insertWall (insertBlocks gw) 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 gw
    blid = IM.newKey $ _blocks gw
    insertBlock (i,p) = over blocks $ IM.insert (i+blid) Block 
        { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
        , _blHPs = [5,5], _blShadows = shadowsAt i, _blMaterial = bm
        , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
        , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris bm}
    insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
    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