Refactor shapes, prepare for different normals at single vertex pos

src/Shape.hs

@@ -22,11 +22,11 @@ import Geometry
 import Shape.Data
 import Color
 
-singleShape :: ShapeObj -> Shape
+singleShape :: Surface -> Shape
 {-# INLINE singleShape #-}
 singleShape = (:[])
 
-shMap :: (ShapeObj -> ShapeObj) -> Shape -> Shape
+shMap :: (Surface -> Surface) -> Shape -> Shape
 {-# INLINE shMap #-}
 shMap = map
 
@@ -52,23 +52,22 @@ prismPoly
     -> [Point3] 
     -> Shape
 {-# INLINE prismPoly #-}
-prismPoly upps downps = singleShape (ShapeObj (TopPrism n) (f upps downps))
+prismPoly upps downps = singleShape (Surface (TopPrism n) (f upps downps) black)
   where
     n = length upps
-    f (a:as) (b:bs) = g a:g b:f as bs
+    f (a:as) (b:bs) = a:b:f as bs
     f [] _ = []
     f _ [] = []
-    g p = ShapeV p black
 
 upperPrismPoly 
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPoly #-}
-upperPrismPoly h ps = singleShape (ShapeObj (TopPrism n) (f ps))
+upperPrismPoly h ps = singleShape (Surface (TopPrism n) (f ps) black)
   where
     n = length ps
-    g h' (V2 x y) = pairToSV (V3 x y h', black)
+    g h' (V2 x y) = V3 x y h'
     f (x:xs) = g h x : g 0 x : f xs
     f _ = []
 
@@ -77,15 +76,15 @@ upperPrismPolyHalf
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPolyHalf #-}
-upperPrismPolyHalf h ps = singleShape (ShapeObj (TopPrism n) (f upps downps))
+upperPrismPolyHalf h ps = singleShape (Surface (TopPrism n) (f upps downps) black)
   where
     n = length ps
     upps = map f' ps
     downps = map f'' ps
     f (a:as) (b:bs) = a:b:f as bs
     f _ _ = []
-    f' (V2 x y) = pairToSV (V3 (0.5 * x) (0.5 * y) h, black)
-    f'' (V2 x y) = pairToSV (V3 x y 0, black)
+    f' (V2 x y) = (V3 (0.5 * x) (0.5 * y) h)
+    f'' (V2 x y) = (V3 x y 0)
 
 colorSH :: Color -> Shape -> Shape
 {-# INLINE colorSH #-}
@@ -123,22 +122,14 @@ scaleSH :: Point3 -> Shape -> Shape
 {-# INLINE scaleSH #-}
 scaleSH (V3 a b c) = overPosSH (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))
 
-overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj
+overColObj :: (Point4 -> Point4) -> Surface -> Surface
 {-# INLINE overColObj #-}
-overColObj f (ShapeObj st vs) = ShapeObj st (fmap (overColVertex f) vs)
+overColObj f (Surface st vs col) = Surface st vs (f col)
 
 --overColObjM :: Monad m => (Point4 -> m Point4) -> ShapeObj -> m ShapeObj
 --{-# INLINE overColObjM #-}
 --overColObjM f (ShapeObj st vs) = ShapeObj st <$> mapM (svCol f) vs
 
-overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV
-{-# INLINE overColVertex #-}
-overColVertex f (ShapeV a b) = ShapeV a (f b)
-
-overPosObj :: (Point3 -> Point3) -> ShapeObj -> ShapeObj
+overPosObj :: (Point3 -> Point3) -> Surface -> Surface
 {-# INLINE overPosObj #-}
-overPosObj f (ShapeObj st vs) = ShapeObj st $ fmap (overPosVertex f) vs
-
-overPosVertex :: (Point3 -> Point3) -> ShapeV -> ShapeV
-{-# INLINE overPosVertex #-}
-overPosVertex f (ShapeV a b) = ShapeV (f a) b
+overPosObj f (Surface st vs col) = Surface st (map f vs) col