summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVincentBerthoux <>2017-08-12 07:19:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-08-12 07:19:00 (GMT)
commitbf8ec23def382e7d8d813efb608592fc5234a3ac (patch)
treed2a3d2fe4a2605c5063d2a804f925addd3b333c0
parente550e1d8cfb2b3c9cd8e912162e79420c28c4ea7 (diff)
version 0.3.30.3.3
-rw-r--r--changelog.md8
-rw-r--r--exec-src/svgrender.hs1
-rw-r--r--rasterific-svg.cabal9
-rw-r--r--src/Graphics/Rasterific/Svg/ArcConversion.hs121
-rw-r--r--src/Graphics/Rasterific/Svg/PathConverter.hs582
-rw-r--r--src/Graphics/Rasterific/Svg/RasterificRender.hs26
-rw-r--r--src/Graphics/Rasterific/Svg/RenderContext.hs124
7 files changed, 480 insertions, 391 deletions
diff --git a/changelog.md b/changelog.md
index 0d661d4..808e50b 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,6 +1,14 @@
Change log
==========
+v0.3.3 2017
+-----------
+
+ * Fix: Arc rendering, some cases where mishandled
+ * Addition: linked patterns handling
+ * Fix: gradient transformation handling
+ * Fix: better handling of viewbox attribute.
+
v0.3.2.1 November 2016
----------------------
* Fix: handling of "matrix()" transform
diff --git a/exec-src/svgrender.hs b/exec-src/svgrender.hs
index 8da8057..c05cd02 100644
--- a/exec-src/svgrender.hs
+++ b/exec-src/svgrender.hs
@@ -49,6 +49,7 @@ data Options = Options
, _dpi :: !Int
}
+
argParser :: Parser Options
argParser = Options
<$> ( argument str
diff --git a/rasterific-svg.cabal b/rasterific-svg.cabal
index b40871d..21e64d8 100644
--- a/rasterific-svg.cabal
+++ b/rasterific-svg.cabal
@@ -1,7 +1,7 @@
-- Initial svg.cabal generated by cabal init. For further documentation,
-- see http://haskell.org/cabal/users-guide/
name: rasterific-svg
-version: 0.3.2.1
+version: 0.3.3
synopsis: SVG renderer based on Rasterific.
description: SVG renderer that will let you render svg-tree parsed
SVG file to a JuicyPixel image or Rasterific Drawing.
@@ -22,7 +22,7 @@ Source-Repository head
Source-Repository this
Type: git
Location: git://github.com/Twinside/rasterific-svg.git
- Tag: v0.3.2.1
+ Tag: v0.3.3
library
hs-source-dirs: src
@@ -35,6 +35,7 @@ library
, Graphics.Rasterific.Svg.MeshConverter
, Graphics.Rasterific.Svg.RasterificRender
, Graphics.Rasterific.Svg.RasterificTextRendering
+ , Graphics.Rasterific.Svg.ArcConversion
build-depends: base >= 4.5 && < 5
, directory
@@ -46,7 +47,7 @@ library
, containers >= 0.5
, Rasterific >= 0.7 && < 0.8
, FontyFruity >= 0.5.2.1 && < 0.6
- , svg-tree >= 0.6 && < 0.7
+ , svg-tree >= 0.6.2 && < 0.7
, lens >= 4.5 && < 5
, linear >= 1.20
, vector >= 0.10
@@ -61,7 +62,7 @@ Executable svgrender
Main-Is: svgrender.hs
Ghc-options: -O3 -Wall
Build-Depends: base >= 4.6
- , optparse-applicative >= 0.11 && < 0.14
+ , optparse-applicative >= 0.11 && < 0.15
, directory >= 1.0
, bytestring
, rasterific-svg
diff --git a/src/Graphics/Rasterific/Svg/ArcConversion.hs b/src/Graphics/Rasterific/Svg/ArcConversion.hs
new file mode 100644
index 0000000..903822d
--- /dev/null
+++ b/src/Graphics/Rasterific/Svg/ArcConversion.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE BangPatterns #-}
+-- | Conversion from SVG arcs to bezier curves
+-- see https://github.com/GNOME/librsvg/blob/ebcbfae24321f22cd8c04a4951bbaf70b60d7f29/rust/src/path_builder.rs
+module Graphics.Rasterific.Svg.ArcConversion( arcToSegments ) where
+
+import Graphics.Svg.Types
+import Linear( M22, nearZero, (!*), V2( V2 ), norm, quadrance )
+
+toRadian :: Floating a => a -> a
+toRadian v = v / 180 * pi
+
+-- | Create a 2 dimensional rotation matrix given an angle
+-- expressed in radians.
+mkRotation :: Floating a => a -> M22 a
+mkRotation angle =
+ V2 (V2 ca (-sa))
+ (V2 sa ca)
+ where
+ ca = cos angle
+ sa = sin angle
+
+mkRota' :: Floating a => a -> M22 a
+mkRota' angle =
+ V2 (V2 ca sa)
+ (V2 (-sa) ca)
+ where
+ ca = cos angle
+ sa = sin angle
+
+arcSegment :: V2 Double -> Double -> Double -> V2 Double -> Double
+ -> PathCommand
+arcSegment c th0 th1 r angle = comm where
+ !comm = CurveTo OriginAbsolute
+ [( c + (finalRotation !* p1)
+ , c + (finalRotation !* p2)
+ , c + (finalRotation !* p3)
+ )]
+
+ !finalRotation = mkRotation $ toRadian angle
+
+ !th_half = 0.5 * (th1 - th0)
+ !t = (8.0 / 3.0) *
+ sin (th_half * 0.5) *
+ sin (th_half * 0.5) /
+ sin th_half
+
+ !cosTh0 = cos th0
+ !sinTh0 = sin th0
+ !cosTh1 = cos th1
+ !sinTh1 = sin th1
+
+ !p1 = r * V2 (cosTh0 - t * sinTh0) (sinTh0 + t * cosTh0)
+ !p3 = r * V2 cosTh1 sinTh1
+ !p2 = p3 + r * V2 (t * sinTh1) (-t * cosTh1)
+
+-- See Appendix F.6 Elliptical arc implementation notes
+-- http://www.w3.org/TR/SVG/implnote.html#ArcImplementationNotes */
+arc :: V2 Double -> Double -> Double -> Double -> Bool -> Bool -> V2 Double
+ -> [PathCommand]
+arc p1 rxOrig ryOrig x_axis_rotation is_large_arc is_sweep p2
+ | p1 == p2 = mempty
+ | nearZero (abs rxOrig) || nearZero (abs ryOrig) = [LineTo OriginAbsolute [p2]]
+ | kCheck == 0 = mempty
+ | norm kk == 0 = mempty
+ | k5Norm == 0 = mempty
+ | otherwise = segs
+ where
+ f = toRadian x_axis_rotation
+
+ k = (p1 - p2) * 0.5
+ p1_@(V2 x1_ y1_) = mkRota' f !* k
+
+ radius@(V2 rx ry)
+ | gamma > 1 = V2 (abs rxOrig * sqrt gamma) (abs ryOrig * sqrt gamma)
+ | otherwise = V2 (abs rxOrig) (abs ryOrig)
+ where gamma = (x1_ * x1_) / (rxOrig * rxOrig) + (y1_ * y1_) / (ryOrig * ryOrig)
+
+ sweepCoeff | is_sweep == is_large_arc = -1
+ | otherwise = 1
+
+ -- Compute the center
+ kCheck = rx * rx * y1_ * y1_ + ry * ry * x1_ * x1_
+
+ kc = (sweepCoeff *) . sqrt . abs $ (rx * rx * ry * ry) / kCheck - 1.0
+
+ c_ = V2 (kc * rx * y1_ / ry) (-kc * ry * x1_ / rx)
+ c = (mkRotation f !* c_) + (p1 + p2) * 0.5
+
+ -- Compute start angle
+ kk@(V2 k1 k2) = (p1_ - c_) / radius
+ kkk@(V2 k3 k4) = ((-p1_) - c_) / radius
+
+ theta1 = (if k2 < 0 then negate else id) . acos . min 1 . max (-1) $ k1 / norm kk
+
+ -- Compute delta_theta
+ k5Norm = sqrt $ quadrance kk * quadrance kkk
+
+ delta_theta
+ | is_sweep && v < 0.0 = v + 2 * pi
+ | not is_sweep && v > 0.0 = v - 2 * pi
+ | otherwise = v
+ where
+ vBase = acos . min 1 . max (-1) $ (k1 * k3 + k2 * k4) / k5Norm;
+ v | k1 * k4 - k3 * k2 < 0.0 = - vBase
+ | otherwise = vBase
+
+ -- Now draw the arc
+ n_segs :: Int
+ n_segs = ceiling . abs $ delta_theta / (pi * 0.5 + 0.001)
+
+ angleAt v = theta1 + fromIntegral v * delta_theta / fromIntegral n_segs
+
+ segs =
+ [arcSegment c (angleAt i) (angleAt $ i + 1) (V2 rx ry) x_axis_rotation
+ | i <- [0 .. n_segs - 1]]
+
+arcToSegments :: RPoint -> (Coord, Coord, Coord, Bool, Bool, RPoint)
+ -> [PathCommand]
+arcToSegments orig (radX, radY, rotateX, large, sweep, pos) =
+ arc orig radX radY rotateX large sweep pos
+
diff --git a/src/Graphics/Rasterific/Svg/PathConverter.hs b/src/Graphics/Rasterific/Svg/PathConverter.hs
index 7275813..f2e256f 100644
--- a/src/Graphics/Rasterific/Svg/PathConverter.hs
+++ b/src/Graphics/Rasterific/Svg/PathConverter.hs
@@ -1,332 +1,250 @@
-{-# LANGUAGE CPP #-}
-module Graphics.Rasterific.Svg.PathConverter
- ( svgPathToPrimitives
- , svgPathToRasterificPath
- ) where
-
-#if !MIN_VERSION_base(4,8,0)
-import Data.Monoid( mconcat )
-import Control.Applicative( pure, (<$>) )
-#endif
-
-import Data.List( mapAccumL )
-import Graphics.Rasterific.Linear( (^+^)
- , (^-^)
- , (^*)
- , norm
- , nearZero
- , zero )
-import qualified Graphics.Rasterific as R
-import Linear( dot, (!*!), (!*), V2( V2 ), scaled )
-import qualified Linear as L
-import Graphics.Svg.Types
-import Graphics.Rasterific.Svg.RenderContext
-
-singularize :: [PathCommand] -> [PathCommand]
-singularize = concatMap go
- where
- go (MoveTo _ []) = []
- go (MoveTo o (x: xs)) = MoveTo o [x] : go (LineTo o xs)
- go (LineTo o lst) = LineTo o . pure <$> lst
- go (HorizontalTo o lst) = HorizontalTo o . pure <$> lst
- go (VerticalTo o lst) = VerticalTo o . pure <$> lst
- go (CurveTo o lst) = CurveTo o . pure <$> lst
- go (SmoothCurveTo o lst) = SmoothCurveTo o . pure <$> lst
- go (QuadraticBezier o lst) = QuadraticBezier o . pure <$> lst
- go (SmoothQuadraticBezierCurveTo o lst) =
- SmoothQuadraticBezierCurveTo o . pure <$> lst
- go (EllipticalArc o lst) = EllipticalArc o . pure <$> lst
- go EndPath = [EndPath]
-
-toR :: RPoint -> R.Point
-{-# INLINE toR #-}
-toR (L.V2 x y) = realToFrac <$> R.V2 x y
-
-fromR :: R.Point -> RPoint
-{-# INLINE fromR #-}
-fromR (R.V2 x y) = realToFrac <$> L.V2 x y
-
-svgPathToPrimitives :: Bool -> [PathCommand] -> [R.Primitive]
-svgPathToPrimitives shouldClose lst
- | shouldClose && not (nearZero $ norm (lastPoint ^-^ firstPoint)) =
- concat $ prims ++ [R.line lastPoint firstPoint]
- | otherwise = concat prims
- where
- ((lastPoint, _, firstPoint), prims) =
- mapAccumL go (zero, zero, zero) $ singularize lst
-
- go (latest, p, first) EndPath =
- ((first, p, first), R.line latest first)
-
- go o (HorizontalTo _ []) = (o, [])
- go o (VerticalTo _ []) = (o, [])
- go o (MoveTo _ []) = (o, [])
- go o (LineTo _ []) = (o, [])
- go o (CurveTo _ []) = (o, [])
- go o (SmoothCurveTo _ []) = (o, [])
- go o (QuadraticBezier _ []) = (o, [])
- go o (SmoothQuadraticBezierCurveTo _ []) = (o, [])
- go o (EllipticalArc _ []) = (o, [])
-
- go (_, _, _) (MoveTo OriginAbsolute (p:_)) = ((p', p', p'), [])
- where p' = toR p
- go (o, _, _) (MoveTo OriginRelative (p:_)) =
- ((pp, pp, pp), []) where pp = o ^+^ toR p
-
- go (o@(R.V2 _ y), _, fp) (HorizontalTo OriginAbsolute (c:_)) =
- ((p, p, fp), R.line o p) where p = R.V2 (realToFrac c) y
- go (o@(R.V2 x y), _, fp) (HorizontalTo OriginRelative (c:_)) =
- ((p, p, fp), R.line o p) where p = R.V2 (x + realToFrac c) y
-
- go (o@(R.V2 x _), _, fp) (VerticalTo OriginAbsolute (c:_)) =
- ((p, p, fp), R.line o p) where p = R.V2 x (realToFrac c)
- go (o@(R.V2 x y), _, fp) (VerticalTo OriginRelative (c:_)) =
- ((p, p, fp), R.line o p) where p = R.V2 x (realToFrac c + y)
-
- go (o, _, fp) (LineTo OriginRelative (c:_)) =
- ((p, p, fp), R.line o p) where p = o ^+^ toR c
-
- go (o, _, fp) (LineTo OriginAbsolute (p:_)) =
- ((p', p', fp), R.line o $ toR p)
- where p' = toR p
-
- go (o, _, fp) (CurveTo OriginAbsolute ((c1, c2, e):_)) =
- ((e', c2', fp),
- [R.CubicBezierPrim $ R.CubicBezier o (toR c1) c2' e'])
- where e' = toR e
- c2' = toR c2
-
- go (o, _, fp) (CurveTo OriginRelative ((c1, c2, e):_)) =
- ((e', c2', fp), [R.CubicBezierPrim $ R.CubicBezier o c1' c2' e'])
- where c1' = o ^+^ toR c1
- c2' = o ^+^ toR c2
- e' = o ^+^ toR e
-
- go (o, control, fp) (SmoothCurveTo OriginAbsolute ((c2, e):_)) =
- ((e', c2', fp), [R.CubicBezierPrim $ R.CubicBezier o c1' c2' e'])
- where c1' = o ^* 2 ^-^ control
- c2' = toR c2
- e' = toR e
-
- go (o, control, fp) (SmoothCurveTo OriginRelative ((c2, e):_)) =
- ((e', c2', fp), [R.CubicBezierPrim $ R.CubicBezier o c1' c2' e'])
- where c1' = o ^* 2 ^-^ control
- c2' = o ^+^ toR c2
- e' = o ^+^ toR e
-
- go (o, _, fp) (QuadraticBezier OriginAbsolute ((c1, e):_)) =
- ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
- where e' = toR e
- c1' = toR c1
-
- go (o, _, fp) (QuadraticBezier OriginRelative ((c1, e):_)) =
- ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
- where c1' = o ^+^ toR c1
- e' = o ^+^ toR e
-
- go (o, control, fp)
- (SmoothQuadraticBezierCurveTo OriginAbsolute (e:_)) =
- ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
- where c1' = o ^* 2 ^-^ control
- e' = toR e
-
- go (o, control, fp)
- (SmoothQuadraticBezierCurveTo OriginRelative (e:_)) =
- ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
- where c1' = o ^* 2 ^-^ control
- e' = o ^+^ toR e
-
- go acc@(o, _, _) (EllipticalArc OriginAbsolute (e:_)) =
- (accFinal, mconcat outList)
- where
- (accFinal, outList) = mapAccumL go acc $ arcToSegments (fromR o) e
-
- go back@(o,_,_) (EllipticalArc OriginRelative ((rx, ry, rot, f1, f2, p): _)) =
- go back $ EllipticalArc OriginAbsolute [new]
- where p' = p L.^+^ (fromR o)
- new = (rx, ry, rot, f1, f2, p')
-
-
--- | Conversion function between svg path to the rasterific one.
-svgPathToRasterificPath :: Bool -> [PathCommand] -> R.Path
-svgPathToRasterificPath shouldClose lst =
- R.Path firstPoint shouldClose $ concat commands
- where
- lineTo p = [R.PathLineTo p]
- cubicTo e1 e2 e3 = [R.PathCubicBezierCurveTo e1 e2 e3]
- quadTo e1 e2 = [R.PathQuadraticBezierCurveTo e1 e2]
-
- ((_, _, firstPoint), commands) =
- mapAccumL go (zero, zero, zero) $ singularize lst
-
- go (_, p, first) EndPath =
- ((first, p, first), [])
-
- go o (HorizontalTo _ []) = (o, [])
- go o (VerticalTo _ []) = (o, [])
- go o (MoveTo _ []) = (o, [])
- go o (LineTo _ []) = (o, [])
- go o (CurveTo _ []) = (o, [])
- go o (SmoothCurveTo _ []) = (o, [])
- go o (QuadraticBezier _ []) = (o, [])
- go o (SmoothQuadraticBezierCurveTo _ []) = (o, [])
- go o (EllipticalArc _ []) = (o, [])
-
- go (_, _, _) (MoveTo OriginAbsolute (p:_)) =
- ((pp, pp, pp), []) where pp = toR p
- go (o, _, _) (MoveTo OriginRelative (p:_)) =
- ((pp, pp, pp), []) where pp = o ^+^ toR p
-
- go (R.V2 _ y, _, fp) (HorizontalTo OriginAbsolute (c:_)) =
- ((p, p, fp), lineTo p) where p = R.V2 (realToFrac c) y
- go (R.V2 x y, _, fp) (HorizontalTo OriginRelative (c:_)) =
- ((p, p, fp), lineTo p) where p = R.V2 (x + realToFrac c) y
-
- go (R.V2 x _, _, fp) (VerticalTo OriginAbsolute (c:_)) =
- ((p, p, fp), lineTo p) where p = R.V2 x (realToFrac c)
- go (R.V2 x y, _, fp) (VerticalTo OriginRelative (c:_)) =
- ((p, p, fp), lineTo p) where p = R.V2 x (realToFrac c + y)
-
- go (o, _, fp) (LineTo OriginRelative (c:_)) =
- ((p, p, fp), lineTo p) where p = o ^+^ toR c
-
- go (_, _, fp) (LineTo OriginAbsolute (p:_)) =
- ((p', p', fp), lineTo p')
- where p' = toR p
-
- go (_, _, fp) (CurveTo OriginAbsolute ((c1, c2, e):_)) =
- ((e', c2', fp), cubicTo c1' c2' e')
- where e' = toR e
- c2' = toR c2
- c1' = toR c1
-
- go (o, _, fp) (CurveTo OriginRelative ((c1, c2, e):_)) =
- ((e', c2', fp), cubicTo c1' c2' e')
- where c1' = o ^+^ toR c1
- c2' = o ^+^ toR c2
- e' = o ^+^ toR e
-
- go (o, control, fp) (SmoothCurveTo OriginAbsolute ((c2, e):_)) =
- ((e', c2', fp), cubicTo c1' c2' e')
- where c1' = o ^* 2 ^-^ control
- c2' = toR c2
- e' = toR e
-
- go (o, control, fp) (SmoothCurveTo OriginRelative ((c2, e):_)) =
- ((e', c2', fp), cubicTo c1' c2' e')
- where c1' = o ^* 2 ^-^ control
- c2' = o ^+^ toR c2
- e' = o ^+^ toR e
-
- go (_, _, fp) (QuadraticBezier OriginAbsolute ((c1, e):_)) =
- ((e', c1', fp), quadTo c1' e')
- where e' = toR e
- c1' = toR c1
-
- go (o, _, fp) (QuadraticBezier OriginRelative ((c1, e):_)) =
- ((e', c1', fp), quadTo c1' e')
- where c1' = o ^+^ toR c1
- e' = o ^+^ toR e
-
- go (o, control, fp)
- (SmoothQuadraticBezierCurveTo OriginAbsolute (e:_)) =
- ((e', c1', fp), quadTo c1' e')
- where c1' = o ^* 2 ^-^ control
- e' = toR e
-
- go (o, control, fp)
- (SmoothQuadraticBezierCurveTo OriginRelative (e:_)) =
- ((e', c1', fp), quadTo c1' e')
- where c1' = o ^* 2 ^-^ control
- e' = o ^+^ toR e
-
- go back@(o, _, _) (EllipticalArc OriginAbsolute (com:_)) = (nextState, mconcat pathCommands)
- where
- (nextState, pathCommands) =
- mapAccumL go back $ arcToSegments (fromR o) com
- go back@(o, _, _) (EllipticalArc OriginRelative ((rx, ry, rot, f1, f2, p):_)) =
- go back $ EllipticalArc OriginAbsolute [new]
- where p' = p L.^+^ (fromR o)
- new = (rx, ry, rot, f1, f2, p')
-
-
--- | Create a 2 dimensional rotation matrix given an angle
--- expressed in radians.
-mkRotation :: Floating a => a -> L.M22 a
-mkRotation angle =
- L.V2 (L.V2 ca (-sa))
- (L.V2 sa ca)
- where
- ca = cos angle
- sa = sin angle
-
-mkRota' :: Floating a => a -> L.M22 a
-mkRota' angle =
- L.V2 (L.V2 ca sa)
- (L.V2 (-sa) ca)
- where
- ca = cos angle
- sa = sin angle
-
-arcToSegments :: RPoint -> (Coord, Coord, Coord, Bool, Bool, RPoint)
- -> [PathCommand]
-arcToSegments orig (radX, radY, rotateX, large, sweep, pos) =
- [segmentToBezier transBackward (V2 xc yc) th2 th3
- | (th2, th3) <- zip angleSampling $ tail angleSampling]
- where
- angleSampling =
- [th0 + i * th_arc / fromIntegral segmentCount | i <- fromIntegral <$> [0 .. segmentCount]]
- theta = toRadian rotateX
- rotation = mkRota' theta
-
- V2 px py =
- (mkRota' theta !* (orig L.^-^ pos)) ^* 0.5
-
- (rx, ry)
- | tmp > 1 = (rx' * sqtmp, ry' * sqtmp)
- | otherwise = (rx', ry')
- where
- sqtmp = sqrt tmp
- tmp = (px * px) / (rx' * rx') + (py * py) / (ry' * ry')
- rx' = abs radX
- ry' = abs radY
-
- transBackward = mkRotation theta !*! scaled (V2 rx ry)
- trans = scaled (V2 (1 / rx) (1 / ry)) !*! rotation
-
- orig'@(V2 x0 y0) = trans !* orig
- pos'@(V2 x1 y1) = trans !* pos
- delta = pos' L.^-^ orig'
- d = delta `dot` delta
-
- sfactor | sweep == large = - factor
- | otherwise = factor
- where
- factor = sqrt . max 0 $ 1 / d - 0.25
-
- xc = 0.5 * (x0 + x1) - sfactor * (y1-y0)
- yc = 0.5 * (y0 + y1) + sfactor * (x1-x0)
-
- th0 = atan2 (y0 - yc) (x0 - xc)
- th1 = atan2 (y1 - yc) (x1 - xc)
-
- th_arc | tmp < 0 && sweep = tmp + 2 * pi
- | tmp > 0 && not sweep = tmp - 2 * pi
- | otherwise = tmp
- where
- tmp = th1 - th0
-
- segmentCount :: Int
- segmentCount = ceiling . abs $ th_arc / (pi / 2 + 0.001)
-
-segmentToBezier :: L.M22 Coord -> RPoint -> Coord -> Coord -> PathCommand
-segmentToBezier trans (V2 cx cy) th0 th1 =
- CurveTo OriginAbsolute [(trans !* p1, trans !* p2, trans !* p3)]
- where
- th_half = 0.5 * (th1 - th0)
- t = (8 / 3) * sin (th_half * 0.5) * sin (th_half * 0.5) / sin th_half
-
- p1 = V2 (cx + cos th0 - t * sin th0) (cy + sin th0 + t * cos th0)
- p3@(V2 x3 y3) = V2 (cx + cos th1) (cy + sin th1)
- p2 = V2 (x3 + t * sin th1) (y3 - t * cos th1)
-
+{-# LANGUAGE CPP #-}
+module Graphics.Rasterific.Svg.PathConverter
+ ( svgPathToPrimitives
+ , svgPathToRasterificPath
+ ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid( mconcat )
+import Control.Applicative( pure, (<$>) )
+#endif
+
+import Data.List( mapAccumL )
+import Graphics.Rasterific.Linear( (^+^)
+ , (^-^)
+ , (^*)
+ , norm
+ , nearZero
+ , zero )
+import qualified Graphics.Rasterific as R
+import qualified Linear as L
+import Graphics.Svg.Types
+import Graphics.Rasterific.Svg.ArcConversion
+
+singularize :: [PathCommand] -> [PathCommand]
+singularize = concatMap go
+ where
+ go (MoveTo _ []) = []
+ go (MoveTo o (x: xs)) = MoveTo o [x] : go (LineTo o xs)
+ go (LineTo o lst) = LineTo o . pure <$> lst
+ go (HorizontalTo o lst) = HorizontalTo o . pure <$> lst
+ go (VerticalTo o lst) = VerticalTo o . pure <$> lst
+ go (CurveTo o lst) = CurveTo o . pure <$> lst
+ go (SmoothCurveTo o lst) = SmoothCurveTo o . pure <$> lst
+ go (QuadraticBezier o lst) = QuadraticBezier o . pure <$> lst
+ go (SmoothQuadraticBezierCurveTo o lst) =
+ SmoothQuadraticBezierCurveTo o . pure <$> lst
+ go (EllipticalArc o lst) = EllipticalArc o . pure <$> lst
+ go EndPath = [EndPath]
+
+toR :: RPoint -> R.Point
+{-# INLINE toR #-}
+toR (L.V2 x y) = realToFrac <$> R.V2 x y
+
+fromR :: R.Point -> RPoint
+{-# INLINE fromR #-}
+fromR (R.V2 x y) = realToFrac <$> L.V2 x y
+
+svgPathToPrimitives :: Bool -> [PathCommand] -> [R.Primitive]
+svgPathToPrimitives shouldClose lst
+ | shouldClose && not (nearZero $ norm (lastPoint ^-^ firstPoint)) =
+ concat $ prims ++ [R.line lastPoint firstPoint]
+ | otherwise = concat prims
+ where
+ ((lastPoint, _, firstPoint), prims) =
+ mapAccumL go (zero, zero, zero) $ singularize lst
+
+ go (latest, p, first) EndPath =
+ ((first, p, first), R.line latest first)
+
+ go o (HorizontalTo _ []) = (o, [])
+ go o (VerticalTo _ []) = (o, [])
+ go o (MoveTo _ []) = (o, [])
+ go o (LineTo _ []) = (o, [])
+ go o (CurveTo _ []) = (o, [])
+ go o (SmoothCurveTo _ []) = (o, [])
+ go o (QuadraticBezier _ []) = (o, [])
+ go o (SmoothQuadraticBezierCurveTo _ []) = (o, [])
+ go o (EllipticalArc _ []) = (o, [])
+
+ go (_, _, _) (MoveTo OriginAbsolute (p:_)) = ((p', p', p'), [])
+ where p' = toR p
+ go (o, _, _) (MoveTo OriginRelative (p:_)) =
+ ((pp, pp, pp), []) where pp = o ^+^ toR p
+
+ go (o@(R.V2 _ y), _, fp) (HorizontalTo OriginAbsolute (c:_)) =
+ ((p, p, fp), R.line o p) where p = R.V2 (realToFrac c) y
+ go (o@(R.V2 x y), _, fp) (HorizontalTo OriginRelative (c:_)) =
+ ((p, p, fp), R.line o p) where p = R.V2 (x + realToFrac c) y
+
+ go (o@(R.V2 x _), _, fp) (VerticalTo OriginAbsolute (c:_)) =
+ ((p, p, fp), R.line o p) where p = R.V2 x (realToFrac c)
+ go (o@(R.V2 x y), _, fp) (VerticalTo OriginRelative (c:_)) =
+ ((p, p, fp), R.line o p) where p = R.V2 x (realToFrac c + y)
+
+ go (o, _, fp) (LineTo OriginRelative (c:_)) =
+ ((p, p, fp), R.line o p) where p = o ^+^ toR c
+
+ go (o, _, fp) (LineTo OriginAbsolute (p:_)) =
+ ((p', p', fp), R.line o $ toR p)
+ where p' = toR p
+
+ go (o, _, fp) (CurveTo OriginAbsolute ((c1, c2, e):_)) =
+ ((e', c2', fp),
+ [R.CubicBezierPrim $ R.CubicBezier o (toR c1) c2' e'])
+ where e' = toR e
+ c2' = toR c2
+
+ go (o, _, fp) (CurveTo OriginRelative ((c1, c2, e):_)) =
+ ((e', c2', fp), [R.CubicBezierPrim $ R.CubicBezier o c1' c2' e'])
+ where c1' = o ^+^ toR c1
+ c2' = o ^+^ toR c2
+ e' = o ^+^ toR e
+
+ go (o, control, fp) (SmoothCurveTo OriginAbsolute ((c2, e):_)) =
+ ((e', c2', fp), [R.CubicBezierPrim $ R.CubicBezier o c1' c2' e'])
+ where c1' = o ^* 2 ^-^ control
+ c2' = toR c2
+ e' = toR e
+
+ go (o, control, fp) (SmoothCurveTo OriginRelative ((c2, e):_)) =
+ ((e', c2', fp), [R.CubicBezierPrim $ R.CubicBezier o c1' c2' e'])
+ where c1' = o ^* 2 ^-^ control
+ c2' = o ^+^ toR c2
+ e' = o ^+^ toR e
+
+ go (o, _, fp) (QuadraticBezier OriginAbsolute ((c1, e):_)) =
+ ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
+ where e' = toR e
+ c1' = toR c1
+
+ go (o, _, fp) (QuadraticBezier OriginRelative ((c1, e):_)) =
+ ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
+ where c1' = o ^+^ toR c1
+ e' = o ^+^ toR e
+
+ go (o, control, fp)
+ (SmoothQuadraticBezierCurveTo OriginAbsolute (e:_)) =
+ ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
+ where c1' = o ^* 2 ^-^ control
+ e' = toR e
+
+ go (o, control, fp)
+ (SmoothQuadraticBezierCurveTo OriginRelative (e:_)) =
+ ((e', c1', fp), [R.BezierPrim $ R.Bezier o c1' e'])
+ where c1' = o ^* 2 ^-^ control
+ e' = o ^+^ toR e
+
+ go acc@(o, _, _) (EllipticalArc OriginAbsolute (e:_)) =
+ (accFinal, mconcat outList)
+ where
+ (accFinal, outList) = mapAccumL go acc $ arcToSegments (fromR o) e
+
+ go back@(o,_,_) (EllipticalArc OriginRelative ((rx, ry, rot, f1, f2, p): _)) =
+ go back $ EllipticalArc OriginAbsolute [new]
+ where p' = p L.^+^ (fromR o)
+ new = (rx, ry, rot, f1, f2, p')
+
+
+-- | Conversion function between svg path to the rasterific one.
+svgPathToRasterificPath :: Bool -> [PathCommand] -> R.Path
+svgPathToRasterificPath shouldClose lst =
+ R.Path firstPoint shouldClose $ concat commands
+ where
+ lineTo p = [R.PathLineTo p]
+ cubicTo e1 e2 e3 = [R.PathCubicBezierCurveTo e1 e2 e3]
+ quadTo e1 e2 = [R.PathQuadraticBezierCurveTo e1 e2]
+
+ ((_, _, firstPoint), commands) =
+ mapAccumL go (zero, zero, zero) $ singularize lst
+
+ go (_, p, first) EndPath =
+ ((first, p, first), [])
+
+ go o (HorizontalTo _ []) = (o, [])
+ go o (VerticalTo _ []) = (o, [])
+ go o (MoveTo _ []) = (o, [])
+ go o (LineTo _ []) = (o, [])
+ go o (CurveTo _ []) = (o, [])
+ go o (SmoothCurveTo _ []) = (o, [])
+ go o (QuadraticBezier _ []) = (o, [])
+ go o (SmoothQuadraticBezierCurveTo _ []) = (o, [])
+ go o (EllipticalArc _ []) = (o, [])
+
+ go (_, _, _) (MoveTo OriginAbsolute (p:_)) =
+ ((pp, pp, pp), []) where pp = toR p
+ go (o, _, _) (MoveTo OriginRelative (p:_)) =
+ ((pp, pp, pp), []) where pp = o ^+^ toR p
+
+ go (R.V2 _ y, _, fp) (HorizontalTo OriginAbsolute (c:_)) =
+ ((p, p, fp), lineTo p) where p = R.V2 (realToFrac c) y
+ go (R.V2 x y, _, fp) (HorizontalTo OriginRelative (c:_)) =
+ ((p, p, fp), lineTo p) where p = R.V2 (x + realToFrac c) y
+
+ go (R.V2 x _, _, fp) (VerticalTo OriginAbsolute (c:_)) =
+ ((p, p, fp), lineTo p) where p = R.V2 x (realToFrac c)
+ go (R.V2 x y, _, fp) (VerticalTo OriginRelative (c:_)) =
+ ((p, p, fp), lineTo p) where p = R.V2 x (realToFrac c + y)
+
+ go (o, _, fp) (LineTo OriginRelative (c:_)) =
+ ((p, p, fp), lineTo p) where p = o ^+^ toR c
+
+ go (_, _, fp) (LineTo OriginAbsolute (p:_)) =
+ ((p', p', fp), lineTo p')
+ where p' = toR p
+
+ go (_, _, fp) (CurveTo OriginAbsolute ((c1, c2, e):_)) =
+ ((e', c2', fp), cubicTo c1' c2' e')
+ where e' = toR e
+ c2' = toR c2
+ c1' = toR c1
+
+ go (o, _, fp) (CurveTo OriginRelative ((c1, c2, e):_)) =
+ ((e', c2', fp), cubicTo c1' c2' e')
+ where c1' = o ^+^ toR c1
+ c2' = o ^+^ toR c2
+ e' = o ^+^ toR e
+
+ go (o, control, fp) (SmoothCurveTo OriginAbsolute ((c2, e):_)) =
+ ((e', c2', fp), cubicTo c1' c2' e')
+ where c1' = o ^* 2 ^-^ control
+ c2' = toR c2
+ e' = toR e
+
+ go (o, control, fp) (SmoothCurveTo OriginRelative ((c2, e):_)) =
+ ((e', c2', fp), cubicTo c1' c2' e')
+ where c1' = o ^* 2 ^-^ control
+ c2' = o ^+^ toR c2
+ e' = o ^+^ toR e
+
+ go (_, _, fp) (QuadraticBezier OriginAbsolute ((c1, e):_)) =
+ ((e', c1', fp), quadTo c1' e')
+ where e' = toR e
+ c1' = toR c1
+
+ go (o, _, fp) (QuadraticBezier OriginRelative ((c1, e):_)) =
+ ((e', c1', fp), quadTo c1' e')
+ where c1' = o ^+^ toR c1
+ e' = o ^+^ toR e
+
+ go (o, control, fp)
+ (SmoothQuadraticBezierCurveTo OriginAbsolute (e:_)) =
+ ((e', c1', fp), quadTo c1' e')
+ where c1' = o ^* 2 ^-^ control
+ e' = toR e
+
+ go (o, control, fp)
+ (SmoothQuadraticBezierCurveTo OriginRelative (e:_)) =
+ ((e', c1', fp), quadTo c1' e')
+ where c1' = o ^* 2 ^-^ control
+ e' = o ^+^ toR e
+
+ go back@(o, _, _) (EllipticalArc OriginAbsolute (com:_)) = (nextState, mconcat pathCommands)
+ where
+ (nextState, pathCommands) =
+ mapAccumL go back $ arcToSegments (fromR o) com
+ go back@(o, _, _) (EllipticalArc OriginRelative ((rx, ry, rot, f1, f2, p):_)) =
+ go back $ EllipticalArc OriginAbsolute [new]
+ where p' = p L.^+^ (fromR o)
+ new = (rx, ry, rot, f1, f2, p')
+
diff --git a/src/Graphics/Rasterific/Svg/RasterificRender.hs b/src/Graphics/Rasterific/Svg/RasterificRender.hs
index d965d41..164da3d 100644
--- a/src/Graphics/Rasterific/Svg/RasterificRender.hs
+++ b/src/Graphics/Rasterific/Svg/RasterificRender.hs
@@ -43,7 +43,7 @@ import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Graphics.Rasterific as R
import System.FilePath( (</>), dropFileName )
-import Graphics.Rasterific.Linear( V2( V2 ), (^+^), (^-^), (^*), zero )
+import Graphics.Rasterific.Linear( V2( V2 ), (^+^), (^*), zero )
import Graphics.Rasterific.Outline
import qualified Graphics.Rasterific.Transformations as RT
import Graphics.Text.TrueType
@@ -129,9 +129,9 @@ drawingOfSvgDocument cache sizes dpi doc = case sizes of
aw = fromIntegral actualWidth
ah = fromIntegral actualHeight
sizeFitter (V2 0 0, _) _ = id
- sizeFitter (p@(V2 xs ys), V2 xEnd yEnd) actualSize =
- R.withTransformation (RT.translate (negate p)) .
- sizeFitter (zero, V2 (xEnd - xs) (yEnd - ys)) actualSize
+ sizeFitter (p, V2 xEnd yEnd) actualSize =
+ sizeFitter (zero, V2 xEnd yEnd) actualSize .
+ R.withTransformation (RT.translate (negate p))
renderAtSize (w, h) = do
let stateDraw = mapM (renderSvg emptyContext) $ _elements doc
@@ -146,22 +146,6 @@ withInfo accessor val action =
Nothing -> return $ return ()
Just v -> action v
-toTransformationMatrix :: Transformation -> RT.Transformation
-toTransformationMatrix = go where
- rf = realToFrac
- go (TransformMatrix a d b e c f) =
- RT.Transformation (rf a) (rf b) (rf c) (rf d) (rf e) (rf f)
- go (Translate x y) = RT.translate $ V2 (rf x) (rf y)
- go (Scale xs Nothing) = RT.scale (rf xs) (rf xs)
- go (Scale xs (Just ys)) = RT.scale (rf xs) (rf ys)
- go (Rotate angle Nothing) =
- RT.rotate . toRadian $ rf angle
- go (Rotate angle (Just (cx, cy))) =
- RT.rotateCenter (toRadian $ rf angle) $ V2 (rf cx) (rf cy)
- go (SkewX v) = RT.skewX . toRadian $ rf v
- go (SkewY v) = RT.skewY . toRadian $ rf v
- go TransformUnknown = mempty
-
withTransform :: DrawAttributes -> R.Drawing a ()
-> R.Drawing a ()
withTransform trans draw =
@@ -450,7 +434,7 @@ fitBox ctxt attr basePoint mwidth mheight preTranslate viewbox =
(Just (xs, ys, xe, ye)) ->
let boxOrigin = V2 (realToFrac xs) (realToFrac ys)
boxEnd = V2 (realToFrac xe) (realToFrac ye)
- V2 bw bh = abs $ boxEnd ^-^ boxOrigin
+ V2 bw bh = abs boxEnd
xScaleFactor = case w of
Just wpx -> wpx / bw
Nothing -> 1.0
diff --git a/src/Graphics/Rasterific/Svg/RenderContext.hs b/src/Graphics/Rasterific/Svg/RenderContext.hs
index 5c3c334..a22ae77 100644
--- a/src/Graphics/Rasterific/Svg/RenderContext.hs
+++ b/src/Graphics/Rasterific/Svg/RenderContext.hs
@@ -17,10 +17,10 @@ module Graphics.Rasterific.Svg.RenderContext
, linearisePoint
, lineariseLength
, prepareTexture
- , documentOfPattern
, fillAlphaCombine
, fillMethodOfSvg
, emTransform
+ , toTransformationMatrix
)
where
@@ -29,32 +29,39 @@ import Control.Applicative( (<$>) )
import Data.Monoid( Monoid( .. ) )
#endif
+import Control.Lens( (&), (.~) )
import Control.Monad.Trans.State.Strict( StateT )
import Codec.Picture( PixelRGBA8( .. ) )
import qualified Codec.Picture as CP
import qualified Data.Foldable as F
import qualified Data.Map as M
-import Data.Monoid( Last( .. ) )
+import Data.Monoid( (<>), Last( .. ) )
import Control.Lens( Lens', lens )
import Graphics.Rasterific.Linear( (^-^) )
import qualified Graphics.Rasterific as R
+import qualified Graphics.Rasterific.Transformations as RT
import qualified Graphics.Rasterific.Texture as RT
import Graphics.Text.TrueType
import Graphics.Svg.Types
import Graphics.Rasterific.Svg.MeshConverter
+import Debug.Trace
+import Text.Printf
+
toRadian :: Floating a => a -> a
toRadian v = v / 180 * pi
+type Definitions = M.Map String Element
+
data RenderContext = RenderContext
- { _initialViewBox :: (R.Point, R.Point)
- , _renderViewBox :: (R.Point, R.Point)
- , _renderDpi :: Int
- , _contextDefinitions :: M.Map String Element
- , _fontCache :: FontCache
- , _subRender :: Document -> IODraw (R.Drawing PixelRGBA8 ())
- , _basePath :: FilePath
+ { _initialViewBox :: !(R.Point, R.Point)
+ , _renderViewBox :: !(R.Point, R.Point)
+ , _renderDpi :: !Int
+ , _contextDefinitions :: !Definitions
+ , _fontCache :: !FontCache
+ , _subRender :: !(Document -> IODraw (R.Drawing PixelRGBA8 ()))
+ , _basePath :: !FilePath
}
data LoadedElements = LoadedElements
@@ -191,11 +198,18 @@ prepareGradientMeshTexture ctxt _attr mesh prims =
let bounds = F.foldMap R.planeBounds prims
strip (x, y) = (stripUnits ctxt x, stripUnits ctxt y)
mesh' = mapMeshBaseCoordiantes strip mesh
+ gradTransform = toTransformer $ _meshGradientTransform mesh
interp = case _meshGradientType mesh of
GradientBilinear -> R.PatchBilinear
GradientBicubic -> R.PatchBicubic
in
- RT.meshPatchTexture interp $ convertGradientMesh (globalBounds ctxt) bounds mesh'
+ RT.meshPatchTexture interp $
+ R.transform gradTransform $ convertGradientMesh (globalBounds ctxt) bounds mesh'
+
+toTransformer :: [Transformation] -> R.Point -> R.Point
+toTransformer [] = id
+toTransformer lst = RT.applyTransformation combined where
+ combined = F.foldMap toTransformationMatrix lst
prepareLinearGradientTexture
:: RenderContext -> DrawAttributes
@@ -207,13 +221,14 @@ prepareLinearGradientTexture ctxt attr grad opa prims =
CoordUserSpace -> linearisePoint ctxt attr
CoordBoundingBox -> boundbingBoxLinearise ctxt attr bounds
toA = maybe 1 id
+ gradTransform = toTransformer $ _linearGradientTransform grad
gradient =
[(offset, fillAlphaCombine (opa * toA opa2) color)
| GradientStop offset color _ opa2 <- _linearGradientStops grad]
startPoint = lineariser $ _linearGradientStart grad
stopPoint = lineariser $ _linearGradientStop grad
in
- RT.linearGradientTexture gradient startPoint stopPoint
+ RT.linearGradientTexture gradient (gradTransform startPoint) (gradTransform stopPoint)
prepareRadialGradientTexture
:: RenderContext -> DrawAttributes
@@ -228,10 +243,11 @@ prepareRadialGradientTexture ctxt attr grad opa prims =
(boundbingBoxLinearise ctxt attr bounds,
boundingBoxLength ctxt attr bounds)
toA = maybe 1 id
+ gradTransform = toTransformer $ _radialGradientTransform grad
gradient =
[(offset, fillAlphaCombine (opa * toA opa2) color)
| GradientStop offset color _ opa2 <- _radialGradientStops grad]
- center = lineariser $ _radialGradientCenter grad
+ center = gradTransform . lineariser $ _radialGradientCenter grad
radius = lengthLinearise $ _radialGradientRadius grad
in
case (_radialGradientFocusX grad,
@@ -261,17 +277,54 @@ fillAlphaCombine opacity (PixelRGBA8 r g b a) =
a' = fromIntegral a / 255.0
alpha = floor . max 0 . min 255 $ opacity * a' * 255
-documentOfPattern :: Pattern -> String -> Document
-documentOfPattern pat loc = Document
+scalesOfTransformation :: RT.Transformation -> (Float, Float)
+scalesOfTransformation (RT.Transformation a c _e
+ b d _f) = (widthScale, heightScale)
+ where
+ widthScale = sqrt $ a * a + c * c
+ heightScale = sqrt $ b * b + d * d
+
+
+documentOfPattern :: Definitions -> RT.Transformation -> Int -> Int -> Pattern -> String
+ -> Document
+documentOfPattern defs trans w h pat loc = Document
{ _viewBox = _patternViewBox pat
- , _width = return $ _patternWidth pat
- , _height = return $ _patternHeight pat
- , _elements = _patternElements pat
- , _definitions = M.empty
+ , _width = return . Num $ fromIntegral tileWidth
+ , _height = return . Num $ fromIntegral tileHeight
+ , _elements = _patternElements pat -- [GroupTree asTransformedGroup]
+ , _definitions = defs
, _styleRules = []
, _description = ""
, _documentLocation = loc
}
+ where
+ (widthScale, heightScale) = scalesOfTransformation trans
+ tileWidth, tileHeight :: Int
+ tileWidth = floor $ widthScale * fromIntegral w
+ tileHeight = floor $ heightScale * fromIntegral h
+ _asGroup = defaultSvg { _groupChildren = _patternElements pat }
+ _transfo = Scale
+ (realToFrac widthScale)
+ (Just . realToFrac $ heightScale)
+ _asTransformedGroup = _asGroup & drawAttr . transform .~ Just [_transfo]
+
+
+toTransformationMatrix :: Transformation -> RT.Transformation
+toTransformationMatrix = go where
+ rf = realToFrac
+ go (TransformMatrix a d b e c f) =
+ RT.Transformation (rf a) (rf b) (rf c) (rf d) (rf e) (rf f)
+ go (Translate x y) = RT.translate $ R.V2 (rf x) (rf y)
+ go (Scale xs Nothing) = RT.scale (rf xs) (rf xs)
+ go (Scale xs (Just ys)) = RT.scale (rf xs) (rf ys)
+ go (Rotate angle Nothing) =
+ RT.rotate . toRadian $ rf angle
+ go (Rotate angle (Just (cx, cy))) =
+ RT.rotateCenter (toRadian $ rf angle) $ R.V2 (rf cx) (rf cy)
+ go (SkewX v) = RT.skewX . toRadian $ rf v
+ go (SkewY v) = RT.skewY . toRadian $ rf v
+ go TransformUnknown = mempty
+
prepareTexture :: RenderContext -> DrawAttributes
-> Texture -> Float
@@ -281,26 +334,29 @@ prepareTexture _ _ FillNone _opacity _ = return Nothing
prepareTexture _ _ (ColorRef color) opacity _ =
return . Just . RT.uniformTexture $ fillAlphaCombine opacity color
prepareTexture ctxt attr (TextureRef ref) opacity prims =
- maybe (return Nothing) prepare $
- M.lookup ref (_contextDefinitions ctxt)
- where
- prepare (ElementGeometry _) = return Nothing
- prepare (ElementMarker _) = return Nothing
- prepare (ElementMask _) = return Nothing
- prepare (ElementClipPath _) = return Nothing
- prepare (ElementMeshGradient mesh) =
+ maybe (return Nothing) (prepare mempty) $ M.lookup ref (_contextDefinitions ctxt) where
+ prepare rootTrans e = case e of
+ ElementGeometry _ -> return Nothing
+ ElementMarker _ -> return Nothing
+ ElementMask _ -> return Nothing
+ ElementClipPath _ -> return Nothing
+ ElementMeshGradient mesh ->
return . Just $ prepareGradientMeshTexture ctxt attr mesh prims
- prepare (ElementLinearGradient grad) =
- return . Just $ prepareLinearGradientTexture ctxt
- attr grad opacity prims
- prepare (ElementRadialGradient grad) =
- return . Just $ prepareRadialGradientTexture ctxt
- attr grad opacity prims
- prepare (ElementPattern pat) = do
- let doc = documentOfPattern pat (_basePath ctxt)
+ ElementLinearGradient grad ->
+ return . Just $ prepareLinearGradientTexture ctxt attr grad opacity prims
+ ElementRadialGradient grad ->
+ return . Just $ prepareRadialGradientTexture ctxt attr grad opacity prims
+ ElementPattern pat@Pattern { _patternHref = "" } -> do
+ let doc = documentOfPattern (_contextDefinitions ctxt) rootTrans w h pat (_basePath ctxt)
dpi = _renderDpi ctxt
w = floor . lineariseXLength ctxt attr $ _patternWidth pat
h = floor . lineariseYLength ctxt attr $ _patternHeight pat
patDrawing <- _subRender ctxt doc
return . Just $ RT.patternTexture w h dpi (PixelRGBA8 0 0 0 0) patDrawing
+ ElementPattern pat -> do
+ let _inverser = maybe id RT.transformTexture . RT.inverseTransformation
+ _applyTransformation = RT.transformTexture
+ trans = maybe mempty (F.foldMap toTransformationMatrix) $ _patternTransform pat
+ nextRef = _patternHref pat
+ maybe (return Nothing) (prepare (rootTrans <> trans)) $ M.lookup nextRef (_contextDefinitions ctxt)