Simplify Prop drawing

src/Dodge/Prop/Draw.hs

@@ -1,11 +1,12 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.Prop.Draw (
     propSPic,
     debrisSPic,
 ) where
 
-import Dodge.Block.Debris
 import Control.Lens
+import Dodge.Block.Debris
 import Dodge.Data.Prop
 import Geometry.Data
 import Geometry.Polygon
@@ -15,21 +16,17 @@ import Shape
 import ShapePicture
 
 propSPic :: Prop -> SPic
-propSPic pr = drawProp (_prDraw pr) pr
+propSPic pr = drawProp pr
 
 debrisSPic :: Debris -> SPic
 debrisSPic db = translateSP (_dbPos db) . overPosSP (Q.rotate (_dbRot db)) $
-     case db ^. dbType of
+    case db ^. dbType of
         Gib x col -> noPic $ drawGib x col
         BlockDebris m -> noPic . colorSH m $ cubeShape 4
 
-drawProp :: PropDraw -> Prop -> SPic
-drawProp = \case
-    PropDoubleLampCover h -> drawDoubleLampCover h
-    PropVerticalLampCover h -> drawVerticalLampCover h
-    PropLampCover h -> drawLampCover h
-    PropDrawFlatTranslate x -> \pr ->
-        uncurryV translateSPxy (_prPos pr) $ rotateSP (_prRot pr) x
+drawProp :: Prop -> SPic
+drawProp pr =
+        uncurryV translateSPxy (_prPos pr) $ rotateSP (_prRot pr) $ pr ^. prDraw
 
 drawGib :: Float -> Color -> Shape
 drawGib x col = flesh <> skin
@@ -42,55 +39,3 @@ drawGib x col = flesh <> skin
             translateSH (V3 1 1 (1 - x)) baseCube
     baseCube = upperPrismPoly Small Typical (2 * x) $ square x
 
-drawLampCover :: Float -> Prop -> SPic
-drawLampCover h pr =
-    noPic
-        ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
-            rotateSH (_prRot pr) $
-                mconcat
-                    [ aface 1 2 (-1)
-                    , aface 1 (-1) 2
-                    , aface 2 2 (-1)
-                    , aface 2 (-1) 2
-                    , upperPrismPoly Small Essential 1 [V2 2 2, V2 (-1) 2, V2 2 (-1)]
-                    ]
-        )
-  where
-    aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1 $ rectNSWE 3 s w 3
-
-drawVerticalLampCover :: Float -> Prop -> SPic
-drawVerticalLampCover h pr =
-    noPic
-        ( translateSHz h . uncurryV translateSHxy (_prPos pr)
-            . rotateSHx (_prRot pr)
-            . translateSHz (-3)
-            . upperPrismPoly Small Essential 1
-            $ rectNSWE 2 (-2) (-5) 5
-        )
-
---drawMovingShape :: Prop -> SPic -> SPic
---drawMovingShape pr =
---    translateSPz (_prPosZ pr)
---        . uncurryV translateSPxy (_prPos pr)
---        . overPosSP (Q.rotate (_prQuat pr))
-
---drawMovingShapeCol :: Prop -> Shape -> SPic
---drawMovingShapeCol pr =
---    noPic
---        . translateSHz (_prPosZ pr)
---        . uncurryV translateSHxy (_prPos pr)
---        . overPosSH (Q.rotate (_prQuat pr))
---        . colorSH (_prColor pr)
-
-drawDoubleLampCover :: Float -> Prop -> SPic
-drawDoubleLampCover h pr =
-    noPic
-        ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
-            rotateSH (_prRot pr) $
-                mconcat
-                    [ upperPrismPoly Small Essential 5 $ rectNSWE 6 5 (-6) 6
-                    , upperPrismPoly Small Essential 5 $ rectNSWE (-5) (-6) (-6) 6
-                    , upperPrismPoly Small Essential 1 [V2 0 (-1), V2 6 5, V2 (-6) 5]
-                    , upperPrismPoly Small Essential 1 [V2 0 1, V2 (-6) (-5), V2 6 (-5)]
-                    ]
-        )