diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -24,5 +24,9 @@ * `marker` element hadnling * Path arcs. +And from SVG 2.0 draft: + + * Gradient mesh + This package can render SVG to an image or transform it to a PDF. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ Change log ========== +v0.3.2 October 2016 +------------------- + * Bumping Rasterific dep + * Bumping svg-tree dep + * Adding SVG2 gradient mesh rendering + v0.3.1.2 May 2016 ----------------- * Fix: Bumping for GHC 8.0 diff --git a/exec-src/svgrender.hs b/exec-src/svgrender.hs --- a/exec-src/svgrender.hs +++ b/exec-src/svgrender.hs @@ -6,6 +6,7 @@ import Control.Applicative( (<|>) ) import Control.Monad( when ) +import qualified Data.ByteString.Lazy as LB import Data.Monoid( (<>) ) import Codec.Picture( writePng ) import System.Directory( getTemporaryDirectory ) @@ -31,6 +32,7 @@ import Graphics.Rasterific.Svg( loadCreateFontCache , renderSvgDocument + , pdfOfSvgDocument ) import Graphics.Svg( loadSvgFile , documentSize ) @@ -41,6 +43,7 @@ { _inputFile :: !FilePath , _outputFile :: !FilePath , _verbose :: !Bool + , _asPdf :: !Bool , _width :: !Int , _height :: !Int , _dpi :: !Int @@ -57,6 +60,7 @@ <> " different extension if unspecified.")) <|> pure "" ) <*> ( switch (long "verbose" <> help "Display more information") ) + <*> ( switch (long "pdf" <> help "Convert to a PDF" ) ) <*> ( option auto ( long "width" <> help "Force the width of the rendered PNG" @@ -77,7 +81,7 @@ progOptions :: ParserInfo Options progOptions = info (helper <*> argParser) ( fullDesc - <> progDesc "Convert SVGINPUTFILE into a png OUTPUTFILE" + <> progDesc "Convert SVGINPUTFILE into a png or pdf OUTPUTFILE" <> header "svgrender svg file renderer." ) outFileName :: Options -> FilePath @@ -108,9 +112,16 @@ let dpi = _dpi options size = fixSize options $ documentSize dpi d whenVerbose $ "Rendering at " ++ show size - (finalImage, _) <- renderSvgDocument cache (Just size) dpi d - writePng (outFileName options) finalImage - exitWith ExitSuccess + if _asPdf options then do + whenVerbose $ "Writing PDF at " ++ outFileName options + (doc, _) <- pdfOfSvgDocument cache (Just size) dpi d + LB.writeFile (outFileName options) doc + exitWith ExitSuccess + else do + whenVerbose $ "Writing PNG at " ++ outFileName options + (finalImage, _) <- renderSvgDocument cache (Just size) dpi d + writePng (outFileName options) finalImage + exitWith ExitSuccess main :: IO () main = execParser progOptions >>= runConversion diff --git a/rasterific-svg.cabal b/rasterific-svg.cabal --- 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.1.2 +version: 0.3.2 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 this Type: git Location: git://github.com/Twinside/rasterific-svg.git - Tag: v0.3.1.2 + Tag: v0.3.2 library hs-source-dirs: src @@ -32,6 +32,7 @@ exposed-modules: Graphics.Rasterific.Svg other-modules: Graphics.Rasterific.Svg.RenderContext , Graphics.Rasterific.Svg.PathConverter + , Graphics.Rasterific.Svg.MeshConverter , Graphics.Rasterific.Svg.RasterificRender , Graphics.Rasterific.Svg.RasterificTextRendering @@ -43,15 +44,16 @@ , scientific >= 0.3 , JuicyPixels >= 3.2 && < 3.3 , containers >= 0.5 - , Rasterific >= 0.6.1.1 && < 0.7 + , Rasterific >= 0.7 && < 0.8 , FontyFruity >= 0.5.2.1 && < 0.6 - , svg-tree >= 0.5.1.1 && < 0.6 + , svg-tree >= 0.6 && < 0.7 , lens >= 4.5 && < 5 , linear >= 1.20 , vector >= 0.10 , text >= 1.2 , transformers >= 0.3 && < 0.6 , mtl >= 2.1 && < 2.3 + , primitive Executable svgrender default-language: Haskell2010 @@ -59,8 +61,9 @@ Main-Is: svgrender.hs Ghc-options: -O3 -Wall Build-Depends: base >= 4.6 - , optparse-applicative >= 0.11 && < 0.13 + , optparse-applicative >= 0.11 && < 0.14 , directory >= 1.0 + , bytestring , rasterific-svg , Rasterific , JuicyPixels diff --git a/src/Graphics/Rasterific/Svg/MeshConverter.hs b/src/Graphics/Rasterific/Svg/MeshConverter.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rasterific/Svg/MeshConverter.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +module Graphics.Rasterific.Svg.MeshConverter + ( mapMeshBaseCoordiantes + , convertGradientMesh ) where + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid( mconcat ) +import Control.Applicative( pure, (<$>) ) +#endif + +import Control.Monad.Primitive( PrimMonad, PrimState ) +import Control.Monad.Reader.Class( MonadReader ) +import Graphics.Rasterific.Linear( (^+^) + , (^-^) + , lerp + ) +import qualified Linear as L +import qualified Graphics.Rasterific as R +import Data.Vector( (//) ) +import qualified Data.Vector as V + +import Codec.Picture( PixelRGBA8( .. ) ) + +import Graphics.Svg.Types +import Graphics.Rasterific.MeshPatch +{-import Graphics.Rasterific.Svg.RenderContext-} + +toBaseX :: R.PlaneBound -> MeshGradient -> Float +toBaseX bounds mesh = case _meshGradientX mesh of + Num n -> realToFrac n + Percent p -> miniX + (maxiX - miniX) * realToFrac p + Px n -> realToFrac n + Em n -> realToFrac n + Pc n -> realToFrac n + Mm n -> realToFrac n + Cm n -> realToFrac n + Point n -> realToFrac n + Inches n -> realToFrac n + where + R.PlaneBound (R.V2 miniX _miniY) (R.V2 maxiX _maxiY) = bounds + +toBaseY :: R.PlaneBound -> MeshGradient -> Float +toBaseY bounds mesh = case _meshGradientY mesh of + Num n -> realToFrac n + Percent p -> miniY + (maxiY - miniY) * realToFrac p + Px n -> realToFrac n + Em n -> realToFrac n + Pc n -> realToFrac n + Mm n -> realToFrac n + Cm n -> realToFrac n + Point n -> realToFrac n + Inches n -> realToFrac n + where + R.PlaneBound (R.V2 _miniX miniY) (R.V2 _maxiX maxiY) = bounds + +mapMeshBaseCoordiantes :: ((Number, Number) -> (Number, Number)) -> MeshGradient + -> MeshGradient +mapMeshBaseCoordiantes f m = m { _meshGradientX = x, _meshGradientY = y } + where (x, y) = f (_meshGradientX m, _meshGradientY m) + +convertGradientMesh :: R.PlaneBound -> R.PlaneBound -> MeshGradient -> MeshPatch PixelRGBA8 +convertGradientMesh globalBounds bounds mesh = scaler rmesh where + (_, rmesh) = withMesh baseGrid (gatherGeometry svgBasePoint mesh) + (w, h) = svgMeshSize mesh + colors = gatherColors mesh w h + baseGrid = generateLinearGrid w h svgBasePoint svgBasePoint colors + + svgBasePoint = + R.V2 (toBaseX startBounds mesh) (toBaseY startBounds mesh) + + startBounds = case _meshGradientUnits mesh of + CoordUserSpace -> globalBounds + CoordBoundingBox -> R.PlaneBound (R.V2 0 0) (R.V2 1 1) + + delta = R._planeMaxBound bounds ^-^ R._planeMinBound bounds + toBoundingBox p = R._planeMinBound bounds ^+^ delta * p + + scaler :: MeshPatch px -> MeshPatch px + scaler = case _meshGradientUnits mesh of + CoordUserSpace -> id + CoordBoundingBox -> R.transform toBoundingBox + + +gatherGeometry :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) + => R.Point -> MeshGradient -> m () +gatherGeometry basePoint = mapM_ goRow . zip [0 ..] . _meshGradientRows where + toCurve firstPatchPoint lastPoint p = case _gradientPath p of + Just pp -> svgPathToPrimitives firstPatchPoint lastPoint pp + Nothing -> lastPoint `straightLine` firstPatchPoint + + lastOf (R.CubicBezier _ _ _ a) = a + firstOf (R.CubicBezier a _ _ _) = a + goRow (y, r) = mapM_ (goPatch y) . zip [0 ..] $ _meshGradientRowPatches r + goPatch y (x, patch) = case _meshGradientPatchStops patch of + -- A B + -- +---+ + -- | | + -- +---+ + -- D C + [a, b, c, d] -> do + let toC = toCurve basePoint + northEast = toC basePoint a + eastSouth = toC (lastOf northEast) b + southWest = toC (lastOf eastSouth) c + westNorth = toC (lastOf southWest) d + setVertice x y $ firstOf northEast + setVertice (x + 1) y $ lastOf northEast + setVertice (x + 1) (y + 1) $ firstOf southWest + setVertice x (y + 1) $ lastOf southWest + horizOrdered northEast + horizUnordered southWest + vertUnordered westNorth + vertOrdered eastSouth + + -- A B + -- +---+ + -- | + -- +---+ + -- C + [a, b, c] | y == 0 -> do + firstPoint <- getVertice x y + closePoint <- getVertice x (y + 1) + let toC = toCurve closePoint + northEast = toC firstPoint a + eastSouth = toC (lastOf northEast) b + southWest = toC (lastOf eastSouth) c + setVertice (x + 1) y $ firstOf eastSouth + setVertice (x + 1) (y + 1) $ lastOf eastSouth + horizOrdered northEast + horizUnordered southWest + vertOrdered eastSouth + + + -- B + -- + + + -- | | + -- +---+ + -- D C + [b, c, d] -> do + firstPoint <- getVertice (x + 1) y + closePoint <- getVertice x y + let toC = toCurve closePoint + eastSouth = toC firstPoint b + southWest = toC (lastOf eastSouth) c + westNorth = toC (lastOf southWest) d + setVertice (x + 1) (y + 1) $ firstOf southWest + setVertice x (y + 1) $ lastOf southWest + horizUnordered southWest + vertUnordered westNorth + vertOrdered eastSouth + + -- B + -- + + -- | + -- +---+ + -- C + [b, c] -> do + firstPoint <- getVertice (x + 1) y + closePoint <- getVertice x (y + 1) + let toC = toCurve closePoint + eastSouth = toC firstPoint b + southWest = toC (lastOf eastSouth) c + setVertice (x + 1) (y + 1) $ firstOf southWest + horizUnordered southWest + vertOrdered eastSouth + _ -> return () + where + horizOrdered (R.CubicBezier _ b c _) = setHorizPoints x y $ InterBezier b c + horizUnordered (R.CubicBezier _ b c _) = setHorizPoints x (y + 1) $ InterBezier c b + vertUnordered (R.CubicBezier _ b c _) = setVertPoints x y $ InterBezier c b + vertOrdered (R.CubicBezier _ b c _) = setVertPoints (x + 1) y $ InterBezier b c + + +gatherColors :: MeshGradient -> Int -> Int -> V.Vector PixelRGBA8 +gatherColors mesh w h = baseVec // foldMap goRow (zip [0 ..] $ _meshGradientRows mesh) where + baseVec = V.replicate ((w + 1) * (h + 1)) $ PixelRGBA8 0 0 0 255 + + goRow (y, row) = foldMap (goPatch y) . zip [0 ..] $ _meshGradientRowPatches row + + goPatch y (x, patch) = case _meshGradientPatchStops patch of + -- A B + -- +---+ + -- | | + -- +---+ + -- D C + [a, b, c, d] -> + [setAt 0 0 a, setAt 1 0 b, setAt 1 1 c, setAt 0 1 d] + -- A B + -- +---+ + -- | + -- +---+ + -- C + [_a, b, c] | y == 0 -> [setAt 1 0 b, setAt 1 1 c] + -- B + -- + + + -- | | + -- +---+ + -- D C + [_b, c, d] -> [setAt 1 1 c, setAt 0 1 d] + -- B + -- + + -- | + -- +---+ + -- C + [_b, c] -> [setAt 1 1 c] + + _ -> [] + where + colorOf s = case _gradientOpacity s of + Nothing -> _gradientColor s + Just a -> PixelRGBA8 r g b . floor $ 255 * a + where + PixelRGBA8 r g b _ = _gradientColor s + + + setAt dx dy stop = (idx, colorOf stop) where + idx = (y + dy) * (w + 1) + x + dx + + +svgMeshSize :: MeshGradient -> (Int, Int) +svgMeshSize mesh = (w, h) where + h = length $ _meshGradientRows mesh + w = maximum $ length . _meshGradientRowPatches <$> _meshGradientRows mesh + +svgPathToPrimitives :: R.Point -> R.Point -> GradientPathCommand -> R.CubicBezier +svgPathToPrimitives firstPatchPoint = go where + go o GClose = o `straightLine` firstPatchPoint + go o (GLine OriginRelative c) = o `straightLine` (o ^+^ mp c) + go o (GLine OriginAbsolute p) = o `straightLine` mp p + go o (GCurve OriginAbsolute c1 c2 e) = + R.CubicBezier o (toR c1) (toR c2) (mp e) + go o (GCurve OriginRelative c1 c2 e) = + R.CubicBezier o (o ^+^ toR c1) (o ^+^ toR c2) (o ^+^ mp e) + + mp Nothing = firstPatchPoint + mp (Just p) = toR p + +toR :: RPoint -> R.Point +{-# INLINE toR #-} +toR (L.V2 x y) = realToFrac <$> R.V2 x y + +straightLine :: R.Point -> R.Point -> R.CubicBezier +straightLine a b = R.CubicBezier a p1 p2 b where + p1 = lerp (1/3) a b + p2 = lerp (2/3) a b diff --git a/src/Graphics/Rasterific/Svg/RasterificRender.hs b/src/Graphics/Rasterific/Svg/RasterificRender.hs --- a/src/Graphics/Rasterific/Svg/RasterificRender.hs +++ b/src/Graphics/Rasterific/Svg/RasterificRender.hs @@ -51,6 +51,7 @@ import Graphics.Rasterific.Svg.PathConverter import Graphics.Rasterific.Svg.RenderContext import Graphics.Rasterific.Svg.RasterificTextRendering +import Graphics.Rasterific.Svg.MeshConverter {-import Debug.Trace-} {-import Text.Groom-} @@ -557,6 +558,15 @@ [ MoveTo OriginAbsolute [x] , LineTo OriginAbsolute xs ] + + go ctxt attr (MeshGradientTree mesh) = + return $ do + R.renderMeshPatch interp rasterificMesh + where + rasterificMesh = convertGradientMesh mempty mempty mesh + interp = case _meshGradientType mesh of + GradientBilinear -> R.PatchBilinear + GradientBicubic -> R.PatchBicubic go ctxt attr (PolygonTree (Polygon pAttr points)) = go ctxt attr . PathTree . Path pAttr $ toPath points diff --git a/src/Graphics/Rasterific/Svg/RenderContext.hs b/src/Graphics/Rasterific/Svg/RenderContext.hs --- a/src/Graphics/Rasterific/Svg/RenderContext.hs +++ b/src/Graphics/Rasterific/Svg/RenderContext.hs @@ -11,6 +11,7 @@ , joinOfSvg , stripUnits , boundingBoxLength + , boundbingBoxLinearise , lineariseXLength , lineariseYLength , linearisePoint @@ -41,6 +42,7 @@ import qualified Graphics.Rasterific.Texture as RT import Graphics.Text.TrueType import Graphics.Svg.Types +import Graphics.Rasterific.Svg.MeshConverter toRadian :: Floating a => a -> a toRadian v = v / 180 * pi @@ -65,6 +67,10 @@ mappend (LoadedElements a b) (LoadedElements a' b') = LoadedElements (a `mappend` a') (b `mappend` b') +globalBounds :: RenderContext -> R.PlaneBound +globalBounds RenderContext { _renderViewBox = (p1, p2) } = + R.PlaneBound p1 p2 + loadedFonts :: Lens' LoadedElements (M.Map FilePath Font) loadedFonts = lens _loadedFonts (\a b -> a { _loadedFonts = b }) @@ -177,6 +183,20 @@ lineariseLength ctxt attr num = lineariseLength ctxt attr $ stripUnits ctxt num +prepareGradientMeshTexture + :: RenderContext -> DrawAttributes + -> MeshGradient -> [R.Primitive] + -> R.Texture PixelRGBA8 +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 + interp = case _meshGradientType mesh of + GradientBilinear -> R.PatchBilinear + GradientBicubic -> R.PatchBicubic + in + RT.meshPatchTexture interp $ convertGradientMesh (globalBounds ctxt) bounds mesh' + prepareLinearGradientTexture :: RenderContext -> DrawAttributes -> LinearGradient -> Float -> [R.Primitive] @@ -186,9 +206,10 @@ lineariser = case _linearGradientUnits grad of CoordUserSpace -> linearisePoint ctxt attr CoordBoundingBox -> boundbingBoxLinearise ctxt attr bounds + toA = maybe 1 id gradient = - [(offset, fillAlphaCombine opa color) - | GradientStop offset color <- _linearGradientStops grad] + [(offset, fillAlphaCombine (opa * toA opa2) color) + | GradientStop offset color _ opa2 <- _linearGradientStops grad] startPoint = lineariser $ _linearGradientStart grad stopPoint = lineariser $ _linearGradientStop grad in @@ -206,9 +227,10 @@ CoordBoundingBox -> (boundbingBoxLinearise ctxt attr bounds, boundingBoxLength ctxt attr bounds) + toA = maybe 1 id gradient = - [(offset, fillAlphaCombine opa color) - | GradientStop offset color <- _radialGradientStops grad] + [(offset, fillAlphaCombine (opa * toA opa2) color) + | GradientStop offset color _ opa2 <- _radialGradientStops grad] center = lineariser $ _radialGradientCenter grad radius = lengthLinearise $ _radialGradientRadius grad in @@ -266,6 +288,8 @@ prepare (ElementMarker _) = return Nothing prepare (ElementMask _) = return Nothing prepare (ElementClipPath _) = return Nothing + prepare (ElementMeshGradient mesh) = + return . Just $ prepareGradientMeshTexture ctxt attr mesh prims prepare (ElementLinearGradient grad) = return . Just $ prepareLinearGradientTexture ctxt attr grad opacity prims