Prop reification/splitting

src/Dodge/Block/Debris.hs

@@ -1,12 +1,8 @@
 module Dodge.Block.Debris where
 import Dodge.Material.Sound
-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
@@ -50,7 +46,7 @@ makeDebris = makeDebrisDirected 1 2 (2*pi) 0
 makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material 
     -> Color -> Point2 -> World -> World
 makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
-        & flip (foldl' (flip $ plNew props pjID)) thedebris
+        & flip (foldl' (flip $ plNew props prID)) thedebris
         & randGen .~ newg
         & originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
   where
@@ -62,13 +58,13 @@ makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
         spinspeed <- randomR (-0.2,-0.1) & state
         basedebris <- baseDebris bm
         return $ basedebris
-            & pjColor .~ col
+            & prColor .~ col
             & prPos .~ p
-            & pjVel .~ v
-            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
-            & pjQuat .~ q
-            & pjVelZ .~ 0
-            & pjPosZ .~ h
+            & prVel .~ v
+            & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
+            & prQuat .~ q
+            & prVelZ .~ 0
+            & prPosZ .~ h
 
 makeDebrisDirected :: Float 
     -> Float 
@@ -79,7 +75,7 @@ makeDebrisDirected :: Float
     -> Point2 
     -> World -> World
 makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
-        & flip (foldl' (flip $ plNew props pjID)) thedebris
+        & flip (foldl' (flip $ plNew props prID)) thedebris
         & randGen .~ newg
         & originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
   where
@@ -90,13 +86,13 @@ makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
         spinspeed <- randomR (-0.2,-0.1) & state
         basedebris <- baseDebris bm
         return $ basedebris
-            & pjColor .~ col
+            & prColor .~ col
             & prPos .~ p
-            & pjVel .~ v
-            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
-            & pjQuat .~ q
-            & pjVelZ .~ 0
-            & pjPosZ .~ h
+            & prVel .~ v
+            & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) spinspeed
+            & prQuat .~ q
+            & prVelZ .~ 0
+            & prPosZ .~ h
 
 debrisSize :: Material -> Float
 debrisSize mt = case mt of
@@ -119,45 +115,45 @@ baseDebris mt = case mt of
     Metal   -> do
         sh <- jaggedShape
         return $ metalDebris
-            & prDraw .~ (`drawMovingShapeCol` sh)
+            & prDraw .~ PropDrawMovingShapeCol sh
     Electronics -> baseDebris Metal
-    Flesh   -> baseDebris Dirt <&> pjColor .~ red
+    Flesh   -> baseDebris Dirt <&> prColor .~ red
 
 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
+    ,_prStartPos = 0
+    ,_prVel = 0
+    ,_prDraw = PropDrawMovingShapeCol (cubeShape 4)
+    ,_prID = 0
+    ,_prUpdate = PropFallSmallBounceDamage
+    ,_prPosZ = 10
+    ,_prVelZ = 5
+    ,_prTimer = 20
+    ,_prQuat = Q.axisAngle (V3 1 0 0) 0
+    ,_prQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
+    ,_prColor = greyN 0.5
     }
 dirtDebris :: Prop
 dirtDebris = stoneDebris
-    & pjColor .~ dirtColor
-    & pjUpdate .~ fallSmallBounce
+    & prColor .~ dirtColor
+    & prUpdate .~ PropFallSmallBounce
 dirtColor :: Color
 dirtColor = V4 (150/256) ( 75/256)  0 ( 250/256)
 
 metalDebris :: Prop
 metalDebris = stoneDebris
-    & prDraw    .~ (\pr -> drawMovingShapeCol pr (shardShape 4))
-    & pjUpdate  .~ fallSmallBounce
+    & prDraw    .~ PropDrawMovingShapeCol (shardShape 4)
+    & prUpdate  .~ PropFallSmallBounceDamage
 
 glassDebris :: Prop
 glassDebris = stoneDebris
-    & prDraw    .~ (\pr -> drawMovingShapeCol pr (shardShape 4))
-    & pjUpdate  .~ fallSmallBounce
-    & pjColor   .~ withAlpha 0.5 cyan
+    & prDraw    .~ PropDrawMovingShapeCol (shardShape 4)
+    & prUpdate  .~ PropFallSmallBounce
+    & prColor   .~ withAlpha 0.5 cyan
 crystalDebris :: Prop
 crystalDebris = glassDebris
-    & pjColor .~ withAlpha 0.5 aquamarine
+    & prColor .~ withAlpha 0.5 aquamarine
 
 shardShape :: Float -> Shape
 shardShape size = translateSHz (-size) $ upperPrismPoly size