-- | Creation, update and destruction of destructible walls.
module Dodge.Placement.PlaceSpot.Block (
    plBlock,
    plLineBlock,
) where

import Data.Set (Set)
import qualified Data.Set as Set
import Control.Lens
import qualified Data.IntSet as IS
import Data.List
import Dodge.Base
import Dodge.Data.World
import Dodge.Path
import Geometry
import qualified IntMapHelp as IM

plBlock ::
    -- | Block polygon
    [Point2] ->
    Block ->
    -- | Base Pane
    Wall ->
    World ->
    (Int, World)
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p : ps) bl wl w =
    (,) blid $
        w
            & cWorld . lWorld . blocks . at blid
                ?~ bl
                    { _blID = blid
                    , _blWallIDs = IS.fromList is
                    , _blShadows = []
                    , _blFootprint = p : ps
                    }
            & insertWalls blid wls
  where
    blid = IM.newKey $ w ^. cWorld . lWorld . blocks
    lns = zip (p : ps) (ps ++ [p])
    i = IM.newKey $ w ^. cWorld . lWorld . walls
    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 ::
    -- | Base pane
    Wall ->
    Float ->
    -- | Start point (symmetric)
    Point2 ->
    -- | End point (symmetric)
    Point2 ->
    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 $ gw ^. cWorld . lWorld . walls
    blid = IM.newKey $ gw ^. cWorld . lWorld . blocks
    insertBlock (i, p) =
        insertWalls (i + blid) (makeWallAt p i)
            . over
                (cWorld . lWorld . 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 = mempty
                        , _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' & cWorld . lWorld . blocks . ix blid . blObstructs .~ Set.unions paths
  where
    (w', paths) = mapAccumR (flip insertWall) w wls

insertWall :: Wall -> World -> (World, Set PathEdgeNodes)
insertWall wl =
    uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
        . (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)