module Dodge.Block.Debris where
import Dodge.Material
import Dodge.Prop.Moving
import Dodge.WorldEvent.Sound
--import Dodge.Zone
import Dodge.Base
import Dodge.Data
--import Dodge.Damage
--import ShapePicture
import Shape
import Geometry
import Color
import LensHelp
import RandomHelp
import qualified Quaternion as Q

import qualified Data.IntSet as IS
import Data.Maybe
import Data.Foldable

makeDoorDebris :: Door -> World -> World
makeDoorDebris dr w = w & makeDebris mt col p
  where
    p = uncurry midPoint (_drPos dr)
    (mt,col) = fromMaybe (Stone,greyN 0.5) $ do
        wlids <- w ^? doors . ix (_drID dr) . drWallIDs
        (wlid,_) <- IS.minView wlids
        wl <- w ^? walls . ix wlid
        return (_wlMaterial wl,_wlColor wl)

makeBlockDebris :: Block -> World -> World
makeBlockDebris bl w = w & makeDebris mt col (_blPos bl)
  where
    (mt,col) = fromMaybe (Stone,greyN 0.5) $ do
        wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
        (wlid,_) <- IS.minView wlids
        wl <- w ^? walls . ix wlid
        return (_wlMaterial wl,_wlColor wl)

makeDebris :: Material -> Color -> Point2 -> World -> World
makeDebris = makeDebrisDirected 1 2 (2*pi) 0
makeDebrisDirected :: Float 
    -> Float 
    -> Float 
    -> Float 
    -> Material 
    -> Color
    -> Point2 
    -> World -> World
makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
        & flip (foldl' (flip $ plNew props pjID)) thedebris
        & randGen .~ newg
        & originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
  where
    (thedebris,newg) = mapM f [35,55..95] & runState $ _randGen w
    f h = do
        v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
        q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
        spinspeed <- randomR (-0.2,-0.1) & state
        basedebris <- baseDebris bm
        return $ basedebris
            & pjColor .~ col
            & prPos .~ p
            & pjVel .~ v
            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
            & pjQuat .~ q
            & pjVelZ .~ 0
            & pjPosZ .~ h

baseDebris :: Material -> State StdGen Prop
baseDebris mt = case mt of
    Stone   -> return stoneDebris
    Glass   -> return glassDebris
    Crystal -> return crystalDebris
    Dirt    -> return dirtDebris
    Wood    -> return stoneDebris
    Metal   -> do
        sh <- jaggedShape
        return $ metalDebris
            & prDraw .~ (`drawMovingShapeCol` sh)

stoneDebris :: Prop
stoneDebris = PropZ
    {_prPos = 0
    ,_pjStartPos = 0
    ,_pjVel = 0
    ,_prDraw = \pr -> drawMovingShapeCol pr (cubeShape 4)
    ,_pjID = 0
    ,_pjUpdate = fallSmallBounceDamage
    ,_pjPosZ = 10
    ,_pjVelZ = 5
    ,_pjTimer = 20
    ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
    ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
    ,_pjColor = greyN 0.5
    }
dirtDebris :: Prop
dirtDebris = stoneDebris
    & pjColor .~ dirtColor
    & pjUpdate .~ fallSmallBounce
dirtColor :: Color
dirtColor = V4 (150/256) ( 75/256)  0 ( 250/256)

metalDebris :: Prop
metalDebris = stoneDebris
    & prDraw    .~ (\pr -> drawMovingShapeCol pr (shardShape 4))
    & pjUpdate  .~ fallSmallBounce

glassDebris :: Prop
glassDebris = stoneDebris
    & prDraw    .~ (\pr -> drawMovingShapeCol pr (shardShape 4))
    & pjUpdate  .~ fallSmallBounce
    & pjColor   .~ withAlpha 0.5 cyan
crystalDebris :: Prop
crystalDebris = glassDebris
    & pjColor .~ withAlpha 0.5 aquamarine

shardShape :: Float -> Shape
shardShape size = translateSHz (-size) $ upperPrismPoly size
    [V2 size 0
    ,V2 (-size) 1
    ,V2 (-size) (-1)
    ]

jaggedShape :: State StdGen Shape
jaggedShape = do
    s <- randomR (4,10) & state
    return $ shardShape s

cubeShape :: Float -> Shape
cubeShape size = translateSHz (-size) $ upperPrismPoly (2*size) $ square size