Make crytal walls destructible by shatterGun

src/Dodge/Block/Debris.hs

@@ -16,33 +16,38 @@ import qualified Quaternion as Q
 --import Data.List (zip4)
 
 makeBlockDebris :: Block -> World -> World
-makeBlockDebris bl = makeDebris (greyN 0.5) (_blMaterial bl) (_blPos bl)
+makeBlockDebris bl = makeDebris (_blMaterial bl) (_blPos bl)
 
-makeDebris :: Color -> BlockMaterial -> Point2 -> World -> World
+makeDebris :: BlockMaterial -> Point2 -> World -> World
 makeDebris = makeDebrisDirected 1 2 (2*pi) 0
-
 makeDebrisDirected :: Float -> Float 
-    -> Float -> Float -> Color -> BlockMaterial -> Point2 -> World -> World
-makeDebrisDirected mindist maxdist arcrad dir col bm p w = w
-    & flip (foldr (plNew props pjID)) thedebris
-    & randGen .~ newg
-    & matDesSound bm p
+    -> Float -> Float -> BlockMaterial -> Point2 -> World -> World
+makeDebrisDirected mindist maxdist arcrad dir bm p w = w
+        & flip (foldr (plNew props pjID)) thedebris
+        & randGen .~ newg
+        & matDesSound bm p
   where
+    someDebris = case bm of
+        StoneBlock -> stoneDebris
+        GlassBlock -> glassDebris
+        CrystalBlock -> crystalDebris
+        DirtBlock   -> dirtDebris
+        WoodBlock   -> stoneDebris
+        MetalBlock  -> stoneDebris
     (thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
     f h = do
         v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
         q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
         return $ someDebris
             & prPos .~ p
-            & pjColor .~ col
             & pjVel .~ v
             & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
             & pjQuat .~ q
             & pjVelZ .~ 0
             & pjPosZ .~ h
 
-someDebris :: Prop
-someDebris = PropZ
+stoneDebris :: Prop
+stoneDebris = PropZ
     {_prPos = 0
     ,_pjStartPos = 0
     ,_pjVel = 0
@@ -54,14 +59,40 @@ someDebris = PropZ
     ,_pjTimer = 20
     ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
     ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
-    ,_pjColor = white
+    ,_pjColor = greyN 0.5
     }
+dirtDebris :: Prop
+dirtDebris = stoneDebris
+    & pjColor .~ dirtColor
+    & pjUpdate .~ fallSmallBounce
+dirtColor :: Color
+dirtColor = V4 (150/256) ( 75/256)  0 ( 250/256)
+
+glassDebris :: Prop
+glassDebris = PropZ
+    {_prPos = 0
+    ,_pjStartPos = 0
+    ,_pjVel = 0
+    ,_prDraw = \pr -> drawMovingShape pr (debrisShape 2 pr)
+    ,_pjID = 0
+    ,_pjUpdate = fallSmallBounce
+    ,_pjPosZ = 10
+    ,_pjVelZ = 5
+    ,_pjTimer = 20
+    ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
+    ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
+    ,_pjColor = withAlpha 0.5 cyan
+    }
+crystalDebris :: Prop
+crystalDebris = glassDebris
+    & pjColor .~ withAlpha 0.5 aquamarine
 debrisShape :: Float -> Prop -> Shape
 debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly 8 $ square size
 
 matDesSound :: BlockMaterial -> Point2 -> World -> World
 matDesSound mat = case mat of
     GlassBlock -> mkSoundBreakGlass
+    CrystalBlock -> mkSoundBreakGlass -- this should be more crunchy
     StoneBlock -> mkSoundSplinterBlock
     DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
     WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]