diagrams-svg-1.4.3.2/0000755000000000000000000000000007346545000012434 5ustar0000000000000000diagrams-svg-1.4.3.2/CHANGELOG.md0000644000000000000000000004416307346545000014255 0ustar0000000000000000## [v1.4.3.2](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.2) (2024-08-27) - Allow `hashable-1.5` - Fix `examples/opts.hs` (thanks to @PiotrJustyna) ## [v1.4.3.1-r7](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1-r7) (2024-07-02) - Allow `filepath-1.5`, `containers-0.7`, and `lens-5.3` - Test on GHC 9.10 ## [v1.4.3.1-r6](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1-r6) (2024-01-20) - Allow `base-4.19` and `text-2.1` - Test on GHC 9.8 ## [v1.4.3.1-r5](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1-r5) (2023-05-30) - Allow `base-4.18`, `mtl-2.3`, `optparse-applicative-0.18`, and test on GHC 9.6 ## [v1.4.3.1-r4](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1-r4) (2022-09-05) - Allow `base-4.17`, `lens-5.2`, and test on GHC 9.4 ## [v1.4.3.1-r3](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1-r3) (2022-02-02) - Allow `optparse-applicative-0.17`. ## [v1.4.3.1-r2](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1-r2) (2022-01-10) - Allow `text-2.0`. ## [v1.4.3.1](https://github.com/diagrams/diagrams-svg/tree/v1.4.3.1) (2021-12-28) - Dependency upper bounds updates to allow: - `base-4.16` (GHC 9.2) - `lens-5.1` - `hashable-1.4` - `semigroups-0.20` - Add `Eq` instance for `Options SVG` and (orphan) `Eq` instance for `Element` ## [v1.4.3-r3](https://github.com/diagrams/diagrams-svg/tree/v1.4.3-r3) (2021-06-08) Dependency upper bounds updates, to allow: - `base-4.15` (GHC 9.0) - `base64-bytestring-1.2` - `diagrams-core-1.5` - `monoid-extras-0.6` - `lens-5.0` - `optparse-applicative-0.16` ## [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` - Add `Semigroup (Render SVG V2 n)` instance ## [v1.4.1.1](https://github.com/diagrams/diagrams-svg/tree/v1.4.1.1) (2017-08-23) - Allow `base-4.10` and `optparse-applicative-0.14` - Fix gradients applied to text ([#98](https://github.com/diagrams/diagrams-svg/issues/98)) ## [v1.4.1](https://github.com/diagrams/diagrams-svg/tree/v1.4.1) (2016-10-26) - Handle wider range of font weight specifications - allow `lens-4.15` ## [v1.4.0.4](https://github.com/diagrams/diagrams-svg/tree/v1.4.0.4) (2016-08-22) - Require `optparse-applicative-0.13`, and fix compilation error ## [v1.4.0.3](https://github.com/diagrams/diagrams-svg/tree/v1.4.0.3) (2016-08-16) - Allow `optparse-applicative-0.13` ## [v1.4.0.2](https://github.com/diagrams/diagrams-svg/tree/v1.4.0.2) (2016-06-06) - allow `base-4.9` - test with GHC 8.0 - minor documentation updates ## [v1.4.0.1](https://github.com/diagrams/diagrams-svg/tree/v1.4.0.1) (2016-05-01) - allow `lens-4.14` ## [v1.4](https://github.com/diagrams/diagrams-svg/tree/v1.4) (2016-02-14) -- Changes for `svg-builder` -- Deprecate `svgId` and `svgClass` ## [v1.3.1.8](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.8) (2015-11-14) - allow `lucid-svg-0.6` ## [v1.3.1.7](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.7) (2015-11-10) - allow `semigroups-0.18` [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.3.1.6...v1.3.1.7) ## [v1.3.1.6](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.6) (2015-09-29) - allow `optparse-applicative-0.12` [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.3.1.5...v1.3.1.6) ## [v1.3.1.5](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.5) (2015-09-19) - allow `lens-4.13` and `semigroups-0.17` [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.3.1.4...v1.3.1.5) ## [v1.3.1.4](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.4) (2015-07-19) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.3.1.3...v1.3.1.4) ## [v1.3.1.3](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.2) (2015-07-09) - Changes to allow `lucid-svg-0.5` ## [v1.3.1.2](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.2) (2015-05-26) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.3.1.1...v1.3.1.2) ## [v1.3.1.1](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.1) (2015-05-06) **Bug Fix**: handle empty dashing array properly ([\#80](https://github.com/diagrams/diagrams-svg/pull/80)) ## [v1.3.1](https://github.com/diagrams/diagrams-svg/tree/v1.3.1) (2015-04-30) **API Changes** - Type of `SVGOptions` changed. `_svgDefinitions :: Maybe SvgM` **Internal Changes** - Use `ReaderT` for styles ## [v1.3](https://github.com/diagrams/diagrams-svg/tree/v1.3) (2015-04-19) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.1.0.4...v1.1.0.5) **New features** - User settable ID prefixes - Support opacity group - Fix clipping bug (Issue #70) **Internal Changes** - Switch rendering engine from `blaze-svg` to `lucid-svg` - Use `fsnotify` for looping - Add defs tags for clips and gradients **Implemented enhancements:** - Put `clip path`, `gradients`, etc in defs tag. [\#73](https://github.com/diagrams/diagrams-svg/issues/73) **Fixed bugs:** - Font size not applied properly in composite diagram [\#66](https://github.com/diagrams/diagrams-svg/issues/66) - clipping broken [\#70](https://github.com/diagrams/diagrams-svg/issues/70) **Merged pull requests:** - State [\#74](https://github.com/diagrams/diagrams-svg/pull/74) ([cchalmers](https://github.com/cchalmers)) - Bump base upper bound [\#72](https://github.com/diagrams/diagrams-svg/pull/72) ([bgamari](https://github.com/bgamari)) - Allow user to set ID prefixes [\#71](https://github.com/diagrams/diagrams-svg/pull/71) ([mightybyte](https://github.com/mightybyte)) - Lucid [\#69](https://github.com/diagrams/diagrams-svg/pull/69) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Use fsnotify for looping, via diagrams-lib [\#67](https://github.com/diagrams/diagrams-svg/pull/67) ([bergey](https://github.com/bergey)) ## [v1.1.0.5](https://github.com/diagrams/diagrams-svg/tree/v1.1.0.5) (2015-04-03) - allow `lens-4.9` - allow `vector-space-0.10` - allow `blaze-markup-0.7` ## [v1.1.0.4](https://github.com/diagrams/diagrams-svg/tree/v1.1.0.4) (2015-01-13) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.1.0.3...v1.1.0.4) ## [v1.1.0.3](https://github.com/diagrams/diagrams-svg/tree/v1.1.0.3) (2014-12-07) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.1.0.2...v1.1.0.3) ## [v1.1.0.2](https://github.com/diagrams/diagrams-svg/tree/v1.1.0.2) (2014-11-17) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.1.0.1...v1.1.0.2) **Fixed bugs:** - Font scaling uses "em" units. [\#30](https://github.com/diagrams/diagrams-svg/issues/30) **Merged pull requests:** - Bump lens upper version bounds [\#65](https://github.com/diagrams/diagrams-svg/pull/65) ([RyanGlScott](https://github.com/RyanGlScott)) - New stuff [\#63](https://github.com/diagrams/diagrams-svg/pull/63) ([cchalmers](https://github.com/cchalmers)) - Allows us to write `Diagram B` instead of `Diagram B V2 Double/Float/Whatever` in diagrams programs [\#62](https://github.com/diagrams/diagrams-svg/pull/62) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Linear [\#61](https://github.com/diagrams/diagrams-svg/pull/61) ([cchalmers](https://github.com/cchalmers)) ## [v1.1.0.1](https://github.com/diagrams/diagrams-svg/tree/v1.1.0.1) (2014-08-22) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.1...v1.1.0.1) **Closed issues:** - Embedding JPEG images without repacking [\#57](https://github.com/diagrams/diagrams-svg/issues/57) **Merged pull requests:** - Enable compilation with GHC HEAD \(v7.9\) [\#60](https://github.com/diagrams/diagrams-svg/pull/60) ([ggreif](https://github.com/ggreif)) - Add loadImageSVG to support JPEG-images without repacking via Native DImages [\#58](https://github.com/diagrams/diagrams-svg/pull/58) ([taruti](https://github.com/taruti)) - Allow svg output file to be pretty printed [\#56](https://github.com/diagrams/diagrams-svg/pull/56) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) ## [v1.1](https://github.com/diagrams/diagrams-svg/tree/v1.1) (2014-06-02) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0.2.1...v1.1) **New features** - Support for radial and linear gradients. - Support for embedded images in `.png` format. **New instances** - `Renderable` instances for `DImage Embedded`. **API changes** - Updates to work with `Measure` units. - Substantial refactoring of `Backend` instance to support changes in `Diagrams.Core`. **Dependency/version changes** - New dependencies: `base64-bytestring` and `JuicyPixels`. - Allow `lens-4.2` - Allow `mtl-2.2` **Closed issues:** - Support hyperlinks [\#48](https://github.com/diagrams/diagrams-svg/issues/48) - Line width not handled properly by some browsers [\#33](https://github.com/diagrams/diagrams-svg/issues/33) - implement image embedding [\#11](https://github.com/diagrams/diagrams-svg/issues/11) **Merged pull requests:** - Embedded images - png working [\#54](https://github.com/diagrams/diagrams-svg/pull/54) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - fix text scaling [\#53](https://github.com/diagrams/diagrams-svg/pull/53) ([byorgey](https://github.com/byorgey)) - Updates to work with `Backend` redesign [\#51](https://github.com/diagrams/diagrams-svg/pull/51) ([byorgey](https://github.com/byorgey)) - Rework of units [\#50](https://github.com/diagrams/diagrams-svg/pull/50) ([byorgey](https://github.com/byorgey)) - Preliminary implementation of Measure [\#46](https://github.com/diagrams/diagrams-svg/pull/46) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Gradient [\#41](https://github.com/diagrams/diagrams-svg/pull/41) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) ## [v1.0.2.1](https://github.com/diagrams/diagrams-svg/tree/v1.0.2.1) (2014-03-19) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0.2...v1.0.2.1) ## [v1.0.2](https://github.com/diagrams/diagrams-svg/tree/v1.0.2) (2014-03-09) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0.1.3...v1.0.2) **New features** - Support for including hyperlinks. **Dependency/version changes** - Allow `diagrams-core-1.1` and `diagrams-lib-1.1` - Allow `lens-4.0` **Bug fixes** - Use `splitFills` to properly render certain diagrams with mixed lines and filled loops. Previously, in certain situations loops that should have been filled were not. ([#43](https://github.com/diagrams/diagrams-svg/issues/43)) - Don't emit last segment of a loop if it is linear. See [diagrams-cairo#38](http://github.com/diagrams/diagrams-cairo/issues/38). This wasn't actually causing any observable problems in the SVG backend output, but this seems a better/more robust way to do things in any case. **Closed issues:** - SVG backend doesn't fill loops if they occur in the same subtree as a line [\#43](https://github.com/diagrams/diagrams-svg/issues/43) **Merged pull requests:** - Hyperlinks [\#49](https://github.com/diagrams/diagrams-svg/pull/49) ([tdox](https://github.com/tdox)) - stop using ignoreFill; use splitFills instead. Fixes \#43. [\#47](https://github.com/diagrams/diagrams-svg/pull/47) ([byorgey](https://github.com/byorgey)) ## [v1.0.1.3](https://github.com/diagrams/diagrams-svg/tree/v1.0.1.3) (2014-02-06) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0.1.2...v1.0.1.3) ## [v1.0.1.2](https://github.com/diagrams/diagrams-svg/tree/v1.0.1.2) (2014-02-04) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0.1.1...v1.0.1.2) ## [v1.0.1.1](https://github.com/diagrams/diagrams-svg/tree/v1.0.1.1) (2014-01-30) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0.1...v1.0.1.1) ## [v1.0.1](https://github.com/diagrams/diagrams-svg/tree/v1.0.1) (2014-01-26) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.0...v1.0.1) **Merged pull requests:** - Add Hashable instance for Options SVG R2 [\#45](https://github.com/diagrams/diagrams-svg/pull/45) ([byorgey](https://github.com/byorgey)) ## [v1.0](https://github.com/diagrams/diagrams-svg/tree/v1.0) (2013-11-25) According to the PVP, these changes should require a major version bump. However, a major version bump would be quite annoying and I don't expect these instance changes to affect anyone (the changes were made for internal reasons). Please yell if it does affect you. [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v0.8.0.2...v1.0) **Fixed bugs:** - SVG backend fills lines again [\#42](https://github.com/diagrams/diagrams-svg/issues/42) ## [v0.8.0.2](https://github.com/diagrams/diagrams-svg/tree/v0.8.0.2) (2013-10-26) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v0.8.0.1...v0.8.0.2) **Closed issues:** - Text alignment support [\#17](https://github.com/diagrams/diagrams-svg/issues/17) - Add a workaround for the Chrome stroke-width 0 bug [\#3](https://github.com/diagrams/diagrams-svg/issues/3) **Merged pull requests:** - Lens [\#40](https://github.com/diagrams/diagrams-svg/pull/40) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Updating information about 'Options SVG' [\#39](https://github.com/diagrams/diagrams-svg/pull/39) ([co-dan](https://github.com/co-dan)) ## [v0.8.0.1](https://github.com/diagrams/diagrams-svg/tree/v0.8.0.1) (2013-09-11) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v0.8...v0.8.0.1) ## [v0.8](https://github.com/diagrams/diagrams-svg/tree/v0.8) (2013-09-10) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v0.7...v0.8) **New features** - Extra SVG definitions, to be inserted in the output, may be passed as an argument - Support for new miter limit attribute - Approximate text alignment **Bug fixes** - Stacking multiple clip regions now works properly **Merged pull requests:** - Font embedding changes [\#38](https://github.com/diagrams/diagrams-svg/pull/38) ([jbracker](https://github.com/jbracker)) - Added approximation of text alignment. Better then nothing... [\#36](https://github.com/diagrams/diagrams-svg/pull/36) ([jbracker](https://github.com/jbracker)) ## [v0.7](https://github.com/diagrams/diagrams-svg/tree/v0.7) (2013-08-09) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v0.6.0.1...v0.7) **New features** - New `renderToSVG` convenience function - Vastly improved Haddock documentation **New instances** - `Show` instance for `Options SVG R2` **Dependency/version changes** - allow `base-4.7` and `unix-2.7` - Upgrade to `monoid-extras-0.3` **Implemented enhancements:** - Improve Haddock documentation [\#27](https://github.com/diagrams/diagrams-svg/issues/27) **Fixed bugs:** - Lines should not be filled [\#35](https://github.com/diagrams/diagrams-svg/issues/35) **Closed issues:** - diagrams-svg.cabal out of sync with core and lib [\#34](https://github.com/diagrams/diagrams-svg/issues/34) - Add function of type FilePath -\> SizeSpec2D -\> Diagram -\> IO \(\) [\#28](https://github.com/diagrams/diagrams-svg/issues/28) **Merged pull requests:** - General SVG backend cleanup, additional documentation, and new API function [\#29](https://github.com/diagrams/diagrams-svg/pull/29) ([byorgey](https://github.com/byorgey)) ## [v0.6.0.1](https://github.com/diagrams/diagrams-svg/tree/v0.6.0.1) (2012-12-14) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v0.6...v0.6.0.1) ## [v0.6](https://github.com/diagrams/diagrams-svg/tree/v0.6) (2012-12-12) First "officially supported" release. Features still not implemented: - text alignment - inline images As of this release everything else Should Work (tm). **Closed issues:** - Line width does not follow specification? [\#24](https://github.com/diagrams/diagrams-svg/issues/24) - diagrams-svg doesn't build under directory-1.2 \(and hence GHC-7.6\) [\#20](https://github.com/diagrams/diagrams-svg/issues/20) - Freezing does not appear to work with the SVG backend [\#19](https://github.com/diagrams/diagrams-svg/issues/19) - Font family support [\#18](https://github.com/diagrams/diagrams-svg/issues/18) - Fill color needs to be explicitly specified for text nodes [\#15](https://github.com/diagrams/diagrams-svg/issues/15) - Implement clipping [\#14](https://github.com/diagrams/diagrams-svg/issues/14) - Add README, documentation and generate documentation on Hackage [\#13](https://github.com/diagrams/diagrams-svg/issues/13) - implement text attributes [\#10](https://github.com/diagrams/diagrams-svg/issues/10) - implement text rendering [\#9](https://github.com/diagrams/diagrams-svg/issues/9) - implement line cap [\#8](https://github.com/diagrams/diagrams-svg/issues/8) - implement line dashing [\#7](https://github.com/diagrams/diagrams-svg/issues/7) - Implement line join attribute [\#6](https://github.com/diagrams/diagrams-svg/issues/6) - Implement opacity [\#5](https://github.com/diagrams/diagrams-svg/issues/5) - Implement fill rule [\#4](https://github.com/diagrams/diagrams-svg/issues/4) - Switch to using blaze-svg combinators [\#2](https://github.com/diagrams/diagrams-svg/issues/2) - Create a new branch for using blaze-svg [\#1](https://github.com/diagrams/diagrams-svg/issues/1) **Merged pull requests:** - Fix for clipping with freeze support. [\#26](https://github.com/diagrams/diagrams-svg/pull/26) ([fryguybob](https://github.com/fryguybob)) - Apply frozen transformations with element. [\#25](https://github.com/diagrams/diagrams-svg/pull/25) ([cmears](https://github.com/cmears)) - ghc-7.6 [\#23](https://github.com/diagrams/diagrams-svg/pull/23) ([michaelt](https://github.com/michaelt)) - Increase cmdargs upper bound to < 0.10 [\#16](https://github.com/diagrams/diagrams-svg/pull/16) ([byorgey](https://github.com/byorgey)) - Line join + cap [\#12](https://github.com/diagrams/diagrams-svg/pull/12) ([byorgey](https://github.com/byorgey)) \* *This Change Log was automatically generated by (and hand edited) [github_changelog_generator](https://github.com/skywinder/Github-Changelog-Generator)* diagrams-svg-1.4.3.2/LICENSE0000644000000000000000000000450107346545000013441 0ustar0000000000000000Copyright 2011-2016 diagrams-svg team: Doug Beardsley Daniel Bergey Jan Bracker Christopher Chalmers Michael Chavinda Tad Doxsee Daniil Frumin Ben Gamari Gabor Greif Deepak Jois Sidharth Kapur Taru Karttunen Felipe Lessa Andrew Martin Chris Mears Jeffrey Rosenbluth Ryan Scott Michael Sloan Michael Thompson Ryan Yates Brent Yorgey All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Ryan Yates nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diagrams-svg-1.4.3.2/README.md0000644000000000000000000000532307346545000013716 0ustar0000000000000000diagrams-svg [![Hackage](https://img.shields.io/hackage/v/diagrams-svg.svg?style=flat)](https://hackage.haskell.org/package/diagrams-svg) [![Build Status](https://github.com/diagrams/diagrams-svg/actions/workflows/haskell-ci.yml/badge.svg))](https://github.com/diagrams/diagrams-svg/actions/workflows/haskell-ci.yml) ------------ _diagrams-svg_ is a an SVG backend for [diagrams]. Diagrams is a powerful, flexible, declarative domain-specific language for creating vector graphics, using the [Haskell programming language][haskell]. [diagrams]: http://projects.haskell.org/diagrams/ [haskell]: http://www.haskell.org/haskellwiki/Haskell _diagrams-svg_ is the default out-of-the box backend that comes with the diagrams framework, and supports most features defined in [diagrams-lib]. [diagrams-lib]: http://hackage.haskell.org/package/diagrams%2Dlib # Installation ``` cabal update && cabal install diagrams-svg ``` # Usage A simple example that uses _diagrams-svg_ to draw a square. ```haskell import Diagrams.Prelude import Diagrams.Backend.SVG.CmdLine b1 :: Diagram B b1 = square 20 # lw 0.002 main = mainWith (pad 1.1 b1) ``` Save this to file named `Square.hs` and compile this program: ``` ghc --make Square.hs ``` This will generate an executable which, when run produces an SVG file. Run the executable with the `--help` option to find out more about how to call it. ``` $ ./Square --help ./Square Usage: ./Square [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] [--loop] [-s|--src ARG] [-i|--interval INTERVAL] Command-line diagram generation. Available options: -?,--help Show this help text -w,--width WIDTH Desired WIDTH of the output image -h,--height HEIGHT Desired HEIGHT of the output image -o,--output OUTPUT OUTPUT file -l,--loop Run in a self-recompiling loop -s,--src ARG Source file to watch -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds. -p,--pretty Pretty print the SVG output ``` You _must_ pass an output file name with a `.svg` extension to generate the SVG file. ``` $ ./Square -o square.svg ``` The command above generates the SVG file: ``` ``` diagrams-svg-1.4.3.2/Setup.hs0000644000000000000000000000011007346545000014060 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain diagrams-svg-1.4.3.2/diagrams-svg.cabal0000644000000000000000000000611307346545000016005 0ustar0000000000000000Name: diagrams-svg Version: 1.4.3.2 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: https://diagrams.github.io/ License: BSD3 License-file: LICENSE Extra-source-files: README.md, CHANGELOG.md Author: Felipe Lessa, Deepak Jois Maintainer: diagrams-discuss@googlegroups.com Bug-reports: http://github.com/diagrams/diagrams-svg/issues Stability: Experimental Category: Graphics Build-type: Simple Cabal-version: >=1.10 Tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 Description: This package provides a modular backend for rendering diagrams created with the diagrams EDSL to SVG files. It uses @svg-builder@ to be a native Haskell backend, making it suitable for use on any platform. . The package provides the following modules: . * "Diagrams.Backend.SVG.CmdLine" - if you're just getting started with diagrams, begin here. . * "Diagrams.Backend.SVG" - look at this next. The general API for the SVG backend. . Additional documentation can be found in the README file distributed with the source tarball or viewable on GitHub: . Source-repository head type: git location: http://github.com/diagrams/diagrams-svg Library Exposed-modules: Diagrams.Backend.SVG Diagrams.Backend.SVG.CmdLine Other-modules: Graphics.Rendering.SVG Hs-source-dirs: src Build-depends: base >= 4.7 && < 4.21 , filepath >= 1.4 && < 1.6 , mtl >= 1 && < 2.4 , bytestring >= 0.9 && < 1.0 , base64-bytestring >= 1 && < 1.3 , colour >= 2.3 && < 2.4 , diagrams-core >= 1.4 && < 1.6 , diagrams-lib >= 1.4.5 && < 1.5 , monoid-extras >= 0.3 && < 0.7 , svg-builder >= 0.1 && < 0.2 , text >= 0.11 && < 2.2 , JuicyPixels >= 3.1.5 && < 3.4 , split >= 0.1.2 && < 0.3 , containers >= 0.3 && < 0.8 , lens >= 4.0 && < 5.4 , hashable >= 1.1 && < 1.6 , optparse-applicative >= 0.13 && < 0.19 , semigroups >= 0.13 && < 0.21 Ghc-options: -Wall Default-language: Haskell2010 diagrams-svg-1.4.3.2/src/Diagrams/Backend/0000755000000000000000000000000007346545000016301 5ustar0000000000000000diagrams-svg-1.4.3.2/src/Diagrams/Backend/SVG.hs0000644000000000000000000004161607346545000017304 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ---------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.SVG -- Copyright : (c) 2011-2015 diagrams-svg team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- A full-featured rendering backend for diagrams producing SVG files, -- implemented natively in Haskell (making it easy to use on any -- platform). -- -- To invoke the SVG backend, you have three options. -- -- * You can use the "Diagrams.Backend.SVG.CmdLine" module to create -- standalone executables which output SVG images when invoked. -- -- * You can use the 'renderSVG' or 'renderPretty' functions provided by -- this module, which give you more flexible programmatic control over when -- and how images are output (making it easy to, for example, write a -- single program that outputs multiple images, or one that outputs -- images dynamically based on user input, and so on). The only -- difference between the two functions is that 'renderPretty', pretty -- prints the SVG output. -- -- * For the most flexibility (/e.g./ if you want access to the -- resulting SVG value directly in memory without writing it to -- disk), you can manually invoke the 'renderDia' method from the -- 'Diagrams.Core.Types.Backend' instance for @SVG@. In particular, -- 'Diagrams.Core.Types.renderDia' has the generic type -- -- > renderDia :: b -> Options b v n -> QDiagram b v n m -> Result b v n -- -- (omitting a few type class constraints). @b@ represents the -- backend type, @v@ the vector space, @n@ the numerical field, and @m@ the -- type of monoidal query annotations on the diagram. 'Options' and 'Result' -- are associated data and type families, respectively, which yield the -- type of option records and rendering results specific to any -- particular backend. For @b ~ SVG@, @v ~ V2@, we have -- -- >data Options SVG V2 n = SVGOptions -- > { _size :: SizeSpec V2 n -- ^ The requested size. -- > , _svgDefinitions :: Maybe Element -- > -- ^ Custom definitions that will be added to the @defs@ -- > -- section of the output. -- > , _idPrefix :: T.Text -- > , _svgAttributes :: [Attribute] -- > -- ^ Attributes to apply to the entire svg element. -- > , _generateDoctype :: Bool -- > } -- -- @ -- data family Render SVG V2 n = R 'SvgRenderM n' -- @ -- -- @ -- type family Result SVG V2 n = 'Element' -- @ -- -- So the type of 'renderDia' resolves to -- -- @ -- renderDia :: SVG -> Options SVG V2 n -> QDiagram SVG V2 n m -> 'Graphics.Rendering.SVG.Element' -- @ -- -- which you could call like @renderDia SVG (SVGOptions (mkWidth 250) -- Nothing "" [] True) myDiagram@ (if you have the 'OverloadedStrings' extension -- enabled; otherwise you can use 'Text.pack ""'). (In some -- situations GHC may not be able to infer the type @m@, in which case -- you can use a type annotation to specify it; it may be useful to -- simply use the type synonym @Diagram SVG = QDiagram SVG V2 Double -- Any@.) This returns an 'Graphics.Svg.Core.Element' value, which -- you can, /e.g./ render to a 'ByteString' using 'Graphics.Svg.Core.renderBS' -- from the 'svg-builder' package. -- ----------------------------------------------------------------------------- module Diagrams.Backend.SVG ( SVG(..) -- rendering token , B -- for rendering options specific to SVG , Options(..), sizeSpec, svgDefinitions, idPrefix, svgAttributes, generateDoctype , svgClass, svgId, svgTitle , SVGFloat , renderSVG , renderSVG' , renderPretty , renderPretty' , loadImageSVG ) where -- from JuicyPixels import Codec.Picture (decodeImage, encodeDynamicPng) import Codec.Picture.Types (DynamicImage (ImageYCbCr8), dynamicMap, imageHeight, imageWidth) #if __GLASGOW_HASKELL__ < 710 import Data.Foldable as F (foldMap) #endif import qualified Data.Text as T import Data.Text.Lazy.IO as LT import Data.Tree import System.FilePath -- from base import Control.Monad.Reader import Control.Monad.State import Data.Char import Data.Function (on) import Data.Typeable -- from hashable import Data.Hashable (Hashable (), hashWithSalt) -- from bytestring import qualified Data.ByteString as SBS import qualified Data.ByteString.Lazy as BS -- from lens import Control.Lens hiding (transform, ( # )) -- from diagrams-core import Diagrams.Core.Compile import Diagrams.Core.Types (Annotation (..), keyVal) -- from diagrams-lib 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)) import Diagrams.TwoD.Text -- from svg-builder import Graphics.Svg hiding ((<>)) -- from this package import Graphics.Rendering.SVG (SVGFloat) import qualified Graphics.Rendering.SVG as R -- | @SVG@ is simply a token used to identify this rendering backend -- (to aid type inference). data SVG = SVG deriving (Show, Typeable) type B = SVG type instance V SVG = V2 type instance N SVG = Double data Environment n = Environment { _style :: Style V2 n , __pre :: T.Text } makeLenses ''Environment data SvgRenderState = SvgRenderState { _clipPathId :: Int , _fillGradId :: Int , _lineGradId :: Int } makeLenses ''SvgRenderState initialEnvironment :: SVGFloat n => T.Text -> Environment n initialEnvironment = Environment (mempty # recommendFillColor transparent) -- Fill gradients ids are even, line gradient ids are odd. initialSvgRenderState :: SvgRenderState initialSvgRenderState = SvgRenderState 0 0 1 -- | Monad to keep track of environment and state when rendering an SVG. type SvgRenderM n = ReaderT (Environment n) (State SvgRenderState) Element runRenderM :: SVGFloat n => T.Text -> SvgRenderM n -> Element runRenderM o s = flip evalState initialSvgRenderState $ runReaderT s (initialEnvironment o) instance Semigroup (Render SVG V2 n) where R r1 <> R r2_ = R $ do svg1 <- r1 svg2 <- r2_ return (svg1 `mappend` svg2) instance Monoid (Render SVG V2 n) where mempty = R $ return mempty #if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif -- Handle clip attributes. -- renderSvgWithClipping :: forall n. SVGFloat n => T.Text -> Element -- ^ Input SVG -> Style V2 n -- ^ Styles -> SvgRenderM n -- ^ Resulting svg renderSvgWithClipping prefix svg s = case op Clip <$> getAttr s of Nothing -> return svg Just paths -> renderClips paths where renderClips :: [Path V2 n] -> SvgRenderM n renderClips [] = return svg renderClips (p:ps) = do clipPathId += 1 ident <- use clipPathId R.renderClip p prefix ident <$> renderClips ps -- | Create a new texture defs svg element using the style and the current -- id number, then increment the gradient id number. fillTextureDefs :: SVGFloat n => Style v n -> SvgRenderM n fillTextureDefs s = do ident <- use fillGradId fillGradId += 2 -- always even return $ R.renderFillTextureDefs ident s lineTextureDefs :: SVGFloat n => Style v n -> SvgRenderM n lineTextureDefs s = do ident <- use lineGradId lineGradId += 2 -- always odd return $ R.renderLineTextureDefs ident s instance SVGFloat n => Backend SVG V2 n where newtype Render SVG V2 n = R (SvgRenderM n) type Result SVG V2 n = Element data Options SVG V2 n = SVGOptions { _size :: SizeSpec V2 n -- ^ The requested size. , _svgDefinitions :: Maybe Element -- ^ Custom definitions that will be added to the @defs@ -- section of the output. , _idPrefix :: T.Text , _svgAttributes :: [Attribute] -- ^ Attriubtes to apply to the entire svg element. , _generateDoctype :: Bool } deriving Eq renderRTree :: SVG -> Options SVG V2 n -> RTree SVG V2 n Annotation -> Result SVG V2 n renderRTree _ opts rt = runRenderM (opts ^.idPrefix) svgOutput where svgOutput = do let R r = rtree (splitTextureFills rt) V2 w h = specToSize 100 (opts^.sizeSpec) svg <- r return $ R.svgHeader w h (opts^.svgDefinitions) (opts^.svgAttributes) (opts^.generateDoctype) svg adjustDia c opts d = ( sz, t <> reflectionY, d' ) where (sz, t, d') = adjustDia2D sizeSpec c opts (d # reflectY) 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 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 } -- | Lens onto the svg definitions of the svg options. svgDefinitions :: Lens' (Options SVG V2 n) (Maybe Element) svgDefinitions f opts = f (_svgDefinitions opts) <&> \ds -> opts { _svgDefinitions = ds } -- | Lens onto the idPrefix of the svg options. This is the prefix given -- to clipping paths to distinguish them from other svg files in the -- same web page. idPrefix :: Lens' (Options SVG V2 n) T.Text idPrefix f opts = f (_idPrefix opts) <&> \i -> opts { _idPrefix = i } -- | Lens onto the svgAttributes field of the svg options. This field -- is provided to supply SVG attributes to the entire diagram. svgAttributes :: Lens' (Options SVG V2 n) [Attribute] svgAttributes f opts = f (_svgAttributes opts) <&> \ds -> opts { _svgAttributes = ds } -- | Lens onto the generateDoctype field of the svg options. Set -- to False if you don't want a doctype tag included in the output. generateDoctype :: Lens' (Options SVG V2 n) Bool generateDoctype f opts = f (_generateDoctype opts) <&> \ds -> opts { _generateDoctype = ds } -- paths --------------------------------------------------------------- attributedRender :: SVGFloat n => Element -> SvgRenderM n attributedRender svg = do SvgRenderState _idClip idFill idLine <- get Environment sty preT <- ask clippedSvg <- renderSvgWithClipping preT svg sty lineGradDefs <- lineTextureDefs sty fillGradDefs <- fillTextureDefs sty return $ do let gDefs = mappend fillGradDefs lineGradDefs gDefs `mappend` g_ (R.renderStyles idFill idLine sty) clippedSvg instance SVGFloat n => Renderable (Path V2 n) SVG where render _ = R . attributedRender . R.renderPath instance SVGFloat n => Renderable (Text n) SVG where render _ t@(Text tTxt _ _) = R $ do let svg = R.renderText t SvgRenderState _idClip idFill idLine <- get Environment sty preT <- ask clippedSvg <- renderSvgWithClipping preT svg sty -- SVG applies the text transform to the gradient before rendering. -- This means we need to apply the inverse of the text transform -- first, being careful about how we use reflectionY to handle SVG's -- coordinates. let adjustTrans :: Maybe (FillTexture n) -> Maybe (FillTexture n) adjustTrans = _Just . _FillTexture . committed . _LG . lGradTrans %~ \tGrad -> inv (tTxt <> reflectionY) <> tGrad <> reflectionY fillGradDefs <- fillTextureDefs (sty & atAttr %~ adjustTrans) return $ fillGradDefs `mappend` g_ (R.renderStyles idFill idLine sty) clippedSvg instance SVGFloat n => Renderable (DImage n Embedded) SVG where render _ = R . return . R.renderDImageEmb -- | Render a diagram as an SVG, writing to the specified output file -- and using the requested size. renderSVG :: SVGFloat n => FilePath -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO () renderSVG outFile spec = renderSVG' outFile (SVGOptions spec Nothing (mkPrefix outFile) [] True) -- | Render a diagram as a pretty printed SVG. renderPretty :: SVGFloat n => FilePath -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO () renderPretty outFile spec = renderPretty' outFile (SVGOptions spec Nothing (mkPrefix outFile)[] True) -- Create a prefile using the basename of the output file. Only standard -- letters are considered. mkPrefix :: FilePath -> T.Text mkPrefix = T.filter isAlpha . T.pack . takeBaseName -- | Render a diagram as an SVG, writing to the specified output file -- and using the backend options. The id prefix is derived from the -- basename of the output file. renderSVG' :: SVGFloat n => FilePath -> Options SVG V2 n -> QDiagram SVG V2 n Any -> IO () renderSVG' outFile opts = BS.writeFile outFile . renderBS . renderDia SVG opts -- | Render a diagram as a pretty printed SVG to the specified output -- file and using the backend options. The id prefix is derived from the -- basename of the output file. renderPretty' :: SVGFloat n => FilePath -> Options SVG V2 n -> QDiagram SVG V2 n Any -> IO () renderPretty' outFile opts = LT.writeFile outFile . prettyText . renderDia SVG opts data Img = Img !Char !BS.ByteString deriving Typeable -- | Load images (JPG/PNG/...) in a SVG specific way. loadImageSVG :: SVGFloat n => FilePath -> IO (QDiagram SVG V2 n Any) loadImageSVG fp = do raw <- SBS.readFile fp dyn <- eIO $ decodeImage raw let dat = BS.fromChunks [raw] let pic t d = return $ image (DImage (ImageNative (Img t d)) (dynamicMap imageWidth dyn) (dynamicMap imageHeight dyn) mempty) if | pngHeader `SBS.isPrefixOf` raw -> pic 'P' dat | jpgHeader `SBS.isPrefixOf` raw -> pic 'J' dat | otherwise -> case dyn of (ImageYCbCr8 _) -> pic 'J' dat _ -> pic 'P' =<< eIO (encodeDynamicPng dyn) where pngHeader :: SBS.ByteString pngHeader = SBS.pack [137, 80, 78, 71, 13, 10, 26, 10] jpgHeader :: SBS.ByteString jpgHeader = SBS.pack [0xFF, 0xD8] eIO :: Either String a -> IO a eIO = either fail return instance SVGFloat n => Renderable (DImage n (Native Img)) SVG where render _ di@(DImage (ImageNative (Img t d)) _ _ _) = R $ do mime <- case t of 'J' -> return "image/jpeg" 'P' -> return "image/png" _ -> error "Unknown mime type while rendering image" return $ R.renderDImage di $ R.dataUri mime d instance Hashable n => Hashable (Options SVG V2 n) where hashWithSalt s (SVGOptions sz defs ia sa gd) = s `hashWithSalt` sz `hashWithSalt` ds `hashWithSalt` ia `hashWithSalt` sa `hashWithSalt` gd where ds = fmap renderBS defs -- This is an orphan instance. Since Element is defined as a newtype -- of (HashMap Text Text -> Builder), it doesn't really make sense to -- define an Eq instance for it in general. However, as of -- hashable-1.4 an Eq superclass was added to Hashable, so in order to -- have a Hashable instance for Options SVG, we need to have a -- matching Eq instance. instance Eq Element where (==) = (==) `on` renderBS diagrams-svg-1.4.3.2/src/Diagrams/Backend/SVG/0000755000000000000000000000000007346545000016740 5ustar0000000000000000diagrams-svg-1.4.3.2/src/Diagrams/Backend/SVG/CmdLine.hs0000644000000000000000000001576507346545000020625 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.SVG.CmdLine -- Copyright : (c) 2013 Diagrams team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Convenient creation of command-line-driven executables for -- rendering diagrams using the SVG backend. -- -- * 'defaultMain' creates an executable which can render a single -- diagram at various options. -- -- * 'multiMain' is like 'defaultMain' but allows for a list of -- diagrams from which the user can choose one to render. -- -- * 'mainWith' is a generic form that does all of the above but with -- a slightly scarier type. See "Diagrams.Backend.CmdLine". This -- form can also take a function type that has a subtable final result -- (any of arguments to the above types) and 'Parseable' arguments. -- -- If you want to generate diagrams programmatically---/i.e./ if you -- want to do anything more complex than what the below functions -- provide---you have several options. -- -- * Use a function with 'mainWith'. This may require making -- 'Parseable' instances for custom argument types. -- -- * Make a new 'Mainable' instance. This may require a newtype -- wrapper on your diagram type to avoid the existing instances. -- This gives you more control over argument parsing, intervening -- steps, and diagram creation. -- -- * Build option records and pass them along with a diagram to 'mainRender' -- from "Diagrams.Backend.CmdLine". -- -- * You can use 'Diagrams.Backend.SVG.renderSVG' to render a diagram -- to a file directly; see "Diagrams.Backend.SVG". -- -- * A more flexible approach is to directly call 'renderDia'; see -- "Diagrams.Backend.SVG" for more information. -- -- For a tutorial on command-line diagram creation see -- . -- ----------------------------------------------------------------------------- module Diagrams.Backend.SVG.CmdLine ( -- * General form of @main@ -- $mainwith mainWith -- * Supported forms of @main@ , defaultMain , multiMain -- * Backend tokens , SVG , B ) where import Diagrams.Backend.CmdLine import Diagrams.Backend.SVG import Diagrams.Prelude hiding (height, interval, output, width) import Options.Applicative import Data.List.Split -- $mainwith -- The 'mainWith' method unifies all of the other forms of @main@ and is -- now the recommended way to build a command-line diagrams program. It -- works as a direct replacement for 'defaultMain' or 'multiMain' as well -- as allowing more general arguments. For example, given a function that -- produces a diagram when given an @Int@ and a @'Colour' Double@, 'mainWith' -- will produce a program that looks for additional number and color arguments. -- -- > ... definitions ... -- > f :: Int -> Colour Double -> Diagram SVG V2 Double -- > f i c = ... -- > -- > main = mainWith f -- -- We can run this program as follows: -- -- > $ ghc --make MyDiagram -- > -- > # output image.svg built by `f 20 red` -- > $ ./MyDiagram -o image.svg -w 200 20 red -- | This is the simplest way to render diagrams, and is intended to -- be used like so: -- -- > ... definitions ... -- > -- > main = defaultMain myDiagram -- -- Compiling this file will result in an executable which takes -- various command-line options for setting the size, output file, -- and so on, and renders @myDiagram@ with the specified options. -- -- Pass @--help@ to the generated executable to see all available -- options. Currently it looks something like -- -- @ -- ./Program -- -- Usage: ./Program [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] [--loop] [-s|--src ARG] [-i|--interval INTERVAL] [-p|--pretty] -- Command-line diagram generation. -- -- Available options: -- -?,--help Show this help text -- -w,--width WIDTH Desired WIDTH of the output image -- -h,--height HEIGHT Desired HEIGHT of the output image -- -o,--output OUTPUT OUTPUT file -- -l,--loop Run in a self-recompiling loop -- -s,--src ARG Source file to watch -- -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds. -- -p,--pretty Pretty print the SVG output -- @ -- -- For example, a common scenario is -- -- @ -- $ ghc --make MyDiagram -- -- # output image.svg with a width of 400pt (and auto-determined height) -- $ ./MyDiagram -o image.svg -w 400 -- @ defaultMain :: SVGFloat n => QDiagram SVG V2 n Any -> IO () defaultMain = mainWith newtype PrettyOpt = PrettyOpt {isPretty :: Bool} prettyOpt :: Parser PrettyOpt prettyOpt = PrettyOpt <$> switch (long "pretty" <> short 'p' <> help "Pretty print the SVG output") instance Parseable PrettyOpt where parser = prettyOpt instance SVGFloat n => Mainable (QDiagram SVG V2 n Any) where type MainOpts (QDiagram SVG V2 n Any) = (DiagramOpts, DiagramLoopOpts, PrettyOpt) mainRender (opts, loopOpts, pretty) d = do chooseRender opts pretty d defaultLoopRender loopOpts chooseRender :: SVGFloat n => DiagramOpts -> PrettyOpt -> QDiagram SVG V2 n Any -> IO () chooseRender opts pretty d = case splitOn "." (opts^.output) of [""] -> putStrLn "No output file given." ps | last ps `elem` ["svg"] -> do let szSpec = fromIntegral <$> mkSizeSpec2D (opts^.width) (opts^.height) if isPretty pretty then renderPretty (opts^.output) szSpec d else renderSVG (opts^.output) szSpec d | otherwise -> putStrLn $ "Unknown file type: " ++ last ps -- | @multiMain@ is like 'defaultMain', except instead of a single -- diagram it takes a list of diagrams paired with names as input. -- The generated executable then takes a @--selection@ option -- specifying the name of the diagram that should be rendered. The -- list of available diagrams may also be printed by passing the -- option @--list@. -- -- Example usage: -- -- @ -- $ ghc --make MultiTest -- [1 of 1] Compiling Main ( MultiTest.hs, MultiTest.o ) -- Linking MultiTest ... -- $ ./MultiTest --list -- Available diagrams: -- foo bar -- $ ./MultiTest --selection bar -o Bar.eps -w 200 -- @ multiMain :: SVGFloat n => [(String, QDiagram SVG V2 n Any)] -> IO () multiMain = mainWith instance SVGFloat n => Mainable [(String,QDiagram SVG V2 n Any)] where type MainOpts [(String,QDiagram SVG V2 n Any)] = (MainOpts (QDiagram SVG V2 n Any), DiagramMultiOpts) mainRender = defaultMultiMainRender diagrams-svg-1.4.3.2/src/Graphics/Rendering/0000755000000000000000000000000007346545000016700 5ustar0000000000000000diagrams-svg-1.4.3.2/src/Graphics/Rendering/SVG.hs0000644000000000000000000003542507346545000017704 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.SVG -- Copyright : (c) 2011 diagrams-svg team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Generic tools for generating SVG files. -- ----------------------------------------------------------------------------- module Graphics.Rendering.SVG ( SVGFloat , Element , AttributeValue , svgHeader , renderPath , renderClip , renderText , renderDImage , renderDImageEmb , renderStyles , renderMiterLimit , renderFillTextureDefs , renderFillTexture , renderLineTextureDefs , renderLineTexture , dataUri , getNumAttr ) where -- from base import Data.List (intercalate) #if __GLASGOW_HASKELL__ < 710 import Data.Foldable (foldMap) #endif import Data.Maybe (fromMaybe) #if !MIN_VERSION_base(4,11,0) import Data.Monoid #endif -- from diagrams-core import Diagrams.Core.Transform (matrixHomRep) -- from diagrams-lib import Diagrams.Prelude hiding (Attribute, Render, with, (<>)) import Diagrams.TwoD.Path (getFillRule) import Diagrams.TwoD.Text -- from text import Data.Text (pack) import qualified Data.Text as T -- from svg-builder import Graphics.Svg hiding (renderText) -- from base64-bytestring, bytestring import qualified Data.ByteString.Base64.Lazy as BS64 import qualified Data.ByteString.Lazy.Char8 as BS8 -- from JuicyPixels import Codec.Picture -- | Constaint on number type that diagrams-svg can use to render an SVG. This -- includes the common number types: Double, Float type SVGFloat n = (Show n, TypeableFloat n) -- Could we change Text.Blaze.SVG to use -- showFFloat :: RealFloat a => Maybe Int -> a -> ShowS -- or something similar for all numbers so we need TypeableFloat constraint. type AttributeValue = T.Text getNumAttr :: AttributeClass (a n) => (a n -> t) -> Style v n -> Maybe t getNumAttr f = (f <$>) . getAttr -- | @svgHeader w h defs s@: @w@ width, @h@ height, -- @defs@ global definitions for defs sections, @s@ actual SVG content. svgHeader :: SVGFloat n => n -> n -> Maybe Element -> [Attribute] -> Bool -> Element -> Element svgHeader w h defines attributes genDoctype s = dt <> with (svg11_ (defs_ [] ds <> s)) ([ Width_ <<- toText w , Height_ <<- toText h , Font_size_ <<- "1" , ViewBox_ <<- (pack . unwords $ map show [0, 0, w, h]) , Stroke_ <<- "rgb(0,0,0)" , Stroke_opacity_ <<- "1" ] ++ attributes ) where ds = fromMaybe mempty defines dt = if genDoctype then doctype else mempty renderPath :: SVGFloat n => Path V2 n -> Element renderPath trs = if makePath == T.empty then mempty else path_ [D_ <<- makePath] where makePath = foldMap renderTrail (op Path trs) renderTrail :: SVGFloat n => Located (Trail V2 n) -> AttributeValue renderTrail (viewLoc -> (P (V2 x y), t)) = mA x y <> withTrail renderLine renderLoop t where renderLine = foldMap renderSeg . lineSegments renderLoop lp = case loopSegments lp of -- let z handle the last segment if it is linear (segs, Linear _) -> foldMap renderSeg segs -- otherwise we have to emit it explicitly _ -> foldMap renderSeg (lineSegments . cutLoop $ lp) <> z renderSeg :: SVGFloat n => Segment Closed V2 n -> AttributeValue renderSeg (Linear (OffsetClosed (V2 x 0))) = hR x renderSeg (Linear (OffsetClosed (V2 0 y))) = vR y renderSeg (Linear (OffsetClosed (V2 x y))) = lR x y renderSeg (Cubic (V2 x0 y0) (V2 x1 y1) (OffsetClosed (V2 x2 y2))) = cR x0 y0 x1 y1 x2 y2 renderClip :: SVGFloat n => Path V2 n -> T.Text -> Int -> Element -> Element renderClip p prefix ident svg = do defs_ [] $ clipPath_ [Id_ <<- (clipPathId ident)] (renderPath p) <> g_ [Clip_path_ <<- ("url(#" <> clipPathId ident <> ")")] svg where clipPathId i = prefix <> "myClip" <> (pack . show $ i) renderStop :: SVGFloat n => GradientStop n -> Element renderStop (GradientStop c v) = stop_ [ Stop_color_ <<- (colorToRgbText c) , Offset_ <<- (toText v) , Stop_opacity_ <<- (toText $ colorToOpacity c) ] spreadMethodText :: SpreadMethod -> AttributeValue spreadMethodText GradPad = "pad" spreadMethodText GradReflect = "reflect" spreadMethodText GradRepeat = "repeat" renderLinearGradient :: SVGFloat n => LGradient n -> Int -> Element renderLinearGradient g i = linearGradient_ [ Id_ <<- (pack $ "gradient" ++ show i) , X1_ <<- toText x1 , Y1_ <<- toText y1 , X2_ <<- toText x2 , Y2_ <<- toText y2 , GradientTransform_ <<- mx , GradientUnits_ <<- "userSpaceOnUse" , SpreadMethod_ <<- spreadMethodText (g ^. lGradSpreadMethod) ] $ foldMap renderStop (g^.lGradStops) where mx = matrix a1 a2 b1 b2 c1 c2 [[a1, a2], [b1, b2], [c1, c2]] = matrixHomRep (g ^. lGradTrans) P (V2 x1 y1) = g ^. lGradStart P (V2 x2 y2) = g ^. lGradEnd renderRadialGradient :: SVGFloat n => RGradient n -> Int -> Element renderRadialGradient g i = radialGradient_ [ Id_ <<- (pack $ "gradient" ++ show i) , R_ <<- toText (g ^. rGradRadius1) , Cx_ <<- toText cx , Cy_ <<- toText cy , Fx_ <<- toText fx , Fy_ <<- toText fy , GradientTransform_ <<- mx , GradientUnits_ <<- "userSpaceOnUse" , SpreadMethod_ <<- spreadMethodText (g ^. rGradSpreadMethod) ] ( foldMap renderStop ss ) where mx = matrix a1 a2 b1 b2 c1 c2 [[a1, a2], [b1, b2], [c1, c2]] = matrixHomRep (g ^.rGradTrans) P (V2 cx cy) = g ^. rGradCenter1 P (V2 fx fy) = g ^. rGradCenter0 -- SVGs focal point is our inner center. -- Adjust the stops so that the gradient begins at the perimeter of -- the inner circle (center0, radius0) and ends at the outer circle. r0 = g ^. rGradRadius0 r1 = g ^. rGradRadius1 stopFracs = r0 / r1 : map (\s -> (r0 + (s ^. stopFraction) * (r1 - r0)) / r1) (g ^. rGradStops) gradStops = case g ^. rGradStops of [] -> [] xs@(x:_) -> x : xs ss = zipWith (\gs sf -> gs & stopFraction .~ sf ) gradStops stopFracs -- Create a gradient element so that it can be used as an attribute value for fill. renderFillTextureDefs :: SVGFloat n => Int -> Style v n -> Element renderFillTextureDefs i s = case getNumAttr getFillTexture s of Just (LG g) -> defs_ [] $ renderLinearGradient g i Just (RG g) -> defs_ [] $ renderRadialGradient g i _ -> mempty -- Render the gradient using the id set up in renderFillTextureDefs. renderFillTexture :: SVGFloat n => Int -> Style v n -> [Attribute] renderFillTexture ident s = case getNumAttr getFillTexture s of Just (SC (SomeColor c)) -> renderTextAttr Fill_ fillColorRgb <> renderAttr Fill_opacity_ fillColorOpacity where fillColorRgb = Just $ colorToRgbText c fillColorOpacity = Just $ colorToOpacity c Just (LG _) -> [Fill_ <<- ("url(#gradient" <> (pack . show $ ident) <> ")"), Fill_opacity_ <<- "1"] Just (RG _) -> [Fill_ <<- ("url(#gradient" <> (pack . show $ ident) <> ")"), Fill_opacity_ <<- "1"] Nothing -> [] renderLineTextureDefs :: SVGFloat n => Int -> Style v n -> Element renderLineTextureDefs i s = case getNumAttr getLineTexture s of Just (LG g) -> defs_ [] $ renderLinearGradient g i Just (RG g) -> defs_ [] $ renderRadialGradient g i _ -> mempty renderLineTexture :: SVGFloat n => Int -> Style v n -> [Attribute] renderLineTexture ident s = case getNumAttr getLineTexture s of Just (SC (SomeColor c)) -> renderTextAttr Stroke_ lineColorRgb <> renderAttr Stroke_opacity_ lineColorOpacity where lineColorRgb = Just $ colorToRgbText c lineColorOpacity = Just $ colorToOpacity c Just (LG _) -> [Stroke_ <<- ("url(#gradient" <> (pack . show $ ident) <> ")"), Stroke_opacity_ <<- "1"] Just (RG _) -> [Stroke_ <<- ("url(#gradient" <> (pack . show $ ident) <> ")"), Stroke_opacity_ <<- "1"] Nothing -> [] dataUri :: String -> BS8.ByteString -> AttributeValue dataUri mime dat = pack $ "data:"++mime++";base64," ++ BS8.unpack (BS64.encode dat) renderDImageEmb :: SVGFloat n => DImage n Embedded -> Element renderDImageEmb di@(DImage (ImageRaster dImg) _ _ _) = renderDImage di $ dataUri "image/png" img where img = case encodeDynamicPng dImg of Left str -> error str Right img' -> img' renderDImage :: SVGFloat n => DImage n any -> AttributeValue -> Element renderDImage (DImage _ w h tr) uridata = image_ [ Transform_ <<- transformMatrix , Width_ <<- (pack . show $ w) , Height_ <<- (pack . show $ h) , XlinkHref_ <<- uridata ] where [[a,b],[c,d],[e,f]] = matrixHomRep (tr `mappend` reflectionY `mappend` tX `mappend` tY) transformMatrix = matrix a b c d e f tX = translationX $ fromIntegral (-w)/2 tY = translationY $ fromIntegral (-h)/2 renderText :: SVGFloat n => Text n -> Element renderText (Text tt tAlign str) = text_ [ Transform_ <<- transformMatrix , Dominant_baseline_ <<- vAlign , Text_anchor_ <<- hAlign , Stroke_ <<- "none" ] $ toElement str where vAlign = case tAlign of BaselineText -> "alphabetic" BoxAlignedText _ h -> case h of -- A mere approximation h' | h' <= 0.25 -> "text-after-edge" h' | h' >= 0.75 -> "text-before-edge" _ -> "middle" hAlign = case tAlign of BaselineText -> "start" BoxAlignedText w _ -> case w of -- A mere approximation w' | w' <= 0.25 -> "start" w' | w' >= 0.75 -> "end" _ -> "middle" t = tt `mappend` reflectionY [[a,b],[c,d],[e,f]] = matrixHomRep t transformMatrix = matrix a b c d e f renderStyles :: SVGFloat n => Int -> Int -> Style v n -> [Attribute] renderStyles fillId lineId s = concatMap ($ s) $ [ renderLineTexture lineId , renderFillTexture fillId , renderLineWidth , renderLineCap , renderLineJoin , renderFillRule , renderDashing , renderOpacity , renderFontSize , renderFontSlant , renderFontWeight , renderFontFamily , renderMiterLimit ] renderMiterLimit :: Style v n -> [Attribute] renderMiterLimit s = renderAttr Stroke_miterlimit_ miterLimit where miterLimit = getLineMiterLimit <$> getAttr s renderOpacity :: Style v n -> [Attribute] renderOpacity s = renderAttr Opacity_ o where o = getOpacity <$> getAttr s renderFillRule :: Style v n -> [Attribute] renderFillRule s = renderTextAttr Fill_rule_ fr where fr = (fillRuleToText . getFillRule) <$> getAttr s fillRuleToText :: FillRule -> AttributeValue fillRuleToText Winding = "nonzero" fillRuleToText EvenOdd = "evenodd" renderLineWidth :: SVGFloat n => Style v n -> [Attribute] renderLineWidth s = renderAttr Stroke_width_ lWidth where lWidth = getNumAttr getLineWidth s renderLineCap :: Style v n -> [Attribute] renderLineCap s = renderTextAttr Stroke_linecap_ lCap where lCap = (lineCapToText . getLineCap) <$> getAttr s lineCapToText :: LineCap -> AttributeValue lineCapToText LineCapButt = "butt" lineCapToText LineCapRound = "round" lineCapToText LineCapSquare = "square" renderLineJoin :: Style v n -> [Attribute] renderLineJoin s = renderTextAttr Stroke_linejoin_ lj where lj = (lineJoinToText . getLineJoin) <$> getAttr s lineJoinToText :: LineJoin -> AttributeValue lineJoinToText LineJoinMiter = "miter" lineJoinToText LineJoinRound = "round" lineJoinToText LineJoinBevel = "bevel" renderDashing :: SVGFloat n => Style v n -> [Attribute] renderDashing s = renderTextAttr Stroke_dasharray_ arr <> renderAttr Stroke_dashoffset_ dOffset where getDasharray (Dashing a _) = a getDashoffset (Dashing _ o) = o dashArrayToStr = intercalate "," . map show -- Ignore dashing if dashing array is empty checkEmpty (Just (Dashing [] _)) = Nothing checkEmpty other = other dashing' = checkEmpty $ getNumAttr getDashing s arr = (pack . dashArrayToStr . getDasharray) <$> dashing' dOffset = getDashoffset <$> dashing' renderFontSize :: SVGFloat n => Style v n -> [Attribute] renderFontSize s = renderTextAttr Font_size_ fs where fs = pack <$> getNumAttr ((++ "px") . show . getFontSize) s renderFontSlant :: Style v n -> [Attribute] renderFontSlant s = renderTextAttr Font_style_ fs where fs = (fontSlantAttr . getFontSlant) <$> getAttr s fontSlantAttr :: FontSlant -> AttributeValue fontSlantAttr FontSlantItalic = "italic" fontSlantAttr FontSlantOblique = "oblique" fontSlantAttr FontSlantNormal = "normal" renderFontWeight :: Style v n -> [Attribute] renderFontWeight s = renderTextAttr Font_weight_ fw where fw = (fontWeightAttr . getFontWeight) <$> getAttr s fontWeightAttr :: FontWeight -> AttributeValue fontWeightAttr FontWeightNormal = "normal" fontWeightAttr FontWeightBold = "bold" fontWeightAttr FontWeightLighter = "lighter" fontWeightAttr FontWeightBolder = "bolder" fontWeightAttr FontWeightThin = "100" fontWeightAttr FontWeightUltraLight = "200" fontWeightAttr FontWeightLight = "300" fontWeightAttr FontWeightMedium = "400" fontWeightAttr FontWeightSemiBold = "600" fontWeightAttr FontWeightUltraBold = "800" fontWeightAttr FontWeightHeavy = "900" renderFontFamily :: Style v n -> [Attribute] renderFontFamily s = renderTextAttr Font_family_ ff where ff = (pack . getFont) <$> getAttr s -- | Render a style attribute if available, empty otherwise. renderAttr :: Show s => AttrTag -> Maybe s -> [Attribute] renderAttr attr valM = maybe [] (\v -> [(bindAttr attr) (pack . show $ v)]) valM -- renderTextAttr :: (AttributeValue -> Attribute) -> Maybe AttributeValue -> [Attribute] renderTextAttr :: AttrTag -> Maybe AttributeValue -> [Attribute] renderTextAttr attr valM = maybe [] (\v -> [(bindAttr attr) v]) valM colorToRgbText :: forall c . Color c => c -> AttributeValue colorToRgbText c = T.concat [ "rgb(" , int r, "," , int g, "," , int b , ")" ] where int d = pack . show $ (round (d * 255) :: Int) (r,g,b,_) = colorToSRGBA c colorToOpacity :: forall c . Color c => c -> Double colorToOpacity c = a where (_,_,_,a) = colorToSRGBA c