module Dodge.Block where
import Dodge.Data
import Dodge.SoundLogic
import Dodge.Zone
import Dodge.WorldEvent.Sound
import Dodge.Wall.Delete
import Dodge.Wall.Dust
import RandomHelp
import Geometry
--import Geometry.ConvexPoly

import Data.Function
import qualified Data.IntSet as IS
import qualified Data.IntMap.Strict as IM
import Control.Lens

splinterBlock :: Block -> World -> World
splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
    & blocks . ix (_blID bl) . blHPs %~ tail
    & matSplintSound (_blMaterial bl) cen
  where
    cen = centroid $ fst . _wlLine <$> IM.restrictKeys (_walls w) (_blWallIDs bl)

unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? walls . ix wlid of
    Just wl -> w
        & walls . ix wlid . wlDraw .~ True
        & wallsZone . znObjects . ix x . ix y . ix wlid . wlDraw .~ True
      where
        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
    Nothing -> w

matSplintSound :: BlockMaterial -> Point2 -> World -> World
matSplintSound mat = case mat of
    GlassBlock -> mkSoundSplinterGlass
    StoneBlock -> mkSoundSplinterBlock
    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
matDesSound :: BlockMaterial -> Point2 -> World -> World
matDesSound mat = case mat of
    GlassBlock -> mkSoundBreakGlass
    StoneBlock -> mkSoundSplinterBlock
    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]

destroyBlock :: Block -> World -> World
destroyBlock bl w = w
    & deleteWallIDs wlids
    & blocks %~ IM.delete (_blID bl)
    & matDesSound (_blMaterial bl) pos
    & _blDeath bl bl
    & 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