Improve debris

src/Dodge/Wall/Damage.hs

@@ -17,13 +17,13 @@ damageWall dt wl = case _wlStructure wl of
 
 damageBlockWith :: Damage -> Block -> Block
 damageBlockWith dm = case _dmType dm of
-    PIERCING    -> blHPs %~ reduceHead dam
-    BLUNT       -> blHPs %~ reduceHead dam
-    CUTTING     -> blHPs %~ reduceHead dam
-    EXPLOSIVE   -> blHPs %~ reduceHead dam
-    CONCUSSIVE  -> blHPs %~ reduceHead dam
-    SHATTERING  -> blHPs %~ reduceHead dam
-    CRUSHING    -> blHPs %~ reduceHead (dam `div` 4)
+    PIERCING    -> blHP -~ dam
+    BLUNT       -> blHP -~ dam
+    CUTTING     -> blHP -~ dam
+    EXPLOSIVE   -> blHP -~ dam
+    CONCUSSIVE  -> blHP -~ dam
+    SHATTERING  -> blHP -~ dam
+    CRUSHING    -> blHP -~ (dam `div` 4)
     LASERING    -> id
     SPARKING    -> id
     FLAMING     -> id
@@ -35,14 +35,7 @@ damageBlockWith dm = case _dmType dm of
   where
     dam = _dmAmount dm
 
-reduceHead :: Int -> [Int] -> [Int]
-reduceHead y (x:xs) = x-y:xs
-reduceHead _ _ = []
-
 damageBlocksBy :: Int -> Wall -> World -> World
 damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of
-    Just blid -> blocks . ix blid . blHPs %~ reduceHeadBy x
+    Just blid -> blocks . ix blid . blHP -~ x
     Nothing   -> id
-  where
-    reduceHeadBy y (z:zs) = z - y : zs
-    reduceHeadBy _ [] = []

src/Dodge/Wall/DamageEffect.hs

@@ -14,7 +14,7 @@ defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
     LASERING    -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
     PIERCING    -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
     BLUNT       -> wlDustAt wl outTo
-    SHATTERING  -> wlDustAt wl outTo
+    SHATTERING  -> muchWlDustAt wl outTo
     CRUSHING    -> id
     EXPLOSIVE   -> id
     CUTTING     -> id

src/Dodge/Wall/Dust.hs

@@ -3,9 +3,20 @@ import Dodge.Data
 import Dodge.WorldEvent.Cloud
 import Geometry
 import Control.Lens
+import RandomHelp
 
 wlDustAt :: Wall -> Point2 -> World -> World
 wlDustAt wl = smokeCloudAt dustcol 20 200 1 . addZ 20
   where
     dustcol = _wlColor wl & _4 .~ 1
+
+muchWlDustAt :: Wall -> Point2 -> World -> World
+muchWlDustAt wl p = flip (foldr f) [10,20..100]
+  where
+    f h w = w
+        & smokeCloudAt dustcol 20 200 1 (addZ h (p +.+ off))
+        & randGen .~ g
+      where
+        (off,g) = runState (randInCirc 1) (_randGen w)
+    dustcol = _wlColor wl & _4 .~ 1