module Graphics.Rasterific.Lenses
(
lineX0
, lineX1
, linePoints
, bezX0
, bezX1
, bezX2
, bezierPoints
, cbezX0
, cbezX1
, cbezX2
, cbezX3
, cubicBezierPoints
, primitivePoints
, pathCommandPoints
, pathPoints
, Lens
, Lens'
, Traversal
, Traversal'
) where
#if !MIN_VERSION_base(4,8,0)
import Data.Traversable( traverse )
import Control.Applicative( Applicative, (<*>), pure )
#endif
import Control.Applicative( (<$>) )
import Graphics.Rasterific.Types
type Lens s t a b =
forall f. Functor f => (a -> f b) -> s -> f t
type Lens' s a = Lens s s a a
type Traversal s t a b =
forall f. Applicative f => (a -> f b) -> s -> f t
type Traversal' s a = Traversal s s a a
lens :: (s -> a)
-> (s -> b -> t)
-> Lens s t a b
lens accessor setter = \f src ->
fmap (setter src) $ f (accessor src)
linePoints :: Traversal' Line Point
linePoints f (Line p0 p1) = Line <$> f p0 <*> f p1
lineX0 :: Lens' Line Point
lineX0 = lens _lineX0 setter where
setter a b = a { _lineX0 = b }
lineX1 :: Lens' Line Point
lineX1 = lens _lineX1 setter where
setter a b = a { _lineX1 = b }
bezX0 :: Lens' Bezier Point
bezX0 = lens _bezierX0 setter where
setter a b = a { _bezierX0 = b }
bezX1 :: Lens' Bezier Point
bezX1 = lens _bezierX1 setter where
setter a b = a { _bezierX1 = b }
bezX2 :: Lens' Bezier Point
bezX2 = lens _bezierX2 setter where
setter a b = a { _bezierX2 = b }
bezierPoints :: Traversal' Bezier Point
bezierPoints f (Bezier p0 p1 p2) =
Bezier <$> f p0 <*> f p1 <*> f p2
cbezX0 :: Lens' CubicBezier Point
cbezX0 = lens _cBezierX0 setter where
setter a b = a { _cBezierX0 = b }
cbezX1 :: Lens' CubicBezier Point
cbezX1 = lens _cBezierX1 setter where
setter a b = a { _cBezierX1 = b }
cbezX2 :: Lens' CubicBezier Point
cbezX2 = lens _cBezierX2 setter where
setter a b = a { _cBezierX2 = b }
cbezX3 :: Lens' CubicBezier Point
cbezX3 = lens _cBezierX2 setter where
setter a b = a { _cBezierX3 = b }
cubicBezierPoints :: Traversal' CubicBezier Point
cubicBezierPoints f (CubicBezier p0 p1 p2 p3) =
CubicBezier <$> f p0 <*> f p1 <*> f p2 <*> f p3
primitivePoints :: Traversal' Primitive Point
primitivePoints f (LinePrim l) = LinePrim <$> linePoints f l
primitivePoints f (BezierPrim b) = BezierPrim <$> bezierPoints f b
primitivePoints f (CubicBezierPrim c) =
CubicBezierPrim <$> cubicBezierPoints f c
pathCommandPoints :: Traversal' PathCommand Point
pathCommandPoints f (PathLineTo p) = PathLineTo <$> f p
pathCommandPoints f (PathQuadraticBezierCurveTo p1 p2) =
PathQuadraticBezierCurveTo <$> f p1 <*> f p2
pathCommandPoints f (PathCubicBezierCurveTo p1 p2 p3) =
PathCubicBezierCurveTo <$> f p1 <*> f p2 <*> f p3
pathPoints :: Traversal' Path Point
pathPoints f (Path p0 yn comms) =
Path <$> f p0 <*> pure yn <*> traverse (pathCommandPoints f) comms