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 Dodge.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
import Control.Monad
import Control.Monad.State

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
    wls = IM.restrictKeys (_walls w) (_blWallIDs bl)
    cen = centroid $ fmap (fst . _wlLine) wls

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
    & 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
