Cleanup

src/Dodge/Render/ShapePicture.hs

@@ -33,6 +33,7 @@ import Picture
 import Sound.Data
 import Geometry.ConvexPoly
 import ShortShow
+import Polyhedra
 
 import StreamingHelp
 import qualified Data.IntMap.Strict as IM -- Lazy?
@@ -74,7 +75,30 @@ anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
 drawCreature :: Creature -> SPic
 drawCreature cr = case _crType cr of
     Humanoid {} -> basicCrPict cr
-    DrawnCreature f -> f cr
+    Barreloid {} -> picAtCrPos1 (setDepth 20 $ pictures 
+        [ color orange $ circleSolid 10
+        , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
+        , color (greyN 0.5) $ circleSolid 8
+        ]) cr
+    Lampoid h -> picAtCrPosNoRot1 (lampCrPic h) cr
+    NonDrawnCreature -> mempty
+
+lampCrPic :: Float -> Picture
+lampCrPic h = pictures 
+    [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
+    , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
+    ]
+  where
+    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
+    --DrawnCreature f -> f cr
+    --
+picAtCrPosNoRot1 :: Picture -> Creature -> SPic
+--{-# INLINE picAtCrPos #-}
+picAtCrPosNoRot1 thePic cr = (,) mempty $ uncurryV translate (_crPos cr) thePic
+
+picAtCrPos1 :: Picture -> Creature -> SPic
+--{-# INLINE picAtCrPos #-}
+picAtCrPos1 thePic cr = (,) mempty $ tranRot (_crPos cr) (_crDir cr) thePic
 
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
 shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)