Implement simple sweep light

src/Dodge/LightSources.hs

@@ -4,11 +4,15 @@ module Dodge.LightSources
     , lightAt
     , colorLightAt
     , lampPic
+    , lampCover
     )
     where
 import Dodge.Data
 import Geometry.Data
 import Picture
+import ShapePicture
+import Shape
+import Geometry
 
 import Control.Lens
 
@@ -62,3 +66,31 @@ tLight t rmax col (V3 x y z) = TLS
 lampPic :: Float -> Picture
 --{-# INLINE lampPic #-}
 lampPic h = setLayer 1 (setDepth h . color white $ circleSolid 3)
+
+lampCover :: Float -> Prop
+lampCover h = ShapeProp
+    { _pjPos = V2 0 0
+    , _pjID  = 0
+    , _pjRot = 0
+    , _pjUpdate = updateLampCover
+    , _prDraw = drawLampCover h
+    }
+
+updateLampCover :: Prop -> World -> World
+updateLampCover pr w = w
+    & props . ix (_pjID pr) . pjRot +~ 0.15
+
+drawLampCover :: Float -> Prop -> SPic
+drawLampCover h pr =
+    ( translateSHz (h-2.5) . uncurryV translateSHf pos 
+        $ rotateSH a $ mconcat
+        [ upperPrismPoly 5 $ rectNSEW 6 5    6 (-4)
+        , upperPrismPoly 5 $ rectNSEW 6 (-4) 6 5
+        --, translateSHz 2.5 . upperPrismPoly 1 $ [V2 5 5,V2 (-4) 5,V2 5 (-4)]
+        , upperPrismPoly 1 $ [V2 5 5,V2 (-4) 5,V2 5 (-4)]
+        ]
+    , mempty
+    )
+  where
+    a = _pjRot pr
+    pos = _pjPos pr