Cleanup

src/Shape.hs

@@ -2,14 +2,13 @@
 module Shape
     ( module Shape.Data
     , translateSH
-    , emptySH
     , upperPrismPoly
     , upperPrismPolyHalf
     , prismPoly
     , polyCirc
     , upperBox
     , translateSHz
-    , translateSHf
+    , translateSHxy
     , rotateSH
     , rotateSHx
     , polyCircx
@@ -24,18 +23,6 @@ import Geometry
 import Shape.Data
 import Color
 
-singleShape :: Surface -> Shape
-{-# INLINE singleShape #-}
-singleShape = (:[])
-
-shMap :: (Surface -> Surface) -> Shape -> Shape
-{-# INLINE shMap #-}
-shMap = map
-
-emptySH :: Shape
-{-# INLINE emptySH #-}
-emptySH = mempty
-
 -- - approximate a circle by a polygon with n*2 points of radius x
 polyCirc :: Int -> Float -> [Point2]
 {-# INLINE polyCirc #-}
@@ -54,19 +41,18 @@ prismPoly
     -> [Point3] 
     -> Shape
 {-# INLINE prismPoly #-}
-prismPoly upps downps = singleShape (Surface (TopPrism n) (f upps downps) black)
+prismPoly upps downps = [Surface (TopPrism n) (f upps downps) white]
   where
     n = length upps
     f (a:as) (b:bs) = a:b:f as bs
-    f [] _ = []
-    f _ [] = []
+    f _ _ = []
 
 upperPrismPoly 
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPoly #-}
-upperPrismPoly h ps = singleShape (Surface (TopPrism n) (f ps) black)
+upperPrismPoly h ps = [Surface (TopPrism n) (f ps) white]
   where
     n = length ps
     g h' (V2 x y) = V3 x y h'
@@ -78,7 +64,7 @@ upperBox
     -> [Point2] 
     -> Shape
 {-# INLINE upperBox #-}
-upperBox h ps = singleShape (Surface (FlatFaces n) (f ps) white)
+upperBox h ps = [Surface (FlatFaces n) (f ps) white]
   where
     n = length ps
     g h' (V2 x y) = V3 x y h'
@@ -90,7 +76,7 @@ upperCylinder
     -> [Point2] 
     -> Shape
 {-# INLINE upperCylinder #-}
-upperCylinder h ps = singleShape (Surface (Cylinder n) (addZ (h-0.5) cc:addZ 0.5 cc:f ps) black)
+upperCylinder h ps = [Surface (Cylinder n) (addZ (h-0.5) cc:addZ 0.5 cc:f ps) white]
   where
     cc = centroid ps
     n = length ps
@@ -103,7 +89,7 @@ upperRounded
     -> [Point2] 
     -> Shape
 {-# INLINE upperRounded #-}
-upperRounded h ps = singleShape (Surface (RoundedFaces n) (addZ h cc:addZ 0 cc:f ps) black)
+upperRounded h ps = [Surface (RoundedFaces n) (addZ h cc:addZ 0 cc:f ps) white]
   where
     cc = centroid ps
     n = length ps
@@ -116,7 +102,7 @@ upperPrismPolyHalf
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPolyHalf #-}
-upperPrismPolyHalf h ps = singleShape (Surface (TopPrism n) (f upps downps) black)
+upperPrismPolyHalf h ps = [Surface (TopPrism n) (f upps downps) white]
   where
     n = length ps
     upps = map f' ps
@@ -132,15 +118,15 @@ colorSH = overColSH . const
 
 overColSH :: (Point4 -> Point4) -> Shape -> Shape
 {-# INLINE overColSH #-}
-overColSH = shMap . overColObj
+overColSH = map . overColObj
 
 translateSH :: Point3 -> Shape -> Shape
 {-# INLINE translateSH #-}
 translateSH !p = overPosSH (+.+.+ p)
 
-translateSHf :: Float -> Float -> Shape -> Shape
-{-# INLINE translateSHf #-}
-translateSHf !x !y = translateSH (V3 x y 0)
+translateSHxy :: Float -> Float -> Shape -> Shape
+{-# INLINE translateSHxy #-}
+translateSHxy !x !y = translateSH (V3 x y 0)
 
 translateSHz :: Float -> Shape -> Shape
 {-# INLINE translateSHz #-}
@@ -152,11 +138,11 @@ rotateSH = overPosSH . rotate3
 
 overPosSH :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINEABLE overPosSH #-}
-overPosSH = shMap . overPosObj
+overPosSH = map . overPosObj
 
 rotateSHx :: Float -> Shape -> Shape
 {-# INLINE rotateSHx #-}
-rotateSHx a = overPosSH (rotate3x a)
+rotateSHx = overPosSH . rotate3x
 
 scaleSH :: Point3 -> Shape -> Shape
 {-# INLINE scaleSH #-}
@@ -166,10 +152,6 @@ overColObj :: (Point4 -> Point4) -> Surface -> Surface
 {-# INLINE overColObj #-}
 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
-
 overPosObj :: (Point3 -> Point3) -> Surface -> Surface
 {-# INLINE overPosObj #-}
 overPosObj f (Surface st vs col) = Surface st (map f vs) col