Make many death events just leave corpses (no gore)

src/Shape.hs

@@ -14,6 +14,8 @@ module Shape
     , polyCircx
     , scaleSH
     , colorSH
+    , overColSH
+    , overColSHM
     , overPosSH
     ) where
 import Geometry
@@ -79,11 +81,15 @@ upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (f upps downps)]
 
 colorSH :: Color -> Shape -> Shape
 {-# INLINE colorSH #-}
-colorSH = overCol . const
+colorSH = overColSH . const
 
-overCol :: (Point4 -> Point4) -> Shape -> Shape
-{-# INLINE overCol #-}
-overCol = fmap . overColObj
+overColSH :: (Point4 -> Point4) -> Shape -> Shape
+{-# INLINE overColSH #-}
+overColSH = fmap . overColObj
+
+overColSHM :: Monad m => (Point4 -> m Point4) -> Shape -> m Shape
+{-# INLINE overColSHM #-}
+overColSHM = mapM . overColObjM
 
 overPosSHI :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINE overPosSHI #-}
@@ -121,6 +127,10 @@ overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj
 {-# INLINE overColObj #-}
 overColObj f (ShapeObj st vs) = ShapeObj st (map (overColVertex f) vs)
 
+overColObjM :: Monad m => (Point4 -> m Point4) -> ShapeObj -> m ShapeObj
+{-# INLINE overColObjM #-}
+overColObjM f (ShapeObj st vs) = ShapeObj st <$> (mapM (svCol f) vs)
+
 overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV
 {-# INLINE overColVertex #-}
 overColVertex f (ShapeV a b) = ShapeV a (f b)