{- | Splits a line into many four cornered blocks. -}
module Dodge.LevelGen.LineBlock
    ( putLineBlock
    )
    where
import Dodge.Data
import Dodge.Base
import Dodge.LevelGen.Pathing
--import Picture
import Geometry
import qualified IntMapHelp as IM

import Control.Lens

putLineBlock 
    :: Wall     -- ^ Base pane
    -> Float    -- ^ Block width
    -> Float    -- ^ Block depth
    -> Point2   -- ^ Start point (symmetric)
    -> Point2   -- ^ End point (symmetric)
    -> World 
    -> World
putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
  where 
    d = dist a b
    rot = argV (b -.- a)
    psOnLine = divideLineOddNumPoints blockWidth a b
    halfBlockWidth = d / fromIntegral (length psOnLine - 1)
    blockCenPs = snd $ evenOddSplit psOnLine
    numBlocks = length blockCenPs
    is = [0.. numBlocks - 1]
    cornerPoints = 
        [(-halfBlockWidth,-depth)   -- goes anticlockwise around the block
        ,(-halfBlockWidth, depth)
        ,( halfBlockWidth, depth)
        ,( halfBlockWidth,-depth)
        ]
    cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
    linesAt p = makeLoopPairs $ cornersAt p
    k = IM.newKey $ _walls w
    ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
    visibilityAt i 
        | i == 0             = [ True,True,False,True]
        | i == numBlocks - 1 = [False,True, True,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)
    makeBlockAt :: Point2 -> Int -> [Wall]
    makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
    makePane i visStatus k' ps = basePane 
        {_wlID = k'
        ,_wlLine = ps
        ,_blIDs = ksAtI i
        ,_blShadows = shadowsAt i
        ,_blVisible = visStatus
        }
    listBlocks = concat $ zipWith makeBlockAt blockCenPs is
    insertBlock :: Wall -> World -> World
    insertBlock wl = over walls $ IM.insert (_wlID wl) wl