module Dodge.LevelGen.LineBlock
    (putLineBlock
    )
    where
import Dodge.Data
import Dodge.Base
import Dodge.LevelGen.Pathing

import Picture
import Geometry

import Control.Lens

import qualified Data.IntMap as IM

-- taken from online, splits a list into its even and odd elements
evenOddSplit = foldr f ([],[])
    where f a (ls,rs) = (rs, a : ls)

putLineBlock :: Wall -> Float -> Float -> Point2 -> Point2 -> 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 = map (\(a,b) -> [a,b]) $ makeLoopPairs $ cornersAt p
    k = 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