Implement shading for more types of shapes (cylinders, boxes)

src/Dodge/Creature/Picture.hs

@@ -9,6 +9,7 @@ module Dodge.Creature.Picture (
     deadFeet,
 ) where
 
+import Shape
 import Control.Lens
 import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
 import Dodge.Creature.Test
@@ -18,25 +19,29 @@ import Dodge.Item.Draw
 import Geometry
 import Picture
 import qualified Quaternion as Q
-import Shape
+--import Shape
 import ShapePicture
 
 basicCrPict :: Creature -> SPic
 basicCrPict cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr) 
     <> (basicCrShape cr, mempty)
 
+testShape :: Shape
+testShape = translateSHz 10 . rotateSHx 1 . upperBox 20 $ polyCirc 2 10
+
 basicCrShape ::
     Creature ->
     Shape
 basicCrShape cr
     | _crCamouflage cr == Invisible = mempty
-    | otherwise =
-        tr . scaleSH (V3 crsize crsize crsize) $
-            mconcat
-                [ rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
-                , rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
-                , rotmdir $ colorSH (_skinLower cskin) $ feet cr
-                ]
+    | otherwise = colorSH white $ tr $ rotdir testShape
+--    | otherwise =
+--        tr . scaleSH (V3 crsize crsize crsize) $
+--            mconcat
+--                [ rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
+--                , rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
+--                , rotmdir $ colorSH (_skinLower cskin) $ feet cr
+--                ]
   where
     cskin = _crType cr
     crsize = 0.1 * _crRad cr