Make more point-free

This commit is contained in:
2021-10-29 18:44:54 +01:00
parent d5d4c93007
commit 4df03e59f5
+9 -9
View File
@@ -90,15 +90,15 @@ colorSH = overCol . const
overCol :: (Point4 -> Point4) -> Shape -> Shape overCol :: (Point4 -> Point4) -> Shape -> Shape
{-# INLINE overCol #-} {-# INLINE overCol #-}
overCol f = fmap $ overColObj f overCol = fmap . overColObj
overPos :: (Point3 -> Point3) -> Shape -> Shape overPosSHI :: (Point3 -> Point3) -> Shape -> Shape
{-# INLINE overPos #-} {-# INLINE overPosSHI #-}
overPos f = fmap $ overPosObj f overPosSHI = fmap . overPosObj
translateSH :: Point3 -> Shape -> Shape translateSH :: Point3 -> Shape -> Shape
{-# INLINE translateSH #-} {-# INLINE translateSH #-}
translateSH !p = overPos (+.+.+ p) translateSH !p = overPosSHI (+.+.+ p)
translateSHf :: Float -> Float -> Shape -> Shape translateSHf :: Float -> Float -> Shape -> Shape
{-# INLINE translateSHf #-} {-# INLINE translateSHf #-}
@@ -110,19 +110,19 @@ translateSHz !z = translateSH (V3 0 0 z)
rotateSH :: Float -> Shape -> Shape rotateSH :: Float -> Shape -> Shape
{-# INLINE rotateSH #-} {-# INLINE rotateSH #-}
rotateSH a = overPos (rotate3 a) rotateSH = overPosSHI . rotate3
overPosSH :: (Point3 -> Point3) -> Shape -> Shape overPosSH :: (Point3 -> Point3) -> Shape -> Shape
{-# INLINEABLE overPosSH #-} {-# INLINEABLE overPosSH #-}
overPosSH = overPos overPosSH = overPosSHI
rotateSHx :: Float -> Shape -> Shape rotateSHx :: Float -> Shape -> Shape
{-# INLINE rotateSHx #-} {-# INLINE rotateSHx #-}
rotateSHx a = overPos (rotate3x a) rotateSHx a = overPosSHI (rotate3x a)
scaleSH :: Point3 -> Shape -> Shape scaleSH :: Point3 -> Shape -> Shape
{-# INLINE scaleSH #-} {-# INLINE scaleSH #-}
scaleSH (V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c)) scaleSH (V3 a b c) = overPosSHI (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))
overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj
{-# INLINE overColObj #-} {-# INLINE overColObj #-}