module Dodge.Block (
    splinterBlock,
    destroyBlock,
    destroyDoor,
) where

import Control.Lens
import Data.Foldable
import qualified Data.Graph.Inductive as FGL
import qualified Data.IntSet as IS
import Data.Maybe
import Data.Set (Set)
import Dodge.Base.Collide
import Dodge.Block.Debris
import Dodge.Data.MountedObject
import Dodge.Data.World
import Dodge.DrWdWd
import Dodge.LightSource
import Dodge.Material.Sound
import Dodge.Wall.Delete
import Dodge.Wall.Zone
import Dodge.WorldEvent.Sound
import Dodge.Zoning.Wall
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 :: Set PathEdgeNodes -> World -> World
maybeClearPaths ps w = foldl' maybeClearPath w ps

maybeClearPath :: World -> PathEdgeNodes -> World
maybeClearPath w (PathEdgeNodes x y pe)
    | 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)

destroyDoor :: Door -> World -> World
destroyDoor dr w =
    w
        & doDrWdWd (_drDeath dr) dr
        & deleteWallIDs wlids
        & cWorld . lWorld . doors %~ IM.delete (_drID dr)
--        & muchWlDustAt awl (0.5 * uncurry (+) (_drPos dr))
--        & flip (foldl' (flip $ muchWlDustAt awl)) (map (pos +.+) ps)
        & stopPushing (_drPushes dr)
        & destroyMounts (_drMounts dr)
  where
    wlids = _drWallIDs dr
    --awl = _walls (_cWorld w) IM.! IS.findMin wlids
--    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
--    pos = fst . _wlLine $ awl
--    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w

destroyMounts :: [MountedObject] -> World -> World
destroyMounts mos w = foldl' (flip destroyMount) w mos

destroyMount :: MountedObject -> World -> World
destroyMount mo = case mo of
    MountedLS lsid -> destroyLS lsid
    MountedProp prid -> cWorld . lWorld . props . at prid .~ Nothing

stopPushing :: Maybe Int -> World -> World
stopPushing mdrid w = fromMaybe w $ do
    drid <- mdrid
    dr <- w ^? cWorld . lWorld . doors . ix drid
    return $
        w & cWorld . lWorld . doors . ix drid . drMech .~ DrWdId
            & stopPushing (_drPushes dr)