Use strict tuples for SPics

src/Dodge/Prop/Draw.hs

@@ -15,7 +15,7 @@ drawProp' pr = drawProp (_prDraw pr) pr
 drawProp :: PropDraw -> Prop -> SPic
 drawProp pd = case pd of
     PropDrawSPic spic -> const spic
-    PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (fst $ drawProp pd' pr)
+    PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (drawProp pd' pr)
     PropDrawMovingShapeCol sh -> (`drawMovingShapeCol` sh)
     PropDoubleLampCover h -> drawDoubleLampCover h
     PropVerticalLampCover h -> drawVerticalLampCover h
@@ -42,7 +42,7 @@ propDrawToggle pd pr
     | otherwise = drawProp pd pr
 
 drawLampCover :: Float -> Prop -> SPic
-drawLampCover h pr =
+drawLampCover h pr = noPic
     ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
         rotateSH (_prRot pr) $
             mconcat
@@ -52,28 +52,25 @@ drawLampCover h pr =
                 , aface 2 (-1) 2
                 , upperPrismPoly Small Essential 1 [V2 2 2, V2 (-1) 2, V2 2 (-1)]
                 ]
-    , mempty
     )
   where
     aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1
         . reverse $ rectNSWE 3 s w 3
 
 drawVerticalLampCover :: Float -> Prop -> SPic
-drawVerticalLampCover h pr =
+drawVerticalLampCover h pr = noPic
     ( translateSHz h . uncurryV translateSHxy (_prPos pr) $
         rotateSHx (_prRot pr) $
             mconcat
                 [ translateSHz (-3) . upperPrismPoly Small Essential 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
                 ]
-    , mempty
     )
 
-drawMovingShape :: Prop -> Shape -> SPic
+drawMovingShape :: Prop -> SPic -> SPic
 drawMovingShape pr =
-    noPic
-        . translateSHz (_prPosZ pr)
-        . uncurryV translateSHxy (_prPos pr)
-        . overPosSH (Q.rotate (_prQuat pr))
+        translateSPz (_prPosZ pr)
+        . uncurryV translateSPxy (_prPos pr)
+        . overPosSP (Q.rotate (_prQuat pr))
 
 drawMovingShapeCol :: Prop -> Shape -> SPic
 drawMovingShapeCol pr =
@@ -84,7 +81,7 @@ drawMovingShapeCol pr =
         . colorSH (_prColor pr)
 
 drawDoubleLampCover :: Float -> Prop -> SPic
-drawDoubleLampCover h pr =
+drawDoubleLampCover h pr = noPic
     ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
         rotateSH (_prRot pr) $
             mconcat
@@ -93,5 +90,4 @@ drawDoubleLampCover h pr =
                 , 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)]
                 ]
-    , mempty
     )