module Dodge.Block (
    splinterBlock,
    destroyBlock,
) where

import Dodge.Zoning.Wall
import Dodge.Base.Collide
import Control.Monad
import Dodge.Path
import Control.Lens
import Data.Foldable
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Block.Debris
import Dodge.Data.World
import Dodge.Material.Sound
import Dodge.Wall.Delete
import Dodge.Wall.Zone
import Dodge.WorldEvent.Sound
import qualified IntMapHelp as IM

splinterBlock :: Block -> World -> World
splinterBlock bl w =
    foldl' unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
        & soundOriginsIDsAt
            [MaterialSound bm 0, MaterialSound bm 1, MaterialSound bm 2]
            (weakenMatS bm)
            (_blPos bl)
  where
    bm = fromMaybe Stone $ do
        wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
        (wlid, _) <- IS.minView wlids
        w ^? cWorld . lWorld . walls . ix wlid . wlMaterial

unshadowBlock :: World -> Int -> World
unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of
    Just wl ->
        w
            & cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True
            & insertWallInZones (wl & wlUnshadowed .~ True)
    Nothing -> w

--checkBlockHP :: Block -> World -> World
--checkBlockHP bl
--    | _blHP bl < 1 = destroyBlock bl
--    | otherwise = id

destroyBlock :: Block -> World -> World
destroyBlock bl w =
    w
        & flip (foldl' unshadowBlock) (_blShadows bl)
        & makeBlockDebris bl
        & deleteWallIDs wlids
        & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
        & cWorld . lWorld . blocks %~ IM.delete (_blID bl)
--        & muchWlDustAt awl (_blPos bl)
--        & flip (foldl' $ flip (muchWlDustAt awl)) (map (pos +.+) ps)
  where
    wlids = _blWallIDs bl
--    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
--    pos = fst . _wlLine $ awl
--    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w

-- this does not handle eg doors blocking the path as well
maybeClearPaths :: [(Int,Int)] -> World -> World
maybeClearPaths ps w = foldl' maybeClearPath w ps

maybeClearPath :: World -> (Int,Int) -> World
maybeClearPath w (i,j) = fromMaybe w $ do
    x <- getNodePos i w
    y <- getNodePos j w
    guard $ null $ overlapSegWalls x y $ wlsNearSeg x y w
    return $ w & cWorld . incGraph %~ updateEdge f (i,j) 
  where
    f = at BlockObstacle .~ Nothing
----    | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
----        w
----    | otherwise =
----        w
----            & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)