packages feed

rasterific-svg 0.3.1.2 → 0.3.2

raw patch · 7 files changed

+317/−13 lines, 7 filesdep +primitivedep ~Rasterificdep ~bytestringdep ~svg-tree

Dependencies added: primitive

Dependency ranges changed: Rasterific, bytestring, svg-tree

Files

README.md view
@@ -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. 
changelog.md view
@@ -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
exec-src/svgrender.hs view
@@ -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
rasterific-svg.cabal view
@@ -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
+ src/Graphics/Rasterific/Svg/MeshConverter.hs view
@@ -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
src/Graphics/Rasterific/Svg/RasterificRender.hs view
@@ -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
src/Graphics/Rasterific/Svg/RenderContext.hs view
@@ -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