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

src/Shape.hs

@@ -7,6 +7,7 @@ module Shape
     , upperPrismPolyHalf
     , prismPoly
     , polyCirc
+    , upperBox
     , translateSHz
     , translateSHf
     , rotateSH
@@ -17,6 +18,7 @@ module Shape
     , overColSH
 --    , overColSHM
     , overPosSH
+    , upperCylinder
     ) where
 import Geometry
 import Shape.Data
@@ -71,6 +73,31 @@ upperPrismPoly h ps = singleShape (Surface (TopPrism n) (f ps) black)
     f (x:xs) = g h x : g 0 x : f xs
     f _ = []
 
+upperBox 
+    :: Float    -- ^ height, expected to be strictly positive
+    -> [Point2] 
+    -> Shape
+{-# INLINE upperBox #-}
+upperBox h ps = singleShape (Surface (TopBox n) (f ps) white)
+  where
+    n = length ps
+    g h' (V2 x y) = V3 x y h'
+    f (x:xs) = g h x : g 0 x : f xs
+    f _ = []
+
+upperCylinder 
+    :: Float    -- ^ height, expected to be strictly positive
+    -> [Point2] 
+    -> Shape
+{-# INLINE upperCylinder #-}
+upperCylinder h ps = singleShape (Surface (TopCylinder n) (addZ h cc:addZ 0 cc:f ps) black)
+  where
+    cc = centroid ps
+    n = length ps
+    g h' (V2 x y) = V3 x y h'
+    f (x:xs) = g h x : g 0 x : f xs
+    f _ = []
+
 upperPrismPolyHalf
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2]