Define shape datatype

src/Shape.hs

@@ -0,0 +1,62 @@
+{-# LANGUAGE BangPatterns  #-}
+module Shape
+    ( module Shape.Data
+    , module Shape
+    )
+  where
+import Geometry
+--import Geometry.Vector3D
+import Shape.Data
+import Color
+
+empty :: Shape
+{-# INLINE empty #-}
+empty = Shape [] []
+
+flatPoly :: [Point2] -> Shape
+flatPoly ps = Shape
+    { _shVertices = polyToTris $ map f ps
+    , _shEdges = concat $ zipWith g ps (tail ps ++ [head ps])
+    }
+  where
+    f (V2 x y) = ShapeV {_svPos = V3 x y 0, _svCol = black }
+    g (V2 x y) (V2 a b) =
+        [ V3 x y   0
+        , V3 a b   0
+        , V3 x y (-1)
+        , V3 a b   1
+        ]
+
+colorSh :: Color -> Shape -> Shape
+colorSh col = overCol $ const col
+
+overCol :: (Point4 -> Point4) -> Shape -> Shape
+overCol f Shape{_shVertices=vs,_shEdges=es} = Shape 
+    {_shVertices = map (overColVertex f) vs
+    ,_shEdges    = es
+    }
+
+overPos :: (Point3 -> Point3) -> Shape -> Shape
+overPos f Shape{_shVertices=vs,_shEdges=es} = Shape 
+    {_shVertices = map (overPosVertex f) vs
+    ,_shEdges    = map f es
+    }
+
+translateSh :: Point3 -> Shape -> Shape
+translateSh !p = overPos (+p)
+
+scale :: Point3 -> Shape -> Shape
+scale !p = overPos (*p)
+
+overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV
+overColVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV
+    {_svPos = pos
+    ,_svCol = f col
+    }
+
+overPosVertex :: (Point3 -> Point3) -> ShapeV -> ShapeV
+overPosVertex f ShapeV{_svPos=pos,_svCol=col} = ShapeV
+    {_svPos = f pos
+    ,_svCol = col
+    }
+