module Dodge.Block where

import Dodge.Data.MountedObject
import Control.Lens
import Data.Foldable
import qualified Data.Graph.Inductive as FGL
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Block.Debris
import Dodge.Data.World
import Dodge.DrWdWd
import Dodge.LightSource
import Dodge.Material.Sound
import Dodge.Wall.Delete
import Dodge.Wall.Dust
import Dodge.Wall.Zone
import Dodge.WorldEvent.Sound
import Dodge.Zoning.Wall
import Geometry
import qualified IntMapHelp as IM
import RandomHelp

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

unshadowBlock :: World -> Int -> World
unshadowBlock w wlid = case w ^? cWorld . walls . ix wlid of
    Just wl ->
        w
            & cWorld . 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 . blocks %~ IM.delete (_blID bl)
        --    & matDesSound (_blMaterial bl) pos
        & flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
  where
    wlids = _blWallIDs bl
    awl = _walls (_cWorld w) IM.! IS.findMin wlids
    pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w

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

maybeClearPath :: World -> (Int, Int, PathEdge) -> World
maybeClearPath w (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 . doors %~ IM.delete (_drID dr)
        & flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps)
        & stopPushing (_drPushes dr)
        & destroyMounts (_drMounts dr)
  where
    wlids = _drWallIDs dr
    awl = _walls (_cWorld w) IM.! IS.findMin wlids
    pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
    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 . props . at prid .~ Nothing

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