svg-tree 0.4.2 → 0.5
raw patch · 5 files changed
+192/−64 lines, 5 files
Files
- changelog +4/−0
- src/Graphics/Svg/CssTypes.hs +2/−3
- src/Graphics/Svg/Types.hs +111/−56
- src/Graphics/Svg/XmlParser.hs +72/−2
- svg-tree.cabal +3/−3
changelog view
@@ -1,5 +1,9 @@ -*-change-log-*- +v0.5: March 2016:+ * Adding: preserveAspectRatio attribute+ * Fix: Application of CSS rules with indirect parent/child relation.+ v0.4.2: March 2016 * Enhancement: avoiding serializatinon of empty class attribute * Fix: incorrect deserialization of complex CSS
src/Graphics/Svg/CssTypes.hs view
@@ -31,7 +31,6 @@ import Text.Printf import Codec.Picture( PixelRGBA8( .. ) )-{-import Debug.Trace-} -- | Alias describing a "dot per inch" information -- used for size calculation (see toUserUnit).@@ -149,9 +148,9 @@ go ((e:_):upper) (DirectChildren:AllOf descr:rest) | isDescribedBy e descr = go upper rest go _ (DirectChildren:_) = False- go ((e:_):upper) (AllOf descr : rest)+ go ((e:_):upper) selectors@(AllOf descr : rest) | isDescribedBy e descr = go upper rest- | otherwise = False+ | otherwise = go upper selectors go (_:upper) selector = go upper selector -- | Given CSS rules, find all the declaration to apply to the
src/Graphics/Svg/Types.hs view
@@ -152,6 +152,12 @@ , ClipPath( .. ) , HasClipPath( .. ) + -- * Aspect Ratio description+ , PreserveAspectRatio( .. )+ , Alignment( .. )+ , MeetSlice( .. )+ , HasPreserveAspectRatio( .. )+ -- * MISC functions , isPathArc , isPathWithArc@@ -209,25 +215,25 @@ -- | Path command definition. data PathCommand -- | 'M' or 'm' command- = MoveTo Origin [RPoint]+ = MoveTo !Origin ![RPoint] -- | Line to, 'L' or 'l' Svg path command.- | LineTo Origin [RPoint]+ | LineTo !Origin ![RPoint] -- | Equivalent to the 'H' or 'h' svg path command.- | HorizontalTo Origin [Coord]+ | HorizontalTo !Origin ![Coord] -- | Equivalent to the 'V' or 'v' svg path command.- | VerticalTo Origin [Coord]+ | VerticalTo !Origin ![Coord] -- | Cubic bezier, 'C' or 'c' command- | CurveTo Origin [(RPoint, RPoint, RPoint)]+ | CurveTo !Origin ![(RPoint, RPoint, RPoint)] -- | Smooth cubic bezier, equivalent to 'S' or 's' command- | SmoothCurveTo Origin [(RPoint, RPoint)]+ | SmoothCurveTo !Origin ![(RPoint, RPoint)] -- | Quadratic bezier, 'Q' or 'q' command- | QuadraticBezier Origin [(RPoint, RPoint)]+ | QuadraticBezier !Origin ![(RPoint, RPoint)] -- | Quadratic bezier, 'T' or 't' command- | SmoothQuadraticBezierCurveTo Origin [RPoint]+ | SmoothQuadraticBezierCurveTo !Origin ![RPoint] -- | Eliptical arc, 'A' or 'a' command.- | EllipticalArc Origin [(Coord, Coord, Coord, Bool, Bool, RPoint)]+ | EllipticalArc !Origin ![(Coord, Coord, Coord, Bool, Bool, RPoint)] -- | Close the path, 'Z' or 'z' svg path command. | EndPath deriving (Eq, Show)@@ -245,7 +251,44 @@ isPathWithArc :: Foldable f => f PathCommand -> Bool isPathWithArc = F.any isPathArc +-- | This type represent the align information of the+-- preserveAspectRatio SVGattribute+data Alignment+ = AlignNone -- ^ "none" value+ | AlignxMinYMin -- "xMinYMin" value+ | AlignxMidYMin -- ^ "xMidYMin" value+ | AlignxMaxYMin -- ^ "xMaxYMin" value+ | AlignxMinYMid -- ^ "xMinYMid" value+ | AlignxMidYMid -- ^ "xMidYMid" value+ | AlignxMaxYMid -- ^ "xMaxYMid" value+ | AlignxMinYMax -- ^ "xMinYMax" value+ | AlignxMidYMax -- ^ "xMidYMax" value+ | AlignxMaxYMax -- ^ "xMaxYMax" value+ deriving (Eq, Show) +-- | This type represent the "meet or slice" information+-- of the preserveAspectRatio SVGattribute+data MeetSlice = Meet | Slice+ deriving (Eq, Show)++-- | Describe the content of the preserveAspectRatio attribute.+data PreserveAspectRatio = PreserveAspectRatio+ { _aspectRatioDefer :: !Bool+ , _aspectRatioAlign :: !Alignment+ , _aspectRatioMeetSlice :: !(Maybe MeetSlice)+ }+ deriving (Eq, Show)++-- | Lenses for the PreserveAspectRatio type+makeClassy ''PreserveAspectRatio ++instance WithDefaultSvg PreserveAspectRatio where+ defaultSvg = PreserveAspectRatio + { _aspectRatioDefer = False+ , _aspectRatioAlign = AlignxMidYMid+ , _aspectRatioMeetSlice = Nothing+ }+ -- | Describe how the line should be terminated -- when stroking them. Describe the values of the -- `stroke-linecap` attribute.@@ -284,19 +327,19 @@ -- see `_transform` and `transform`. data Transformation = -- | Directly encode the translation matrix.- TransformMatrix Coord Coord Coord- Coord Coord Coord+ TransformMatrix !Coord !Coord !Coord+ !Coord !Coord !Coord -- | Translation along a vector- | Translate Double Double+ | Translate !Double !Double -- | Scaling on both axis or on X axis and Y axis.- | Scale Double (Maybe Double)+ | Scale !Double !(Maybe Double) -- | Rotation around `(0, 0)` or around an optional -- point.- | Rotate Double (Maybe (Double, Double))+ | Rotate !Double !(Maybe (Double, Double)) -- | Skew transformation along the X axis.- | SkewX Double+ | SkewX !Double -- | Skew transformation along the Y axis.- | SkewY Double+ | SkewY !Double -- | Unkown transformation, like identity. | TransformUnknown deriving (Eq, Show)@@ -461,11 +504,11 @@ -- segments. Correspond to the `<polyline>` tag. data PolyLine = PolyLine { -- | drawing attributes of the polyline.- _polyLineDrawAttributes :: DrawAttributes+ _polyLineDrawAttributes :: !DrawAttributes -- | Geometry definition of the polyline. -- correspond to the `points` attribute- , _polyLinePoints :: [RPoint]+ , _polyLinePoints :: ![RPoint] } deriving (Eq, Show) @@ -487,10 +530,10 @@ -- tag data Polygon = Polygon { -- | Drawing attributes for the polygon.- _polygonDrawAttributes :: DrawAttributes+ _polygonDrawAttributes :: !DrawAttributes -- | Points of the polygon. Correspond to -- the `points` attributes.- , _polygonPoints :: [RPoint]+ , _polygonPoints :: ![RPoint] } deriving (Eq, Show) @@ -510,13 +553,13 @@ -- `<line>` tag. data Line = Line { -- | Drawing attributes of line.- _lineDrawAttributes :: DrawAttributes+ _lineDrawAttributes :: !DrawAttributes -- | First point of the the line, correspond -- to the `x1` and `y1` attributes.- , _linePoint1 :: Point+ , _linePoint1 :: !Point -- | Second point of the the line, correspond -- to the `x2` and `y2` attributes.- , _linePoint2 :: Point+ , _linePoint2 :: !Point } deriving (Eq, Show) @@ -538,20 +581,20 @@ -- `<rectangle>` svg tag. data Rectangle = Rectangle { -- | Rectangle drawing attributes.- _rectDrawAttributes :: DrawAttributes+ _rectDrawAttributes :: !DrawAttributes -- | Upper left corner of the rectangle, correspond -- to the attributes `x` and `y`.- , _rectUpperLeftCorner :: Point+ , _rectUpperLeftCorner :: !Point -- | Rectangle width, correspond, strangely, to -- the `width` attribute.- , _rectWidth :: Number+ , _rectWidth :: !Number -- | Rectangle height, correspond, amazingly, to -- the `height` attribute.- , _rectHeight :: Number+ , _rectHeight :: !Number -- | Define the rounded corner radius radius -- of the rectangle. Correspond to the `rx` and -- `ry` attributes.- , _rectCornerRadius :: (Number, Number)+ , _rectCornerRadius :: !(Number, Number) } deriving (Eq, Show) @@ -573,10 +616,10 @@ -- | Type mapping the `<path>` svg tag. data Path = Path { -- | Drawing attributes of the path.- _pathDrawAttributes :: DrawAttributes+ _pathDrawAttributes :: !DrawAttributes -- | Definition of the path, correspond to the -- `d` attributes.- , _pathDefinition :: [PathCommand]+ , _pathDefinition :: ![PathCommand] } deriving (Eq, Show) @@ -602,6 +645,8 @@ , _groupChildren :: ![a] -- | Mapped to the attribute `viewBox` , _groupViewBox :: !(Maybe (Double, Double, Double, Double))+ -- | used for symbols only+ , _groupAspectRatio :: !PreserveAspectRatio } deriving (Eq, Show) @@ -616,6 +661,7 @@ { _groupDrawAttributes = mempty , _groupChildren = [] , _groupViewBox = Nothing+ , _groupAspectRatio = defaultSvg } -- | Define the `<symbol>` tag, equivalent to@@ -636,13 +682,13 @@ -- | Define a `<circle>`. data Circle = Circle { -- | Drawing attributes of the circle.- _circleDrawAttributes :: DrawAttributes+ _circleDrawAttributes :: !DrawAttributes -- | Define the center of the circle, describe -- the `cx` and `cy` attributes.- , _circleCenter :: Point+ , _circleCenter :: !Point -- | Radius of the circle, equivalent to the `r` -- attribute.- , _circleRadius :: Number+ , _circleRadius :: !Number } deriving (Eq, Show) @@ -662,16 +708,16 @@ -- | Define an `<ellipse>` data Ellipse = Ellipse { -- | Drawing attributes of the ellipse.- _ellipseDrawAttributes :: DrawAttributes+ _ellipseDrawAttributes :: !DrawAttributes -- | Center of the ellipse, map to the `cx` -- and `cy` attributes.- , _ellipseCenter :: Point+ , _ellipseCenter :: !Point -- | Radius along the X axis, map the -- `rx` attribute.- , _ellipseXRadius :: Number+ , _ellipseXRadius :: !Number -- | Radius along the Y axis, map the -- `ry` attribute.- , _ellipseYRadius :: Number+ , _ellipseYRadius :: !Number } deriving (Eq, Show) @@ -692,16 +738,18 @@ -- | Define an `<image>` tag. data Image = Image { -- | Drawing attributes of the image- _imageDrawAttributes :: DrawAttributes+ _imageDrawAttributes :: !DrawAttributes -- | Position of the image referenced by its -- upper left corner.- , _imageCornerUpperLeft :: Point+ , _imageCornerUpperLeft :: !Point -- | Image width- , _imageWidth :: Number+ , _imageWidth :: !Number -- | Image Height- , _imageHeight :: Number+ , _imageHeight :: !Number -- | Image href, pointing to the real image.- , _imageHref :: String+ , _imageHref :: !String+ -- | preserveAspectRatio attribute+ , _imageAspectRatio :: !PreserveAspectRatio } deriving (Eq, Show) @@ -718,6 +766,7 @@ , _imageWidth = Num 0 , _imageHeight = Num 0 , _imageHref = ""+ , _imageAspectRatio = defaultSvg } -- | Define an `<use>` for a named content.@@ -941,21 +990,23 @@ _markerDrawAttributes :: DrawAttributes -- | Define the reference point of the marker. -- correspond to the `refX` and `refY` attributes.- , _markerRefPoint :: (Number, Number)+ , _markerRefPoint :: !(Number, Number) -- | Define the width of the marker. Correspond to -- the `markerWidth` attribute.- , _markerWidth :: Maybe Number+ , _markerWidth :: !(Maybe Number) -- | Define the height of the marker. Correspond to -- the `markerHeight` attribute.- , _markerHeight :: Maybe Number+ , _markerHeight :: !(Maybe Number) -- | Correspond to the `orient` attribute.- , _markerOrient :: Maybe MarkerOrientation+ , _markerOrient :: !(Maybe MarkerOrientation) -- | Map the `markerUnits` attribute.- , _markerUnits :: Maybe MarkerUnit+ , _markerUnits :: !(Maybe MarkerUnit) -- | Optional viewbox- , _markerViewBox :: !(Maybe (Double, Double, Double, Double))+ , _markerViewBox :: !(Maybe (Double, Double, Double, Double)) -- | Elements defining the marker.- , _markerOverflow :: !(Maybe Overflow)+ , _markerOverflow :: !(Maybe Overflow)+ -- | preserveAspectRatio attribute+ , _markerAspectRatio :: !PreserveAspectRatio -- | Elements defining the marker. , _markerElements :: [Tree] }@@ -978,6 +1029,7 @@ , _markerViewBox = Nothing , _markerOverflow = Nothing , _markerElements = mempty+ , _markerAspectRatio = defaultSvg } -- | Insert element in the first sublist in the list of list.@@ -1298,24 +1350,26 @@ -- | Define a `<pattern>` tag. data Pattern = Pattern { -- | Pattern drawing attributes.- _patternDrawAttributes :: DrawAttributes+ _patternDrawAttributes :: !DrawAttributes -- | Possible `viewBox`.- , _patternViewBox :: Maybe (Double, Double, Double, Double)+ , _patternViewBox :: !(Maybe (Double, Double, Double, Double)) -- | Width of the pattern tile, mapped to the -- `width` attribute- , _patternWidth :: Number+ , _patternWidth :: !Number -- | Height of the pattern tile, mapped to the -- `height` attribute- , _patternHeight :: Number+ , _patternHeight :: !Number -- | Pattern tile base, mapped to the `x` and -- `y` attributes.- , _patternPos :: Point+ , _patternPos :: !Point -- | Elements used in the pattern.- , _patternElements :: [Tree]+ , _patternElements :: ![Tree] -- | Define the cordinate system to use for -- the pattern. Mapped to the `patternUnits` -- attribute.- , _patternUnit :: CoordinateUnits+ , _patternUnit :: !CoordinateUnits+ -- | Value of the "preserveAspectRatio" attribute+ , _patternAspectRatio :: !PreserveAspectRatio } deriving Show @@ -1334,6 +1388,7 @@ , _patternElements = [] , _patternUnit = CoordBoundingBox , _patternDrawAttributes = mempty+ , _patternAspectRatio = defaultSvg } -- | Sum types helping keeping track of all the namable
src/Graphics/Svg/XmlParser.hs view
@@ -28,7 +28,7 @@ import Control.Lens hiding( transform, children, elements, element ) import Control.Monad.State.Strict( State, runState, modify, gets )-import Data.Maybe( catMaybes )+import Data.Maybe( fromMaybe, catMaybes ) import Data.Monoid( Last( Last ), getLast, (<>) ) import Data.List( foldl', intercalate ) import Text.XML.Light.Proc( findAttrBy, elChildren, strContent )@@ -122,6 +122,71 @@ aparse = parse $ many transformParser aserialize = Just . serializeTransformations +instance ParseableAttribute Alignment where+ aparse s = Just $ case s of+ "none" -> AlignNone + "xMinYMin" -> AlignxMinYMin+ "xMidYMin" -> AlignxMidYMin+ "xMaxYMin" -> AlignxMaxYMin+ "xMinYMid" -> AlignxMinYMid+ "xMidYMid" -> AlignxMidYMid+ "xMaxYMid" -> AlignxMaxYMid+ "xMinYMax" -> AlignxMinYMax+ "xMidYMax" -> AlignxMidYMax+ "xMaxYMax" -> AlignxMaxYMax+ _ -> _aspectRatioAlign defaultSvg++ aserialize v = Just $ case v of+ AlignNone -> "none" + AlignxMinYMin -> "xMinYMin"+ AlignxMidYMin -> "xMidYMin"+ AlignxMaxYMin -> "xMaxYMin"+ AlignxMinYMid -> "xMinYMid"+ AlignxMidYMid -> "xMidYMid"+ AlignxMaxYMid -> "xMaxYMid"+ AlignxMinYMax -> "xMinYMax"+ AlignxMidYMax -> "xMidYMax"+ AlignxMaxYMax -> "xMaxYMax"++instance ParseableAttribute MeetSlice where+ aparse s = case s of+ "meet" -> Just Meet+ "slice" -> Just Slice+ _ -> Nothing++ aserialize v = Just $ case v of+ Meet -> "meet"+ Slice -> "slice"++instance ParseableAttribute PreserveAspectRatio where+ aserialize v = Just $ defer <> align <> meetSlice where+ defer = if _aspectRatioDefer v then "defer " else ""+ align = fromMaybe "" . aserialize $ _aspectRatioAlign v+ meetSlice = fromMaybe "" $ aserialize =<< _aspectRatioMeetSlice v++ aparse s = case words s of+ [] -> Nothing+ [align] -> Just $ defaultSvg { _aspectRatioAlign = alignOf align }+ ["defer", align] ->+ Just $ defaultSvg+ { _aspectRatioDefer = True+ , _aspectRatioAlign = alignOf align+ }+ [align, meet] ->+ Just $ defaultSvg+ { _aspectRatioMeetSlice = aparse meet+ , _aspectRatioAlign = alignOf align+ }+ ["defer", align, meet] ->+ Just $ PreserveAspectRatio + { _aspectRatioDefer = True+ , _aspectRatioAlign = alignOf align+ , _aspectRatioMeetSlice = aparse meet+ }+ _ -> Nothing+ where+ alignOf = fromMaybe (_aspectRatioAlign defaultSvg) . aparse+ instance ParseableAttribute Cap where aparse s = case s of "butt" -> Just CapButt@@ -561,6 +626,7 @@ ,"x" `parseIn` (imageCornerUpperLeft._1) ,"y" `parseIn` (imageCornerUpperLeft._2) ,parserSetter "href" imageHref (Just . dropSharp) Just+ ,"preserveAspectRatio" `parseIn` imageAspectRatio ] instance XMLUpdatable Line where@@ -686,7 +752,9 @@ updateWithAccessor (filter isNotNone . _groupChildren . _groupOfSymbol) node $ genericSerializeWithDrawAttr node attributes =- ["viewBox" `parseIn` (groupOfSymbol . groupViewBox)]+ ["viewBox" `parseIn` (groupOfSymbol . groupViewBox)+ ,"preserveAspectRatio" `parseIn` (groupOfSymbol . groupAspectRatio)+ ] instance XMLUpdatable RadialGradient where@@ -768,6 +836,7 @@ ,"height" `parseIn` patternHeight ,"x" `parseIn` (patternPos._1) ,"y" `parseIn` (patternPos._2)+ ,"preserveAspectRatio" `parseIn` patternAspectRatio ] instance XMLUpdatable Marker where@@ -783,6 +852,7 @@ ,"orient" `parseIn` markerOrient ,"viewBox" `parseIn` markerViewBox ,"overflow" `parseIn` markerOverflow+ ,"preserveAspectRatio" `parseIn` markerAspectRatio ] serializeText :: Text -> Maybe X.Element
svg-tree.cabal view
@@ -1,5 +1,5 @@ name: svg-tree-version: 0.4.2+version: 0.5 synopsis: SVG file loader and serializer description: svg-tree provides types representing a SVG document,@@ -29,7 +29,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/svg-tree.git- Tag: v0.4.2+ Tag: v0.5 library hs-source-dirs: src@@ -53,7 +53,7 @@ , containers >= 0.4 , xml >= 1.3 , bytestring >= 0.10- , linear >= 1.16+ , linear >= 1.20 , vector >= 0.10 , text >= 1.1 , transformers >= 0.3 && < 0.5