Draw barrels properly

src/Dodge/Render/ShapePicture.hs

@@ -37,21 +37,26 @@ worldSPic cfig u =
     pointIsClose = cullPoint cfig w
 
 drawCreature :: Creature -> SPic
-drawCreature cr = case _crType cr of
+drawCreature cr = case cr ^. crType of
     BarrelCrit{} -> 
-        picAtCrPos1
+            uncurryV translateSPxy (_crPos cr) $ rotateSP (_crDir cr)
-            ( setDepth 20 $
+            $ barrelShape
-                fold
+--        picAtCrPos1
-                    [ color orange $ circleSolid 10
+--            ( setDepth 20 $
-                    , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
+--                fold
-                    , color (greyN 0.5) $ circleSolid 8
+--                    [ color orange $ circleSolid 10
-                    ]
+--                    , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
-            )
+--                    , color (greyN 0.5) $ circleSolid 8
-            cr
+--                    ]
+--            )
+--            cr
     LampCrit{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ lampCrSPic h
     _ -> basicCrPict cr
 --    NonDrawnCreature -> mempty
 
+barrelShape :: SPic
+barrelShape = noPic $ upperPrismPoly Medium Important 20 $ polyCirc 3 10
+
 lampCrSPic :: Float -> SPic
 lampCrSPic h =
     colorSH blue (upperBox Small Typical h $ rectWH 5 5)

src/Shape.hs

@@ -42,7 +42,7 @@ import Geometry
 import qualified Quaternion as Q
 import Shape.Data
 
--- - approximate a circle by a polygon with n*2 points of radius x
+-- - approximate a circle around the z axis by a polygon with n*2 points of radius x
 polyCirc :: Int -> Float -> [Point2]
 {-# INLINE polyCirc #-}
 polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n * 2) [0, pi / fromIntegral n ..]
@@ -120,9 +120,9 @@ upperPrismPolyTS :: Float -> [Point2] -> Shape
 upperPrismPolyTS = upperPrismPoly Tiny Superfluous
 
 upperPrismPoly ::
-    -- | height, expected to be strictly positive
     Size ->
     Importance ->
+    -- | height, expected to be strictly positive
     Float ->
     -- | Should be anticlockwise
     [Point2] ->