diagrams-svg-1.4.0.3/ 0000755 0000000 0000000 00000000000 12754647364 012451 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/README.md 0000644 0000000 0000000 00000005215 12754647364 013733 0 ustar 00 0000000 0000000 diagrams-svg [](https://hackage.haskell.org/package/diagrams-svg) [](http://travis-ci.org/diagrams/diagrams-svg)
------------
_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 = 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.0.3/diagrams-svg.cabal 0000644 0000000 0000000 00000006216 12754647364 016026 0 ustar 00 0000000 0000000 Name: diagrams-svg
Version: 1.4.0.3
Synopsis: SVG backend for diagrams drawing EDSL.
Homepage: http://projects.haskell.org/diagrams/
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 == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.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
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.3 && < 4.10
, old-time
, process
, directory
, filepath
, mtl >= 1 && < 2.3
, bytestring >= 0.9 && < 1.0
, base64-bytestring >= 1 && < 1.1
, colour
, diagrams-core >= 1.3 && < 1.4
, diagrams-lib >= 1.3 && < 1.4
, monoid-extras >= 0.3 && < 0.5
, svg-builder >= 0.1 && < 0.2
, text >= 0.11 && < 1.3
, JuicyPixels >= 3.1.5 && < 3.3
, split >= 0.1.2 && < 0.3
, time
, containers >= 0.3 && < 0.6
, lens >= 4.0 && < 4.15
, hashable >= 1.1 && < 1.3
, optparse-applicative >= 0.10 && < 0.14
, semigroups >= 0.13 && < 0.19
if impl(ghc < 7.6)
build-depends: ghc-prim
Ghc-options: -Wall
Default-language: Haskell2010
diagrams-svg-1.4.0.3/Setup.hs 0000644 0000000 0000000 00000000110 12754647364 014075 0 ustar 00 0000000 0000000 #!/usr/bin/env runhaskell
import Distribution.Simple
main = defaultMain
diagrams-svg-1.4.0.3/CHANGELOG.md 0000644 0000000 0000000 00000036757 12754647364 014304 0 ustar 00 0000000 0000000 ## [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.0.3/LICENSE 0000644 0000000 0000000 00000004014 12754647364 013455 0 ustar 00 0000000 0000000 Copyright 2011-2014 diagrams-svg team:
Doug Beardsley
Daniel Bergey
Jan Bracker
Christopher Chalmers
Daniil Frumin
Deepak Jois
Felipe Lessa
Chris Mears
Jeffrey Rosenbluth
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.0.3/src/ 0000755 0000000 0000000 00000000000 12754647364 013240 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/src/Diagrams/ 0000755 0000000 0000000 00000000000 12754647364 014767 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/src/Diagrams/Backend/ 0000755 0000000 0000000 00000000000 12754647364 016316 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/src/Diagrams/Backend/SVG.hs 0000644 0000000 0000000 00000035220 12754647364 017313 0 ustar 00 0000000 0000000 {-# 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 #-}
{-# LANGUAGE UndecidableInstances #-}
-- UndecidableInstances needed for ghc < 707
----------------------------------------------------------------------------
-- |
-- 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]
-- > -- ^ Attriubtes 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
, SVGFloat
, renderSVG
, renderSVG'
, renderPretty
, renderPretty'
, loadImageSVG
) where
-- from JuicyPixels
import Codec.Picture
import Codec.Picture.Types (dynamicMap)
#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.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 (..))
-- from diagrams-lib
import Diagrams.Prelude hiding (Attribute, size, view, local)
import Diagrams.TwoD.Adjust (adjustDia2D)
import Diagrams.TwoD.Attributes (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 Monoid (Render SVG V2 n) where
mempty = R $ return mempty
R r1 `mappend` R r2_ = R $ do
svg1 <- r1
svg2 <- r2_
return (svg1 `mappend` svg2)
-- 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
}
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
_ -> R r
where
R r = foldMap rtree rs
-- | 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 _ = R . attributedRender . R.renderText
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"
_ -> fail "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
diagrams-svg-1.4.0.3/src/Diagrams/Backend/SVG/ 0000755 0000000 0000000 00000000000 12754647364 016755 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/src/Diagrams/Backend/SVG/CmdLine.hs 0000644 0000000 0000000 00000016114 12754647364 020627 0 ustar 00 0000000 0000000 {-# 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 hiding ((<>))
import qualified Options.Applicative as O ((<>))
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"
O.<> short 'p'
O.<> 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.0.3/src/Graphics/ 0000755 0000000 0000000 00000000000 12754647364 015000 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/src/Graphics/Rendering/ 0000755 0000000 0000000 00000000000 12754647364 016715 5 ustar 00 0000000 0000000 diagrams-svg-1.4.0.3/src/Graphics/Rendering/SVG.hs 0000644 0000000 0000000 00000034575 12754647364 017726 0 ustar 00 0000000 0000000 {-# 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)
import Data.Monoid
-- 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 lucid-svg
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, round w, round h] :: [Int]))
, 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"
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