Copyright | Written by David Himmelstrup |
---|---|
License | Unlicense |
Maintainer | lemmih@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- lowerTransformations :: SVG -> SVG
- lowerIds :: SVG -> SVG
- clearDrawAttributes :: SVG -> SVG
- simplify :: SVG -> SVG
- removeGroups :: SVG -> [SVG]
- extractPath :: SVG -> [PathCommand]
- withSubglyphs :: [Int] -> (SVG -> SVG) -> SVG -> SVG
- splitGlyphs :: [Int] -> SVG -> (SVG, SVG)
- svgGlyphs :: SVG -> [(SVG -> SVG, DrawAttributes, SVG)]
- pathify :: SVG -> SVG
- mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
- mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
- mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
- svgPointsToRadians :: SVG -> SVG
- module Reanimate.Svg.Constructors
- module Reanimate.Svg.LineCommand
- boundingBox :: Tree -> (Double, Double, Double, Double)
- svgHeight :: Tree -> Double
- svgWidth :: Tree -> Double
- replaceUses :: Document -> Document
- unbox :: Document -> Tree
- unboxFit :: Document -> Tree
- embedDocument :: Document -> Tree
Documentation
lowerTransformations :: SVG -> SVG Source #
Remove transformations (such as translations, rotations, scaling) and apply them directly to the SVG nodes. Note, this function may convert nodes (such as Circle or Rect) to paths. Also note that does change how the SVG is rendered. Particularly, stroke width is affected by directly applying scaling.
lowerTransformations (scale 2 (mkCircle 1)) = mkCircle 2
clearDrawAttributes :: SVG -> SVG Source #
Remove all draw attributes such as stroke
, fill
and 'fill-opacity'.
removeGroups :: SVG -> [SVG] Source #
Separate grouped items. This is required by clip nodes.
removeGroups (withFillColor "blue" $ mkGroup [mkCircle 1, mkRect 1 1]) = [ withFillColor "blue" $ mkCircle 1 , withFillColor "blue" $ mkRect 1 1 ]
extractPath :: SVG -> [PathCommand] Source #
Extract all path commands from a node (and its children) and concatenate them.
withSubglyphs :: [Int] -> (SVG -> SVG) -> SVG -> SVG Source #
Map over indexed symbols.
withSubglyphs [0,2] (scale 2) (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2]) = mkGroup [scale 2 (mkCircle 1), mkRect 2, scale 2 (mkEllipse 1 2)]
splitGlyphs :: [Int] -> SVG -> (SVG, SVG) Source #
Split symbols.
splitGlyphs [0,2] (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2]) = ([mkRect 2], [mkCircle 1, mkEllipse 1 2])
svgGlyphs :: SVG -> [(SVG -> SVG, DrawAttributes, SVG)] Source #
Split symbols and include their context and drawing attributes.
pathify :: SVG -> SVG Source #
Convert primitive SVG shapes (like those created by mkCircle
, mkRect
, mkLine
or
mkEllipse
) into SVG path. This can be useful for creating animations of these shapes being
drawn progressively with partialSvg
.
Example:
pathifyExample :: Animation pathifyExample = animate $ \t -> gridLayout [ [ partialSvg t $ pathify $ mkCircle 1 , partialSvg t $ pathify $ mkRect 2 2 ] , [ partialSvg t $ pathify $ mkEllipse 1 0.5 , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1) ] ]
mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG Source #
Map over all recursively-found path commands.
mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG Source #
Map over all recursively-found line commands.
svgPointsToRadians :: SVG -> SVG Source #
Convert coordinate system from degrees to radians.
module Reanimate.Svg.Constructors
module Reanimate.Svg.LineCommand
boundingBox :: Tree -> (Double, Double, Double, Double) Source #
Return bounding box of SVG tree. The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
Note: Bounding boxes are computed on a best-effort basis and will not work in all cases. The only supported SVG nodes are: path, circle, polyline, ellipse, line, rectangle, image and svg. All other nodes return (0,0,0,0). The box for the svg node is based on the document's width and height (if both are present).
svgHeight :: Tree -> Double Source #
Height of SVG node in local units (not pixels). Computed on best-effort basis and will not give accurate results for all SVG nodes.