{- | Creation, update and destruction of destructible walls.  -}
module Dodge.Placement.PlaceSpot.Block 
    ( plBlock
    , plLineBlock
    )
    where
import Dodge.Data
import Dodge.Path
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

plBlock 
    :: [Point2]     -- ^ Block polygon
    -> Block
    -> Wall         -- ^ Base Pane
    -> World 
    -> (Int,World)
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p:ps) bl wl w = (,) blid $ w
    & blocks . at blid ?~ bl 
        { _blID = blid
        , _blWallIDs = IS.fromList is
        , _blShadows = []
        , _blFootprint = p:ps
        }
    & insertWalls blid wls
  where 
    blid = IM.newKey $ _blocks w
    lns = zip (p:ps) (ps ++ [p])
    i = IM.newKey $ _walls w
    is = [i.. i + length lns-1]
    wls = zipWith 
        (\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid) 
        is 
        lns 
        
{- | Splits a line into many four cornered blocks. -}
plLineBlock 
    :: Wall     -- ^ Base pane
    -> Float
    -> Point2   -- ^ Start point (symmetric)
    -> Point2   -- ^ End point (symmetric)
    -> World 
    -> (Int, World)
plLineBlock basePane blwidth a b gw = ( 0 
--    , foldr insertWall (insertBlocks gw) listWalls
    , insertBlocks gw
    )
  where 
    depth = blwidth
    psOnLine = divideLineOddNumPoints blwidth 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) = 
        insertWalls (i + blid) (makeWallAt p i)
        . over blocks (IM.insert (i+blid) Block 
        { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
        , _blHP = 1000, _blShadows = shadowsAt i
        , _blDir = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
        , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
        , _blObstructs = []
        , _blMaterial = _wlMaterial basePane
        , _blHeight   = 100
        , _blPos = p, _blDraw = BlockDrawMempty }
        )
    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
        ,_wlUnshadowed = visStatus
        }

-- | Must be done after inserting the block
insertWalls :: Int -> [Wall] -> World -> World
insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
  where
    (w',paths) = mapAccumR (flip insertWall) w wls

insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
    . (walls . at (_wlID wl) ?~ wl)