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

src/Dodge/Render.hs

@@ -141,11 +141,14 @@ doDrawing' win pdata u = do
     let fs = _shapeShader pdata
     glUseProgram (_shadName fs)
     glBindVertexArray $ fs ^. shadVAO . vaoName
+--    glEnable GL_CULL_FACE
+--    glCullFace GL_BACK
     glDrawElements
         (marshalEPrimitiveMode $ _shadPrim' fs)
         (fromIntegral nIndices)
         GL_UNSIGNED_SHORT
         nullPtr
+--    glDisable GL_CULL_FACE
     --draw floor onto base buffer
     drawShader (fst $ _textureArrayShader pdata) nFls
     --draw lightmap into its own buffer

src/Dodge/Room/Foreground.hs

@@ -141,8 +141,6 @@ putShape sh =
     bnds = shapeBounds sh
     m = midBounds bnds
 
---shapePoints :: Shape -> Stream (Of Point2) Identity ()
---shapePoints = S.each . concatMap (map (stripZ . _svPos) . _shVs)
 shapePoints :: Shape -> [Point2]
 shapePoints = concatMap (map stripZ . _sfVs)