Prop reification/splitting

src/Dodge/Prop/Gib.hs

@@ -1,16 +1,11 @@
 module Dodge.Prop.Gib where
-import Dodge.Prop.Moving
---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 Dodge.Base.NewID
 
 import qualified Quaternion as Q
 import Data.List (zip4)
@@ -19,28 +14,18 @@ import Data.Foldable
 aGib :: Prop
 aGib = PropZ
     {_prPos = 0
-    ,_pjStartPos = 0
-    ,_pjVel = 0
-    ,_prDraw = \pr -> drawMovingShape pr (drawGib 3 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 = white
+    ,_prStartPos = 0
+    ,_prVel = 0
+    ,_prDraw = PropDrawMovingShape (PropDrawGib 3)
+    ,_prID = 0
+    ,_prUpdate = PropFallSmallBounce
+    ,_prPosZ = 10
+    ,_prVelZ = 5
+    ,_prTimer = 20
+    ,_prQuat = Q.axisAngle (V3 1 0 0) 0
+    ,_prQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
+    ,_prColor = white
     }
-drawGib :: Float -> Prop -> Shape
-drawGib x pr = flesh <> skin
-  where
-    flesh = colorSH (dark $ dark red)
-        . translateSHz (negate x)
-        $ upperPrismPoly (2*x) $ square x
-    skin = colorSH (_pjColor pr)
-        . translateSH (V3 1 1 (1 - x))
-        $ upperPrismPoly (2*x) $ square x
-
 
 addCrGibs :: Creature -> World -> World
 addCrGibs cr w = case damageDirection $ _csDamage $ _crState cr of
@@ -83,18 +68,18 @@ addGibsAtDir dir minh maxh col p w = foldl' (flip $ addGib4 p col) w (zip4 vels
   
 addGib4 :: Point2 -> Color -> (Point2, Float, Q.Quaternion Float, Float)
     -> World -> World
-addGib4 p col (v,zs,q,h) = plNew props pjID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
-    & pjColor .~ col
-    & pjVel .~ v
-    & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
-    & pjQuat .~ q
-    & pjVelZ .~ zs
-    & pjPosZ .~ h
+addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
+    & prColor .~ col
+    & prVel .~ v
+    & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+    & prQuat .~ q
+    & prVelZ .~ zs
+    & prPosZ .~ h
     )
 
 addGibAt :: Float -> Color -> Point2 -> World -> World
 addGibAt h col p w = w
-    & plNew props pjID gib
+    & plNew props prID gib
     & randGen .~ newg
   where
     (gib,newg) = runState f $ _randGen w
@@ -106,16 +91,16 @@ addGibAt h col p w = w
         let v = s *.* dir
         return $ aGib
             & prPos .~ p
-            & pjColor .~ col
-            & pjVel .~ v
-            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
-            & pjQuat .~ q
-            & pjVelZ .~ zs
-            & pjPosZ .~ h
+            & prColor .~ col
+            & prVel .~ v
+            & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+            & prQuat .~ q
+            & prVelZ .~ zs
+            & prPosZ .~ h
 
 addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World
 addGibAtDir dir h col p w = w
-    & plNew props pjID gib
+    & plNew props prID gib
     & randGen .~ newg
   where
     (gib,newg) = runState f $ _randGen w
@@ -126,9 +111,9 @@ addGibAtDir dir h col p w = w
         let v = s *.* unitVectorAtAngle dir
         return $ aGib
             & prPos .~ p
-            & pjColor .~ col
-            & pjVel .~ v
-            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
-            & pjQuat .~ q
-            & pjVelZ .~ zs
-            & pjPosZ .~ h
+            & prColor .~ col
+            & prVel .~ v
+            & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+            & prQuat .~ q
+            & prVelZ .~ zs
+            & prPosZ .~ h