Cleanup

src/Dodge/Placement/Instance/LightSource/Cover.hs

@@ -5,12 +5,13 @@ import Geometry.Data
 import ShapePicture
 import Shape
 import Geometry
+import Dodge.Default.Prop
 
 import Control.Lens
 
 lampCover :: Float -> Prop
 lampCover h = ShapeProp
-    { _pjPos = V2 0 0
+    { _prPos = V2 0 0
     , _pjID  = 0
     , _pjRot = 0
     , _pjUpdate = rotateProp 0.15
@@ -18,35 +19,26 @@ lampCover h = ShapeProp
     , _prToggle = True
     }
 lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop
-lampCoverWhen cond pos h = ShapeProp
-    { _pjPos = pos
-    , _pjID  = 0
-    , _pjRot = 0
+lampCoverWhen cond pos h = defaultShapeProp
+    { _prPos = pos
     , _pjUpdate = setToggle cond `dbArgChain` rotateProp 0.15
     , _prDraw = drawLampCover h
     , _prToggle = True
     }
 
 doubleLampCover :: Float -> Prop
-doubleLampCover h = ShapeProp
-    { _pjPos = V2 0 0
-    , _pjID  = 0
-    , _pjRot = 0
+doubleLampCover h = defaultShapeProp
+    { _prPos = V2 0 0
     , _pjUpdate = rotateProp 0.15
     , _prDraw = drawDoubleLampCover h
-    , _prToggle = True
     }
 
 -- on the current (27/9/21) version of shadow stencilling, this glitches
 -- slightly when the shadow rotates towards the screen
 verticalLampCover :: Float -> Prop
-verticalLampCover h = ShapeProp
-    { _pjPos = V2 0 0
-    , _pjID  = 0
-    , _pjRot = 0
-    , _pjUpdate = rotateProp 0.15
+verticalLampCover h = defaultShapeProp
+    { _pjUpdate = rotateProp 0.15
     , _prDraw = drawVerticalLampCover h
-    , _prToggle = True
     }
 
 rotateProp :: Float -> Prop -> World -> World
@@ -57,26 +49,23 @@ setToggle :: (World -> Bool) -> Prop -> World -> World
 setToggle cond pr w = w & props . ix (_pjID pr) . prToggle .~ cond w
 
 drawLampCover :: Float -> Prop -> SPic
-drawLampCover h pr | not (_prToggle pr) = mempty
-                   | otherwise =
-    ( translateSHz (h-2.5) . uncurryV translateSHf pos 
-        $ rotateSH a $ mconcat
+drawLampCover h pr 
+    | not (_prToggle pr) = mempty
+    | otherwise = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
+        $ rotateSH (_pjRot pr) $ mconcat
         [ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2    3 (-1)
         , translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
         , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2    3 (-1)
         , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
         , upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
         ]
-    , mempty
-    )
-  where
-    a = _pjRot pr
-    pos = _pjPos pr
+        , mempty
+        )
 
 drawDoubleLampCover :: Float -> Prop -> SPic
 drawDoubleLampCover h pr =
-    ( translateSHz (h-2.5) . uncurryV translateSHf pos 
-        $ rotateSH a $ mconcat
+    ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr) 
+        $ rotateSH (_pjRot pr) $ mconcat
         [ upperPrismPoly 5 $ rectNSEW 6 5       6 (-6)
         , upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6)
         , upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5]
@@ -84,19 +73,13 @@ drawDoubleLampCover h pr =
         ]
     , mempty
     )
-  where
-    a = _pjRot pr
-    pos = _pjPos pr
 
 drawVerticalLampCover :: Float -> Prop -> SPic
 drawVerticalLampCover h pr =
-    ( translateSHz h . uncurryV translateSHf pos 
-        $ rotateSHx a $ mconcat
+    ( translateSHz h . uncurryV translateSHf (_prPos pr) 
+        $ rotateSHx (_pjRot pr) $ mconcat
         [ 
         translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5)
         ]
     , mempty
     )
-  where
-    a = _pjRot pr
-    pos = _pjPos pr