rasterific-svg 0.3.3.1 → 0.3.3.2
raw patch · 4 files changed
+399/−394 lines, 4 filesdep ~JuicyPixelsdep ~basedep ~lensPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: JuicyPixels, base, lens, mtl, optparse-applicative, transformers
API changes (from Hackage documentation)
Files
- changelog.md +5/−0
- rasterific-svg.cabal +4/−4
- src/Graphics/Rasterific/Svg.hs +144/−144
- src/Graphics/Rasterific/Svg/MeshConverter.hs +246/−246
changelog.md view
@@ -1,6 +1,11 @@ Change log ========== +v0.3.3.2 October 2018 +--------------------- + + * GHC 8.6 version bump + v0.3.3.1 March 2018 -------------------
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.3.1 +version: 0.3.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.3.1 + Tag: v0.3.3.2 library hs-source-dirs: src @@ -43,13 +43,13 @@ -- provide/emulate `Control.Monad.Fail` and `Data.Semigroups` API for pre-GHC8 build-depends: fail == 4.9.*, semigroups == 0.18.* - build-depends: base >= 4.5 && < 5 + build-depends: base >= 4.5 && < 6 , directory , bytestring >= 0.10 , filepath , binary >= 0.7 , scientific >= 0.3 - , JuicyPixels >= 3.2 && < 3.3 + , JuicyPixels >= 3.2 , containers >= 0.5 , Rasterific >= 0.7 && < 0.8 , FontyFruity >= 0.5.2.1 && < 0.6
src/Graphics/Rasterific/Svg.hs view
@@ -1,144 +1,144 @@--- | Svg renderer based on Rasterific.------ Here is a simple example of loading a SVG file (using svg-tree)--- rendering it to a picture, and saving it to a PNG (using Juicy.Pixels)------ @--- import Codec.Picture( writePng )--- import Graphics.Svg( loadSvgFile )--- import Graphics.Rasterific.Svg( loadCreateFontCache--- , renderSvgDocument--- )--- loadRender :: FilePath -> FilePath -> IO ()--- loadRender svgfilename pngfilename = do--- f <- loadSvgFile svgfilename--- case f of--- Nothing -> putStrLn "Error while loading SVG"--- Just doc -> do--- cache <- loadCreateFontCache "fonty-texture-cache"--- (finalImage, _) <- renderSvgDocument cache Nothing 96 doc--- writePng pngfilename finalImage--- @----module Graphics.Rasterific.Svg- ( -- * Main functions- drawingOfSvgDocument- , renderSvgDocument- , pdfOfSvgDocument- , loadCreateFontCache- -- * Types- , LoadedElements( .. )- , Result( .. )- , DrawResult( .. )- , Dpi- -- * Other helper functions- , renderSvgFile- ) where--import qualified Data.ByteString.Lazy as B-import Graphics.Rasterific.Svg.RasterificRender( DrawResult( .. ) )-import qualified Graphics.Rasterific.Svg.RasterificRender as RR-import Data.Binary( encodeFile, decodeOrFail )-import Graphics.Svg.Types hiding ( Dpi )-import Graphics.Svg hiding ( Dpi )-import Graphics.Rasterific.Svg.RenderContext--import System.Directory( doesFileExist )-import Graphics.Text.TrueType---import qualified Codec.Picture as CP-import Codec.Picture( PixelRGBA8( .. )- , writePng )--{-import Graphics.Svg.CssParser-}---- | Render an svg document to an image.--- If you provide a size, the document will be stretched to--- match the provided size.------ The DPI parameter really should depend of your screen, but--- a good default value is 96------ The use of the IO Monad is there to allow loading of fonts--- and referenced images.-renderSvgDocument :: FontCache -- ^ Structure used to access fonts- -> Maybe (Int, Int) -- ^ Optional document size- -> Dpi -- ^ Current resolution for text and elements- -> Document -- ^ Svg document- -> IO (CP.Image PixelRGBA8, LoadedElements)-renderSvgDocument cache size dpi =- RR.renderSvgDocument cache size dpi . applyCSSRules . resolveUses--pdfOfSvgDocument :: FontCache -> Maybe (Int, Int) -> Dpi -> Document- -> IO (B.ByteString, LoadedElements)-pdfOfSvgDocument cache sizes dpi =- RR.pdfOfSvgDocument cache sizes dpi . applyCSSRules . resolveUses---- | Render an svg document to a Rasterific Drawing.--- If you provide a size, the document will be stretched to--- match the provided size.------ The DPI parameter really should depend of your screen, but--- a good default value is 96------ The use of the IO Monad is there to allow loading of fonts--- and referenced images.-drawingOfSvgDocument :: FontCache -- ^ Structure used to access fonts- -> Maybe (Int, Int) -- ^ Optional document size- -> Dpi -- ^ Current resolution for text and elements- -> Document -- ^ Svg document- -> IO (DrawResult, LoadedElements)-drawingOfSvgDocument cache size dpi =- RR.drawingOfSvgDocument cache size dpi . applyCSSRules . resolveUses---- | Rendering status.-data Result- = ResultSuccess -- ^ No problem found- | ResultError String -- ^ Error with message- deriving (Eq, Show)---- | Convert an SVG file to a PNG file, return True--- if the operation went without problems.--- --- This function will call loadCreateFontCache with--- the filename "fonty-texture-cache"-renderSvgFile :: FilePath -> FilePath -> IO Result-renderSvgFile svgfilename pngfilename = do- f <- loadSvgFile svgfilename- case f of- Nothing -> return $ ResultError "Error while loading SVG"- Just doc -> do- cache <- loadCreateFontCache "fonty-texture-cache"- (finalImage, _) <- renderSvgDocument cache Nothing 96 doc- writePng pngfilename finalImage- return ResultSuccess---- | This function will create a font cache,--- a structure allowing to quickly match a font--- family name and style to a specific true type font--- on disk.------ The cache is saved on disk at the filepath given--- as parameter. If a cache is found it is automatically--- loaded from the file.------ Creating the cache is a rather long operation (especially--- on Windows), that's why you may want to keep the cache--- around.-loadCreateFontCache :: FilePath -> IO FontCache-loadCreateFontCache filename = do- exist <- doesFileExist filename- if exist then loadCache else createWrite- where- loadCache = do- bstr <- B.readFile filename- case decodeOrFail bstr of- Left _ -> createWrite- Right (_, _, v) -> return v- - createWrite = do- cache <- buildCache- encodeFile filename cache- return cache-+-- | Svg renderer based on Rasterific. +-- +-- Here is a simple example of loading a SVG file (using svg-tree) +-- rendering it to a picture, and saving it to a PNG (using Juicy.Pixels) +-- +-- @ +-- import Codec.Picture( writePng ) +-- import Graphics.Svg( loadSvgFile ) +-- import Graphics.Rasterific.Svg( loadCreateFontCache +-- , renderSvgDocument +-- ) +-- loadRender :: FilePath -> FilePath -> IO () +-- loadRender svgfilename pngfilename = do +-- f <- loadSvgFile svgfilename +-- case f of +-- Nothing -> putStrLn "Error while loading SVG" +-- Just doc -> do +-- cache <- loadCreateFontCache "fonty-texture-cache" +-- (finalImage, _) <- renderSvgDocument cache Nothing 96 doc +-- writePng pngfilename finalImage +-- @ +-- +module Graphics.Rasterific.Svg + ( -- * Main functions + drawingOfSvgDocument + , renderSvgDocument + , pdfOfSvgDocument + , loadCreateFontCache + -- * Types + , LoadedElements( .. ) + , Result( .. ) + , DrawResult( .. ) + , Dpi + -- * Other helper functions + , renderSvgFile + ) where + +import qualified Data.ByteString.Lazy as B +import Graphics.Rasterific.Svg.RasterificRender( DrawResult( .. ) ) +import qualified Graphics.Rasterific.Svg.RasterificRender as RR +import Data.Binary( encodeFile, decodeOrFail ) +import Graphics.Svg.Types hiding ( Dpi ) +import Graphics.Svg hiding ( Dpi ) +import Graphics.Rasterific.Svg.RenderContext + +import System.Directory( doesFileExist ) +import Graphics.Text.TrueType + + +import qualified Codec.Picture as CP +import Codec.Picture( PixelRGBA8( .. ) + , writePng ) + +{-import Graphics.Svg.CssParser-} + +-- | Render an svg document to an image. +-- If you provide a size, the document will be stretched to +-- match the provided size. +-- +-- The DPI parameter really should depend of your screen, but +-- a good default value is 96 +-- +-- The use of the IO Monad is there to allow loading of fonts +-- and referenced images. +renderSvgDocument :: FontCache -- ^ Structure used to access fonts + -> Maybe (Int, Int) -- ^ Optional document size + -> Dpi -- ^ Current resolution for text and elements + -> Document -- ^ Svg document + -> IO (CP.Image PixelRGBA8, LoadedElements) +renderSvgDocument cache size dpi = + RR.renderSvgDocument cache size dpi . applyCSSRules . resolveUses + +pdfOfSvgDocument :: FontCache -> Maybe (Int, Int) -> Dpi -> Document + -> IO (B.ByteString, LoadedElements) +pdfOfSvgDocument cache sizes dpi = + RR.pdfOfSvgDocument cache sizes dpi . applyCSSRules . resolveUses + +-- | Render an svg document to a Rasterific Drawing. +-- If you provide a size, the document will be stretched to +-- match the provided size. +-- +-- The DPI parameter really should depend of your screen, but +-- a good default value is 96 +-- +-- The use of the IO Monad is there to allow loading of fonts +-- and referenced images. +drawingOfSvgDocument :: FontCache -- ^ Structure used to access fonts + -> Maybe (Int, Int) -- ^ Optional document size + -> Dpi -- ^ Current resolution for text and elements + -> Document -- ^ Svg document + -> IO (DrawResult, LoadedElements) +drawingOfSvgDocument cache size dpi = + RR.drawingOfSvgDocument cache size dpi . applyCSSRules . resolveUses + +-- | Rendering status. +data Result + = ResultSuccess -- ^ No problem found + | ResultError String -- ^ Error with message + deriving (Eq, Show) + +-- | Convert an SVG file to a PNG file, return True +-- if the operation went without problems. +-- +-- This function will call loadCreateFontCache with +-- the filename "fonty-texture-cache" +renderSvgFile :: FilePath -> FilePath -> IO Result +renderSvgFile svgfilename pngfilename = do + f <- loadSvgFile svgfilename + case f of + Nothing -> return $ ResultError "Error while loading SVG" + Just doc -> do + cache <- loadCreateFontCache "fonty-texture-cache" + (finalImage, _) <- renderSvgDocument cache Nothing 96 doc + writePng pngfilename finalImage + return ResultSuccess + +-- | This function will create a font cache, +-- a structure allowing to quickly match a font +-- family name and style to a specific true type font +-- on disk. +-- +-- The cache is saved on disk at the filepath given +-- as parameter. If a cache is found it is automatically +-- loaded from the file. +-- +-- Creating the cache is a rather long operation (especially +-- on Windows), that's why you may want to keep the cache +-- around. +loadCreateFontCache :: FilePath -> IO FontCache +loadCreateFontCache filename = do + exist <- doesFileExist filename + if exist then loadCache else createWrite + where + loadCache = do + bstr <- B.readFile filename + case decodeOrFail bstr of + Left _ -> createWrite + Right (_, _, v) -> return v + + createWrite = do + cache <- buildCache + encodeFile filename cache + return cache +
src/Graphics/Rasterific/Svg/MeshConverter.hs view
@@ -1,246 +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+{-# 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