module Dodge.Block where
import Dodge.Data
import Dodge.Base.Collide
import Dodge.Material.Sound
import Dodge.Block.Debris
import Dodge.Zone
import Dodge.LightSource
import Dodge.Wall.Zone
import Dodge.WorldEvent.Sound
import Dodge.Wall.Delete
import Dodge.Wall.Dust
import RandomHelp
import Geometry
--import Geometry.ConvexPoly

import Data.Foldable
import Data.Function
import Data.Maybe
import qualified Data.IntSet as IS
import qualified IntMapHelp as IM
import Control.Lens
import qualified Streaming.Prelude as S
import qualified Data.Graph.Inductive as FGL

splinterBlock :: Block -> World -> World
splinterBlock bl w = foldr 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 ^? blocks . ix (_blID bl) . blWallIDs
        (wlid,_) <- IS.minView wlids
        w ^? walls . ix wlid . wlMaterial

unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? walls . ix wlid of
    Just wl -> w
        & 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 (foldr unshadowBlock) (_blShadows bl)
    & makeBlockDebris bl
    & deleteWallIDs wlids
    & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
    & blocks %~ IM.delete (_blID bl)
--    & matDesSound (_blMaterial bl) pos
    & flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
  where
    wlids = _blWallIDs bl
    awl = _walls w IM.! IS.findMin wlids
    pos = fst . _wlLine $ _walls 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) 
    | runIdentity . S.any_ (const True) $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
        = w
    | otherwise = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y) 

destroyDoor :: Door -> World -> World
destroyDoor dr w = w
    & _drDeath dr dr
    & deleteWallIDs wlids
    & doors %~ IM.delete (_drID dr)
    & flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
    & stopPushing (_drPushes dr)
    & destroyMounts (_drMounts dr)
  where
    wlids = _drWallIDs dr
    awl = _walls w IM.! IS.findMin wlids
    pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids
    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w

destroyMounts :: [MountedObject] -> World -> World
destroyMounts mos w = foldr destroyMount w mos

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

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