Prop reification/splitting

src/Dodge/Prop/Moving.hs

@@ -1,77 +1,52 @@
 module Dodge.Prop.Moving 
-    ( drawMovingShape
-    , drawMovingShapeCol
-    , fallSmallBounceDamage
+    ( fallSmallBounceDamage
     , fallSmallBounce
     ) where
---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)
---
 fallSmallBounceDamage :: Prop -> World -> World
 fallSmallBounceDamage pr w = w 
     & dodamage
-    & props . ix (_pjID pr) %~ fallSmallBounce' w
+    & props . ix (_prID pr) %~ fallSmallBounce' w
   where
     p = _prPos pr
-    v = _pjVel pr
+    v = _prVel pr
     dodamage
-        | _pjPosZ pr < 25 = creatures %~ fmap dodamage'
+        | _prPosZ pr < 25 = creatures %~ fmap dodamage'
         | otherwise = id
     dodamage' cr
         | dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage 
-            .:~ Damage CRUSHING (floor . (*10) . max 0 . subtract 5 . abs $ _pjVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect
+            .:~ Damage CRUSHING (floor . (*10) . max 0 . subtract 5 . abs $ _prVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect
         | otherwise = cr
 
 fallSmallBounce :: Prop -> World -> World
 fallSmallBounce pr w = w 
-    & props . ix (_pjID pr) %~ fallSmallBounce' w
+    & props . ix (_prID pr) %~ fallSmallBounce' w
 
 fallSmallBounce' :: World -> Prop -> Prop
 fallSmallBounce' w pr
     | newposz < 0 && velz < (-2) = pr 
-        & pjVelZ %~ ((*0.5) . negate)
+        & prVelZ %~ ((*0.5) . negate)
 --        & pjPos +~ (0.5*.* vel)
         & updateWithVel (0.5 *.* vel)
-        & pjVel %~ (0.5 *.*)
+        & prVel %~ (0.5 *.*)
 --        & pjPos +~ (0.5*.* vel)
-    | newposz < 0 = pr & pjUpdate .~ const id
-        & pjZ .~ 0
+    | newposz < 0 = pr & prUpdate .~ PropUpdateId
+        & prPosZ .~ 0
 --        & pjQuat *~ (_pjQuatSpin pr)
     | otherwise = pr
-        & pjVelZ -~ 1
-        & pjPosZ +~ velz
+        & prVelZ -~ 1
+        & prPosZ +~ velz
         & updateWithVel vel
-        & pjQuat *~ _pjQuatSpin pr
+        & prQuat *~ _prQuatSpin pr
   where
-    newposz = _pjPosZ pr + velz
-    velz = _pjVelZ pr
-    vel  = _pjVel pr
+    newposz = _prPosZ pr + velz
+    velz = _prVelZ pr
+    vel  = _prVel pr
     pos  = _prPos pr
     updateWithVel v = case bouncePoint (const True) 0.5 pos (pos + v) w of
         Nothing -> prPos +~ v
-        Just (p,v') -> (prPos .~ p) . (pjVel .~ v')
+        Just (p,v') -> (prPos .~ p) . (prVel .~ v')
 
-drawMovingShape :: Prop -> Shape -> SPic
-drawMovingShape pr = noPic
-    . translateSHz (_pjPosZ pr)
-    . uncurryV translateSHf (_prPos pr) 
-    . overPosSH (Q.rotate (_pjQuat pr))
-
-drawMovingShapeCol :: Prop -> Shape -> SPic
-drawMovingShapeCol pr = noPic
-    . translateSHz (_pjPosZ pr)
-    . uncurryV translateSHf (_prPos pr) 
-    . overPosSH (Q.rotate (_pjQuat pr))
-    . colorSH (_pjColor pr)