Working dynamic shadows using shape vertices buffer

src/Shape.hs

@@ -14,29 +14,23 @@ module Shape
   where
 import Geometry
 import Geometry.Vector3D
-import Geometry.ConvexPoly
 import Shape.Data
 import Color
 
-import Data.Bifunctor
-
 emptySH :: Shape
 {-# INLINE emptySH #-}
 emptySH = mempty
 
 polyCirc :: Int -> Float -> [Point2]
 {-# INLINE polyCirc #-}
-polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/(fromIntegral n)..]
+polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/fromIntegral n..]
 
 upperPrismPoly 
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPoly #-}
-upperPrismPoly h ps =
-    ( [ShapeObj (TopPrism n) (f upps downps)]
-    , topEdges <> bottomEdges <> sideEdges
-    )
+upperPrismPoly h ps = [ShapeObj (TopPrism n) (f upps downps)]
   where
     n = length ps
     upps = map f' ps
@@ -46,13 +40,6 @@ upperPrismPoly h ps =
     f _ [] = []
     f' (V2 x y) = pairToSV (V3 x y h, black)
     f'' (V2 x y) = pairToSV (V3 x y 0, black)
-    topEdges = shEfromList $ concat $ zipWith makeTopEdge ps (tail ps ++ [head ps])
-    makeTopEdge (V2 x y) (V2 x' y') = [V3 x y h,V3 x' y' h,V3 x y 0,V3 xcen ycen h]
-    V2 xcen ycen = centroid ps
-    bottomEdges = shEfromList $ concat $ zipWith makeBottomEdge ps (tail ps ++ [head ps])
-    makeBottomEdge (V2 x' y') (V2 x y) = [V3 x y 0,V3 x' y' 0,V3 x y h,V3 xcen ycen 0]
-    sideEdges = shEfromList $ concat $ zipWith3 makeSideEdge ps (tail ps ++ [head ps]) (drop 2 ps ++ take 2 ps)
-    makeSideEdge (V2 xl yl) (V2 x y) (V2 xr yr) = [V3 x y 0, V3 x y h, V3 xr yr 0, V3 xl yl h]
 
 colorSH :: Color -> Shape -> Shape
 {-# INLINE colorSH #-}
@@ -60,11 +47,11 @@ colorSH col = overCol $ const col
 
 overCol :: (Point4 -> Point4) -> Shape -> Shape
 {-# INLINE overCol #-}
-overCol f = first (fmap $ overColObj f)
+overCol f = fmap $ overColObj f
 
 overPos :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINE overPos #-}
-overPos f = bimap (fmap $ overPosObj f) (fmap f)
+overPos f = fmap $ overPosObj f
 
 translateSH :: Point3 -> Shape -> Shape
 {-# INLINE translateSH #-}
@@ -84,7 +71,7 @@ rotateSH a = overPos (rotate3 a)
 
 scaleSH :: Point3 -> Shape -> Shape
 {-# INLINE scaleSH #-}
-scaleSH !(V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))
+scaleSH (V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))
 
 overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj
 {-# INLINE overColObj #-}