Cleanup

src/Dodge/Prop/Draw.hs

@@ -1,5 +1,9 @@
-module Dodge.Prop.Draw where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Prop.Draw (
+    propSPic,
+) where
 
+import Control.Lens
 import Dodge.Data.Prop
 import Geometry.Data
 import Geometry.Polygon
@@ -7,13 +11,12 @@ import Picture
 import qualified Quaternion as Q
 import Shape
 import ShapePicture
-import Control.Lens
 
-drawProp' :: Prop -> SPic
+propSPic :: Prop -> SPic
-drawProp' pr = drawProp (_prDraw pr) pr
+propSPic pr = drawProp (_prDraw pr) pr
 
 drawProp :: PropDraw -> Prop -> SPic
-drawProp pd = case pd of
+drawProp = \case
     PropDrawSPic spic -> const spic
     PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (drawProp pd' pr)
     PropDrawMovingShapeCol sh -> (`drawMovingShapeCol` sh)
@@ -29,11 +32,11 @@ drawGib :: Float -> Prop -> Shape
 drawGib x pr = flesh <> skin
   where
     flesh =
-        colorSH (dark $ dark red)
+        colorSH (dark $ dark red) $
-            $ translateSHz (negate x) (baseCube & each . sfShadowImportance .~ Superfluous)
+            translateSHz (negate x) (baseCube & each . sfShadowImportance .~ Superfluous)
     skin =
-        colorSH (_prColor pr)
+        colorSH (_prColor pr) $
-            $ translateSH (V3 1 1 (1 - x)) baseCube
+            translateSH (V3 1 1 (1 - x)) baseCube
     baseCube = upperPrismPoly Small Typical (2 * x) $ square x
 
 propDrawToggle :: PropDraw -> Prop -> SPic
@@ -42,7 +45,8 @@ propDrawToggle pd pr
     | otherwise = drawProp pd pr
 
 drawLampCover :: Float -> Prop -> SPic
-drawLampCover h pr = noPic
+drawLampCover h pr =
+    noPic
         ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
             rotateSH (_prRot pr) $
                 mconcat
@@ -57,11 +61,13 @@ drawLampCover h pr = noPic
     aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1 $ rectNSWE 3 s w 3
 
 drawVerticalLampCover :: Float -> Prop -> SPic
-drawVerticalLampCover h pr = noPic
+drawVerticalLampCover h pr =
-    ( translateSHz h . uncurryV translateSHxy (_prPos pr) .
+    noPic
-        rotateSHx (_prRot pr) .
+        ( translateSHz h . uncurryV translateSHxy (_prPos pr)
-                 translateSHz (-3) . upperPrismPoly Small Essential 1 $ rectNSWE 2 (-2) (-5) 5
+            . rotateSHx (_prRot pr)
-                
+            . translateSHz (-3)
+            . upperPrismPoly Small Essential 1
+            $ rectNSWE 2 (-2) (-5) 5
         )
 
 drawMovingShape :: Prop -> SPic -> SPic
@@ -79,7 +85,8 @@ drawMovingShapeCol pr =
         . colorSH (_prColor pr)
 
 drawDoubleLampCover :: Float -> Prop -> SPic
-drawDoubleLampCover h pr = noPic
+drawDoubleLampCover h pr =
+    noPic
         ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
             rotateSH (_prRot pr) $
                 mconcat

src/Dodge/Render/ShapePicture.hs

@@ -23,7 +23,7 @@ import ShapePicture
 worldSPic :: Configuration -> Universe -> SPic
 worldSPic cfig u =
     (mempty :!: extraPics cfig u)
-        <> foldup drawProp' (filtOn _prPos _props)
+        <> foldup propSPic (filtOn _prPos _props)
         <> foldup drawProjectile (filtOn _pjPos _projectiles)
         <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
         <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)