justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Turn shapeObject's vertices into a stream

Browse Source
This commit is contained in:
justin
2022-06-27 17:47:03 +01:00
parent 8d5800d806
commit 673e9b11fc
7 changed files with 47 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shape.hs
+13 -12
View File
@@ -15,12 +15,13 @@ module Shape
, scaleSH
, colorSH
, overColSH
, overColSHM
-- , overColSHM
, overPosSH
) where
import Geometry
import Shape.Data
import Color
import qualified Data.Vector.Fusion.Stream.Monadic as VS
emptySH :: Shape
{-# INLINE emptySH #-}
@@ -44,7 +45,7 @@ prismPoly
-> [Point3]
-> Shape
{-# INLINE prismPoly #-}
prismPoly upps downps = [ShapeObj (TopPrism n) (f upps downps)]
prismPoly upps downps = [ShapeObj (TopPrism n) (VS.fromList $ f upps downps)]
where
n = length upps
f (a:as) (b:bs) = g a:g b:f as bs
@@ -57,7 +58,7 @@ upperPrismPoly
-> [Point2]
-> Shape
{-# INLINE upperPrismPoly #-}
upperPrismPoly h ps = [ShapeObj (TopPrism n) (f ps)]
upperPrismPoly h ps = [ShapeObj (TopPrism n) (VS.fromList $ f ps)]
where
n = length ps
g h' (V2 x y) = pairToSV (V3 x y h', black)
@@ -69,7 +70,7 @@ upperPrismPolyHalf
-> [Point2]
-> Shape
{-# INLINE upperPrismPolyHalf #-}
upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (f upps downps)]
upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (VS.fromList $ f upps downps)]
where
n = length ps
upps = map f' ps
@@ -87,9 +88,9 @@ overColSH :: (Point4 -> Point4) -> Shape -> Shape
{-# INLINE overColSH #-}
overColSH = fmap . overColObj
overColSHM :: Monad m => (Point4 -> m Point4) -> Shape -> m Shape
{-# INLINE overColSHM #-}
overColSHM = mapM . overColObjM
--overColSHM :: Monad m => (Point4 -> m Point4) -> Shape -> m Shape
--{-# INLINE overColSHM #-}
--overColSHM = mapM . overColObjM
overPosSHI :: (Point3 -> Point3) -> Shape -> Shape
{-# INLINE overPosSHI #-}
@@ -125,11 +126,11 @@ scaleSH (V3 a b c) = overPosSHI (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))
overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj
{-# INLINE overColObj #-}
overColObj f (ShapeObj st vs) = ShapeObj st (map (overColVertex f) vs)
overColObj f (ShapeObj st vs) = ShapeObj st (VS.map (overColVertex f) vs)
overColObjM :: Monad m => (Point4 -> m Point4) -> ShapeObj -> m ShapeObj
{-# INLINE overColObjM #-}
overColObjM f (ShapeObj st vs) = ShapeObj st <$> mapM (svCol f) vs
--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 #-}
@@ -137,7 +138,7 @@ overColVertex f (ShapeV a b) = ShapeV a (f b)
overPosObj :: (Point3 -> Point3) -> ShapeObj -> ShapeObj
{-# INLINE overPosObj #-}
overPosObj f (ShapeObj st vs) = ShapeObj st $ map (overPosVertex f) vs
overPosObj f (ShapeObj st vs) = ShapeObj st $ VS.map (overPosVertex f) vs
overPosVertex :: (Point3 -> Point3) -> ShapeV -> ShapeV
{-# INLINE overPosVertex #-}