reanimate-svg 0.9.8.0 → 0.10.0.0

raw patch · 3 files changed

+186/−13 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• reanimate-svg.cabal +1/−1
• src/Graphics/SvgTree/Types.hs +108/−8
• src/Graphics/SvgTree/XmlParser.hs +77/−4

@@ -1,5 +1,5 @@ name:                reanimate-svg-version:             0.9.8.0+version:             0.10.0.0 synopsis:            SVG file loader and serializer description:   reanimate-svg provides types representing a SVG document,

@@ -63,6 +63,13 @@     , EdgeMode(..)     , HasGaussianBlur(..)     , GaussianBlur(..)+    , HasTurbulence(..)+    , Turbulence(..)+    , TurbulenceType(..)+    , StitchTiles(..)+    , HasDisplacementMap(..)+    , DisplacementMap(..)+    , ChannelSelector(..)        -- * SVG drawing primitives       -- ** Rectangle@@ -1633,14 +1640,14 @@ data FilterElement   = FEBlend   | FEColorMatrix ColorMatrix-  | FEComponentTransfer+  | FEComponentTransfer -- Need   | FEComposite Composite   | FEConvolveMatrix   | FEDiffuseLighting-  | FEDisplacementMap+  | FEDisplacementMap DisplacementMap   | FEDropShadow   | FEFlood-  | FEFuncA+  | FEFuncA -- Need   | FEFuncB   | FEFuncG   | FEFuncR@@ -1652,13 +1659,61 @@   | FEOffset   | FESpecularLighting   | FETile-  | FETurbulence+  | FETurbulence Turbulence   | FENone   deriving (Eq,Show)  instance WithDefaultSvg FilterElement where   defaultSvg = FENone +data TransferFunctionType+  = TFIdentity+  | TFTable+  | TFDiscrete+  | TFLinear+  | TFGamma+  deriving (Eq, Show)++data TransferFunction = TransferFunction+  { _transferFunctionDrawAttributes   :: !DrawAttributes+  , _transferFunctionFilterAttr       :: !FilterAttributes+  , _transferFunctionType             :: TransferFunctionType+  , _transferFunctionTableValues      :: [Double]+  , _transferFunctionSlope            :: Double+  , _transferFunctionIntercept        :: Double+  , _transferFunctionAmplitude        :: Double+  , _transferFunctionExponent         :: Double+  , _transferFunctionOffset           :: Double+  } deriving (Eq, Show)++data ChannelSelector+  = ChannelR+  | ChannelG+  | ChannelB+  | ChannelA+  deriving (Eq, Show)++data DisplacementMap = DisplacementMap+  { _displacementMapDrawAttributes   :: !DrawAttributes+  , _displacementMapFilterAttr       :: !FilterAttributes+  , _displacementMapIn               :: !(Last FilterSource)+  , _displacementMapIn2              :: !(Last FilterSource)+  , _displacementMapScale            :: !(Last Double)+  , _displacementMapXChannelSelector :: ChannelSelector+  , _displacementMapYChannelSelector :: ChannelSelector+  } deriving (Eq, Show)++instance WithDefaultSvg DisplacementMap where+  defaultSvg = DisplacementMap+    { _displacementMapDrawAttributes   = defaultSvg+    , _displacementMapFilterAttr       = defaultSvg+    , _displacementMapIn               = Last Nothing+    , _displacementMapIn2              = Last Nothing+    , _displacementMapScale            = Last Nothing+    , _displacementMapXChannelSelector = ChannelA+    , _displacementMapYChannelSelector = ChannelA+    }+ data ColorMatrixType   = Matrix   | Saturate@@ -1717,6 +1772,37 @@     , _compositeK4             = Num 0     } +data Turbulence = Turbulence+  { _turbulenceDrawAttributes :: !DrawAttributes+  , _turbulenceFilterAttr     :: !FilterAttributes+  , _turbulenceBaseFrequency  :: !(Double, Last Double) -- Not negative+  , _turbulenceNumOctaves     :: Int -- Not negative+  , _turbulenceSeed           :: Double+  , _turbulenceStitchTiles    :: StitchTiles+  , _turbulenceType           :: TurbulenceType+  } deriving (Eq, Show)++data StitchTiles+  = NoStitch+  | Stitch+  deriving (Eq, Show)++data TurbulenceType+  = FractalNoiseType+  | TurbulenceType+  deriving (Eq, Show)++instance WithDefaultSvg Turbulence where+  defaultSvg = Turbulence+    { _turbulenceDrawAttributes = defaultSvg+    , _turbulenceFilterAttr     = defaultSvg+    , _turbulenceBaseFrequency  = (0, Last Nothing)+    , _turbulenceNumOctaves     = 1+    , _turbulenceSeed           = 0+    , _turbulenceStitchTiles    = NoStitch+    , _turbulenceType           = TurbulenceType+    }+ data EdgeMode   = EdgeDuplicate   | EdgeWrap@@ -2784,6 +2870,8 @@ makeClassy ''Composite makeClassy ''ColorMatrix makeClassy ''GaussianBlur+makeClassy ''Turbulence+makeClassy ''DisplacementMap  instance HasDrawAttributes Composite where     drawAttributes = compositeDrawAttributes@@ -2795,6 +2883,12 @@ instance HasDrawAttributes GaussianBlur where     drawAttributes = gaussianBlurDrawAttributes +instance HasDrawAttributes Turbulence where+    drawAttributes = turbulenceDrawAttributes++instance HasDrawAttributes DisplacementMap where+    drawAttributes = displacementMapDrawAttributes+ instance HasFilterAttributes Composite where   filterAttributes = compositeFilterAttr @@ -2804,6 +2898,12 @@ instance HasFilterAttributes GaussianBlur where   filterAttributes = gaussianBlurFilterAttr +instance HasFilterAttributes Turbulence where+  filterAttributes = turbulenceFilterAttr++instance HasFilterAttributes DisplacementMap where+  filterAttributes = displacementMapFilterAttr+ instance HasFilterAttributes FilterElement where   filterAttributes = lens getter setter     where@@ -2814,7 +2914,7 @@           FEComposite c       -> c ^. filterAttributes           FEConvolveMatrix    -> defaultSvg           FEDiffuseLighting   -> defaultSvg-          FEDisplacementMap   -> defaultSvg+          FEDisplacementMap d -> d ^. filterAttributes           FEDropShadow        -> defaultSvg           FEFlood             -> defaultSvg           FEFuncA             -> defaultSvg@@ -2829,7 +2929,7 @@           FEOffset            -> defaultSvg           FESpecularLighting  -> defaultSvg           FETile              -> defaultSvg-          FETurbulence        -> defaultSvg+          FETurbulence t      -> t ^. filterAttributes           FENone              -> defaultSvg       setter fe attr = case fe of         FEBlend             -> fe@@ -2838,7 +2938,7 @@         FEComposite c       -> FEComposite $ c & filterAttributes .~ attr         FEConvolveMatrix    -> fe         FEDiffuseLighting   -> fe-        FEDisplacementMap   -> fe+        FEDisplacementMap d -> FEDisplacementMap $ d & filterAttributes .~ attr         FEDropShadow        -> fe         FEFlood             -> fe         FEFuncA             -> fe@@ -2853,5 +2953,5 @@         FEOffset            -> fe         FESpecularLighting  -> fe         FETile              -> fe-        FETurbulence        -> fe+        FETurbulence t      -> FETurbulence $ t & filterAttributes .~ attr         FENone              -> fe

@@ -93,6 +93,10 @@   aparse = parse dashArray   aserialize = Just . serializeDashArray +instance ParseableAttribute [Double] where+  aparse = parse numberList+  aserialize = Just . serializeDashArray . map Num+ instance ParseableAttribute PixelRGBA8 where   aparse = parse colorParser   aserialize = Just . colorSerializer@@ -113,6 +117,10 @@   aparse = parseMayStartDot num   aserialize v = Just $ printf "%s" (ppD v) +instance ParseableAttribute Int where+  aparse = fmap (round :: Double -> Int) . aparse+  aserialize v = Just $ printf "%d" v+ instance ParseableAttribute Texture where   aparse = parse textureParser   aserialize = Just . textureSerializer@@ -390,6 +398,40 @@     HueRotate        -> "hueRotate"     LuminanceToAlpha -> "luminanceToAlpha" +instance ParseableAttribute StitchTiles where+  aparse s = case s of+    "noStitch" -> Just NoStitch+    "stitch"   -> Just Stitch+    _          -> Nothing++  aserialize v = Just $ case v of+    NoStitch -> "noStitch"+    Stitch   -> "stitch"++instance ParseableAttribute TurbulenceType where+  aparse s = case s of+    "fractalNoise" -> Just FractalNoiseType+    "turbulence"   -> Just TurbulenceType+    _              -> Nothing++  aserialize v = Just $ case v of+    FractalNoiseType -> "fractalNoise"+    TurbulenceType   -> "turbulence"++instance ParseableAttribute ChannelSelector where+  aparse s = case s of+    "R" -> Just ChannelR+    "G" -> Just ChannelG+    "B" -> Just ChannelB+    "A" -> Just ChannelA+    _   -> Nothing++  aserialize v = Just $ case v of+    ChannelR -> "R"+    ChannelG -> "G"+    ChannelB -> "B"+    ChannelA -> "A"+ instance ParseableAttribute EdgeMode where   aparse s = case s of     "duplicate" -> Just EdgeDuplicate@@ -411,6 +453,15 @@   aserialize (x, Last Nothing)  = aserialize [x]   aserialize (x, Last (Just y)) = aserialize [x, y] +instance ParseableAttribute (Double, Last Double) where+  aparse s = case aparse s of+    Just [x]   -> Just (x, Last Nothing)+    Just [x,y] -> Just (x, Last (Just y))+    _          -> Nothing++  aserialize (x, Last Nothing)  = aserialize [x]+  aserialize (x, Last (Just y)) = aserialize [x, y]+ parse :: Parser a -> String -> Maybe a parse p str = case parseOnly p (T.pack str) of   Left _  -> Nothing@@ -900,10 +951,12 @@   xmlTagName _ = "FilterElement"   serializeTreeNode fe = flip mergeAttributes <$> (genericSerializeNode fe) <*>     case fe of-      FEColorMatrix m  -> serializeTreeNode m-      FEComposite c    -> serializeTreeNode c-      FEGaussianBlur b -> serializeTreeNode b-      _                -> error $+      FEColorMatrix m     -> serializeTreeNode m+      FEComposite c       -> serializeTreeNode c+      FEGaussianBlur b    -> serializeTreeNode b+      FETurbulence t      -> serializeTreeNode t+      FEDisplacementMap d -> serializeTreeNode d+      _                   -> error $         "Unsupported element: " ++ show fe ++ ". Please submit bug on github."   attributes =     [ "result" `parseIn` (filterAttributes . filterResult)]@@ -935,6 +988,26 @@     [ "in" `parseIn` gaussianBlurIn     , "stdDeviation" `parseIn` lensProduct gaussianBlurStdDeviationX gaussianBlurStdDeviationY     , "edgeMode" `parseIn` gaussianBlurEdgeMode ]++instance XMLUpdatable DisplacementMap where+  xmlTagName _ = "feDisplacementMap"+  serializeTreeNode = genericSerializeWithDrawAttr+  attributes =+    [ "in" `parseIn` displacementMapIn+    , "in2" `parseIn` displacementMapIn2+    , "scale" `parseIn` displacementMapScale+    , "xChannelSelector" `parseIn` displacementMapXChannelSelector+    , "yChannelSelector" `parseIn` displacementMapYChannelSelector ]++instance XMLUpdatable Turbulence where+  xmlTagName _ = "feTurbulence"+  serializeTreeNode = genericSerializeWithDrawAttr+  attributes =+    [ "baseFrequency" `parseIn` turbulenceBaseFrequency+    , "numOctaves" `parseIn` turbulenceNumOctaves+    , "seed" `parseIn` turbulenceSeed+    , "stitchTiles" `parseIn` turbulenceStitchTiles+    , "type" `parseIn` turbulenceType ]  instance XMLUpdatable RadialGradient where   xmlTagName _ = "radialGradient"