Commit before attempting to change cloud shading

src/Shape.hs

@@ -11,6 +11,7 @@ module Shape
     , translateSHxy
     , rotateSH
     , rotateSHx
+    , rotateSHq
     , polyCircx
     , scaleSH
     , colorSH
@@ -18,10 +19,13 @@ module Shape
     , overPosSH
     , upperCylinder
     , upperRounded
+    , xCylinder
+    , xCylinder'
     ) where
 import Geometry
 import Shape.Data
 import Color
+import qualified Quaternion as Q
 
 -- - approximate a circle by a polygon with n*2 points of radius x
 polyCirc :: Int -> Float -> [Point2]
@@ -41,7 +45,6 @@ prismPoly
     -> [Point3] 
     -> Shape
 {-# INLINE prismPoly #-}
---prismPoly upps downps = [Surface (TopPrism n) (f upps downps) white FullShadowFidelity]
 prismPoly upps downps = [Surface (RoundedFaces n) (cp:cp:f upps downps) white FullShadowFidelity]
   where
     cp = centroidNum $ upps ++ downps
@@ -56,6 +59,17 @@ upperPrismPoly
 {-# INLINE upperPrismPoly #-}
 upperPrismPoly h ps = prismPoly (map (addZ h) ps) (map (addZ 0) ps)
 
+xCylinder :: Int -> Float -> Float -> Shape
+xCylinder n r x = rotateSHq (V3 0 1 0) (pi/2) . translateSHxy (-r) 0 . upperCylinder x $ polyCirc n r
+
+xCylinder' :: Float -> Float -> Shape
+xCylinder' r x = translateSHz r . rotateSHq (V3 0 1 0) (pi/2) . upperCylinder x $ 
+    [V2 r    (r)
+    ,V2 (-r/2) (r/2)
+    ,V2 (-r/2) (negate $ r/2)
+    ,V2 r    (-r)
+    ]
+
 upperBox 
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2] 
@@ -68,6 +82,9 @@ upperBox h ps = [Surface (FlatFaces n) (f ps) white FullShadowFidelity]
     f (x:xs) = g h x : g 0 x : f xs
     f _ = []
 
+rotateSHq :: Point3 -> Float -> Shape -> Shape
+rotateSHq p = overPosSH . Q.rotate . Q.axisAngle p
+
 upperCylinder 
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2] 
@@ -75,7 +92,7 @@ upperCylinder
 {-# INLINE upperCylinder #-}
 upperCylinder h ps = [Surface (Cylinder n) (addZ (h-0.5) cc:addZ 0.5 cc:f ps) white FullShadowFidelity]
   where
-    cc = centroid ps
+    cc = V2 0 0
     n = length ps
     g h' (V2 x y) = V3 x y h'
     f (x:xs) = g h x : g 0 x : f xs