diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## [v1.4.3](https://github.com/diagrams/diagrams-svg/tree/v1.4.3) (2019-12-10) + +- Allow `base-4.13` (GHC 8.8), `lens-4.18`, `semigroups-0.19`, + `hashable-1.3`, `optparse-applicative-0.15` +- Stop rounding the coordinates of the viewbox + ([#109](https://github.com/diagrams/diagrams-svg/issues/109)) +- New `svgClass`, `svgId`, and `svgTitle` functions for setting SVG + attributes via annotations + ## [v1.4.2](https://github.com/diagrams/diagrams-svg/tree/v1.4.2) (2018-05-09) - Allow `base-4.11` (GHC 8.4) and `lens-4.16` diff --git a/diagrams-svg.cabal b/diagrams-svg.cabal --- a/diagrams-svg.cabal +++ b/diagrams-svg.cabal @@ -1,5 +1,5 @@ Name: diagrams-svg -Version: 1.4.2 +Version: 1.4.3 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3 @@ -12,7 +12,7 @@ Category: Graphics Build-type: Simple Cabal-version: >=1.10 -Tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2 +Tested-with: GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1 Description: This package provides a modular backend for rendering diagrams created with the diagrams EDSL to SVG files. It uses @lucid-svg@ to be a native @@ -40,7 +40,7 @@ Diagrams.Backend.SVG.CmdLine Other-modules: Graphics.Rendering.SVG Hs-source-dirs: src - Build-depends: base >= 4.3 && < 4.12 + Build-depends: base >= 4.7 && < 4.14 , filepath , mtl >= 1 && < 2.3 , bytestring >= 0.9 && < 1.0 @@ -48,16 +48,16 @@ , colour , diagrams-core >= 1.4 && < 1.5 , diagrams-lib >= 1.4 && < 1.5 - , monoid-extras >= 0.3 && < 0.5 + , monoid-extras >= 0.3 && < 0.6 , svg-builder >= 0.1 && < 0.2 , text >= 0.11 && < 1.3 - , JuicyPixels >= 3.1.5 && < 3.3 + , JuicyPixels >= 3.1.5 && < 3.4 , split >= 0.1.2 && < 0.3 - , containers >= 0.3 && < 0.6 - , lens >= 4.0 && < 4.17 - , hashable >= 1.1 && < 1.3 - , optparse-applicative >= 0.13 && < 0.15 - , semigroups >= 0.13 && < 0.19 + , containers >= 0.3 && < 0.7 + , lens >= 4.0 && < 4.19 + , hashable >= 1.1 && < 1.4 + , optparse-applicative >= 0.13 && < 0.16 + , semigroups >= 0.13 && < 0.20 if impl(ghc < 7.6) build-depends: ghc-prim diff --git a/src/Diagrams/Backend/SVG.hs b/src/Diagrams/Backend/SVG.hs --- a/src/Diagrams/Backend/SVG.hs +++ b/src/Diagrams/Backend/SVG.hs @@ -16,8 +16,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE UndecidableInstances #-} - -- UndecidableInstances needed for ghc < 707 ---------------------------------------------------------------------------- -- | @@ -65,7 +63,7 @@ -- > -- section of the output. -- > , _idPrefix :: T.Text -- > , _svgAttributes :: [Attribute] --- > -- ^ Attriubtes to apply to the entire svg element. +-- > -- ^ Attributes to apply to the entire svg element. -- > , _generateDoctype :: Bool -- > } -- @@ -100,6 +98,7 @@ , B -- for rendering options specific to SVG , Options(..), sizeSpec, svgDefinitions, idPrefix, svgAttributes, generateDoctype + , svgClass, svgId, svgTitle , SVGFloat , renderSVG @@ -110,8 +109,9 @@ ) where -- from JuicyPixels -import Codec.Picture -import Codec.Picture.Types (dynamicMap) +import Codec.Picture (decodeImage, encodeDynamicPng) +import Codec.Picture.Types (DynamicImage (ImageYCbCr8), + dynamicMap, imageHeight, imageWidth) #if __GLASGOW_HASKELL__ < 710 import Data.Foldable as F (foldMap) @@ -139,10 +139,11 @@ -- from diagrams-core import Diagrams.Core.Compile -import Diagrams.Core.Types (Annotation (..)) +import Diagrams.Core.Types (Annotation (..), keyVal) -- from diagrams-lib -import Diagrams.Prelude hiding (Attribute, size, view, local) +import Diagrams.Prelude hiding (Attribute, local, size, view, + with) import Diagrams.TwoD.Adjust (adjustDia2D) import Diagrams.TwoD.Attributes (FillTexture, splitTextureFills) import Diagrams.TwoD.Path (Clip (Clip)) @@ -167,7 +168,7 @@ data Environment n = Environment { _style :: Style V2 n - , __pre :: T.Text + , __pre :: T.Text } makeLenses ''Environment @@ -270,14 +271,31 @@ rtree :: SVGFloat n => RTree SVG V2 n Annotation -> Render SVG V2 n rtree (Node n rs) = case n of - RPrim p -> render SVG p - RStyle sty -> R $ local (over style (<> sty)) r - RAnnot (OpacityGroup o) -> R $ g_ [Opacity_ <<- toText o] <$> r - RAnnot (Href uri) -> R $ a_ [XlinkHref_ <<- T.pack uri] <$> r - _ -> R r + RPrim p -> render SVG p + RStyle sty -> R $ local (over style (<> sty)) r + RAnnot (OpacityGroup o) -> R $ g_ [Opacity_ <<- toText o] <$> r + RAnnot (Href uri) -> R $ a_ [XlinkHref_ <<- T.pack uri] <$> r + RAnnot (KeyVal ("class",v)) -> R $ with <$> r <*> pure [Class_ <<- T.pack v] + RAnnot (KeyVal ("id",v)) -> R $ with <$> r <*> pure [Id_ <<- T.pack v] + RAnnot (KeyVal ("title",v)) -> R $ do + e <- r + pure $ g_ [] $ e <> title_ [] (toElement v) + _ -> R r where R r = foldMap rtree rs +-- | Set the id for a particular SVG diagram +svgId :: SVGFloat n => String -> QDiagram SVG V2 n Any -> QDiagram SVG V2 n Any +svgId = curry keyVal "id" + +-- | Set the class for a particular SVG diagram +svgClass :: SVGFloat n => String -> QDiagram SVG V2 n Any -> QDiagram SVG V2 n Any +svgClass = curry keyVal "class" + +-- | Set the title text for a particular SVG diagram +svgTitle :: SVGFloat n => String -> QDiagram SVG V2 n Any -> QDiagram SVG V2 n Any +svgTitle = curry keyVal "title" + -- | Lens onto the size of the svg options. sizeSpec :: Lens' (Options SVG V2 n) (SizeSpec V2 n) sizeSpec f opts = f (_size opts) <&> \s -> opts { _size = s } @@ -397,7 +415,7 @@ mime <- case t of 'J' -> return "image/jpeg" 'P' -> return "image/png" - _ -> fail "Unknown mime type while rendering image" + _ -> error "Unknown mime type while rendering image" return $ R.renderDImage di $ R.dataUri mime d instance Hashable n => Hashable (Options SVG V2 n) where diff --git a/src/Graphics/Rendering/SVG.hs b/src/Graphics/Rendering/SVG.hs --- a/src/Graphics/Rendering/SVG.hs +++ b/src/Graphics/Rendering/SVG.hs @@ -92,7 +92,7 @@ ([ Width_ <<- toText w , Height_ <<- toText h , Font_size_ <<- "1" - , ViewBox_ <<- (pack . unwords $ map show ([0, 0, round w, round h] :: [Int])) + , ViewBox_ <<- (pack . unwords $ map show [0, 0, w, h]) , Stroke_ <<- "rgb(0,0,0)" , Stroke_opacity_ <<- "1" ] ++ attributes )