diagrams-cairo 1.1.0.2 → 1.5
raw patch · 11 files changed
Files
- CHANGELOG.md +468/−0
- CHANGES.markdown +0/−212
- LICENSE +5/−1
- README.markdown +6/−1
- diagrams-cairo.cabal +34/−31
- src/Diagrams/Backend/Cairo.hs +30/−31
- src/Diagrams/Backend/Cairo/CmdLine.hs +51/−144
- src/Diagrams/Backend/Cairo/Internal.hs +231/−124
- src/Diagrams/Backend/Cairo/List.hs +6/−3
- src/Diagrams/Backend/Cairo/Ptr.hs +24/−18
- src/Diagrams/Backend/Cairo/Text.hs +35/−144
+ CHANGELOG.md view
@@ -0,0 +1,468 @@+## [v1.5](https://github.com/diagrams/diagrams-cairo/tree/v1.5) (2025-06-16)++- Allow `diagrams-lib-1.5` and remove `DiagramLoopOpts` which is no+ longer supported+- Allow `optparse-applicative-0.19`++## [v1.4.3](https://github.com/diagrams/diagrams-cairo/tree/v1.4.3) (2024-11-06)++- Require `data-default-0.8`++## [v1.4.2.1-r3](https://github.com/diagrams/diagrams-cairo/tree/v1.4.2.1-r3) (2024-08-13)++- Allow `base-4.20`, `containers-0.7`, `lens-5.3`, `hashable-1.5`+- Test on GHC 9.10++## [v1.4.2.1-r2](https://github.com/diagrams/diagrams-cairo/tree/v1.4.2.1-r2) (2024-02-13)++- Allow `base-4.19`+- Test on GHC 9.8++## [v1.4.2.1-r1](https://github.com/diagrams/diagrams-cairo/tree/v1.4.2.1-r1) (2023-08-16)++- Allow `bytestring-0.12`++## [v1.4.2.1](https://github.com/diagrams/diagrams-cairo/tree/v1.4.2.1) (2023-07-10)++- Allow `base-4.18`, `mtl-2.3`, `optparse-applicative-0.18`,+ `unix-2.8`+- Test with GHC 9.4 and 9.6++## [v1.4.2](https://github.com/diagrams/diagrams-cairo/tree/v1.4.2) (2022-01-26)++- Test with GHC 9.0 (requires `--allow-newer`)+- Allow `base-4.15`, `lens-5.1`, `bytestring-0.11`,+ `transformers-0.6`, `hashable-1.4`+- Add `Eq Options` instance required for `Hashable`++- r1 (6 Feb 2022): allow `optparse-applicative-0.17`+- r2 (19 Aug 2022): allow `vector-0.13`+- r3 (4 Jan 2023): allow `lens-5.2`, test with GHC 9.2, drop official support for GHC < 8.8++## [v1.4.1.1](https://github.com/diagrams/diagrams-cairo/tree/v1.4.1.1) (2019-01-11)++- Drop GHC 7.10 and 8.0 support+- Test with GHC 8.6 and 8.8++- r1: allow `lens-4.19` and `linear-1.21`+- r2: allow `base-4.14`, `diagrams-core-1.5`, `lens-5.0`,+ `optparse-applicative-0.16`++## [v1.4.1](https://github.com/diagrams/diagrams-cairo/tree/v1.4.1) (2018-05-17)++- Allow `base-4.11` and `lens-4.16`+- Add `Semigroup` instance for `Render Cairo V2 Double`+- Drop GHC 7.8 support++## [v1.4](https://github.com/diagrams/diagrams-cairo/tree/v1.4) (2016-10-26)++- No significant changes, just bumping version for diagrams 1.4+ release++- Allow `vector-0.12` (Hackage revision 1)+- Allow `base-4.10` and `optparse-applicative-0.14` (Hackage rev 2)++## [v1.3.1.2](https://github.com/diagrams/diagrams-cairo/tree/v1.3.1.2) (2016-08-22)++- Require `optparse-applicative-0.13` and fix compilation error++## [v1.3.1.1](https://github.com/diagrams/diagrams-cairo/tree/v1.3.1.1) (2016-08-16)++- Allow `optparse-applicative-0.13`++## [v1.3.1](https://github.com/diagrams/diagrams-cairo/tree/v1.3.1) (2016-06-16)++- Bump upper bounds to allow:+ - `base-4.9`+ - `data-default-class-0.1`+ - `transformers-0.5.x`++- New module `Diagrams.Backend.Cairo.Text` with better text support+ (based on `pango`)++## [v1.3.0.6](https://github.com/diagrams/diagrams-cairo/tree/v1.3.0.6) (2016-05-01)++- allow `lens-4.14`+- New module `Diagrams.Backend.Cairo.Text` (should have been minor+ version bump; if you want to depend on this module please use+ `diagrams-cairo-1.3.1` or later).++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.3.0.5...v1.3.0.6)++## [v1.3.0.5](https://github.com/diagrams/diagrams-cairo/tree/v1.3.0.5) (2015-09-29)++ - Allow `optparse-applicative-0.12`++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.3.0.4...v1.3.0.5)++## [v1.3.0.4](https://github.com/diagrams/diagrams-cairo/tree/v1.3.0.4) (2015-09-17)++ - Allow `lens-4.13`++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.3.0.3...v1.3.0.4)++## [v1.3.0.3](https://github.com/diagrams/diagrams-cairo/tree/v1.3.0.3) (2015-07-19)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.3.0.2...v1.3.0.3)++## [v1.3.0.2](https://github.com/diagrams/diagrams-cairo/tree/v1.3.0.2) (2015-05-26)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.3.0.1...v1.3.0.2)++## [v1.3.0.1](https://github.com/diagrams/diagrams-cairo/tree/v1.3.0.1)(2015-04-25)++**Fixed bug:**++- Reflection should be included in transformation returned by adjustDia [\#63](https://github.com/diagrams/diagrams-cairo/issues/63)++## [v1.3](https://github.com/diagrams/diagrams-cairo/tree/v1.3)(2015-04-19)++- allow `lens-4.9`+- update for `diagrams-1.3`++## [v1.2.0.7](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.7) (2015-04-04)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2.0.5...v1.2.0.7)++**Fixed bugs:**++- loop when rendering text [\#59](https://github.com/diagrams/diagrams-cairo/issues/59)++**Merged pull requests:**++- remove Text module [\#60](https://github.com/diagrams/diagrams-cairo/pull/60) ([bergey](https://github.com/bergey))++## [v1.2.0.6] () (2015-01-12)++- allow `lens-4.7`++## [v1.2.0.5](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.5) (2014-12-25)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2.0.4...v1.2.0.5)++## [v1.2.0.4](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.4) (2014-11-17)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2.0.3...v1.2.0.4)++**Closed issues:**++- expose gifRender [\#55](https://github.com/diagrams/diagrams-cairo/issues/55)++**Merged pull requests:**++- Bump lens upper version bounds [\#58](https://github.com/diagrams/diagrams-cairo/pull/58) ([RyanGlScott](https://github.com/RyanGlScott))++- Update for new measure and size spec. [\#57](https://github.com/diagrams/diagrams-cairo/pull/57) ([cchalmers](https://github.com/cchalmers))++- Diagram B [\#56](https://github.com/diagrams/diagrams-cairo/pull/56) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- port to linear instead of vector-space [\#54](https://github.com/diagrams/diagrams-cairo/pull/54) ([bergey](https://github.com/bergey))++## [v1.2.0.3](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.3) (2014-10-08)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2.0.2-1...v1.2.0.3)++**Fixed bugs:**++- --loop disables generating multiple files [\#50](https://github.com/diagrams/diagrams-cairo/issues/50)++**Merged pull requests:**++- loop using fsnotify [\#53](https://github.com/diagrams/diagrams-cairo/pull/53) ([bergey](https://github.com/bergey))++## [v1.2.0.2-1](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.2-1) (2014-09-08)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2.0.2...v1.2.0.2-1)++## [v1.2.0.2](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.2) (2014-09-07)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2.0.1...v1.2.0.2)++## [v1.2.0.1](https://github.com/diagrams/diagrams-cairo/tree/v1.2.0.1) (2014-08-22)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.2...v1.2.0.1)++**Closed issues:**++- Problems with yellow color in gif animation [\#51](https://github.com/diagrams/diagrams-cairo/issues/51)++## [v1.2](https://github.com/diagrams/diagrams-cairo/tree/v1.2) (2014-06-02)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.1.0.1...v1.2)++**New features**++- Much improved text support using the `pango` library instead of+ cairo's "toy" text API.++- Support for linear and radial gradients on strokes and fills.++**Fixed bugs:**++- textLineBoundedIO sometimes produces incorrect envelopes [\#19](https://github.com/diagrams/diagrams-cairo/issues/19)++**Closed issues:**++- Mac OS X/XQuartz: Can't render single letter [\#43](https://github.com/diagrams/diagrams-cairo/issues/43)++**Merged pull requests:**++- Pango [\#49](https://github.com/diagrams/diagrams-cairo/pull/49) ([bergey](https://github.com/bergey))++- fix text scaling [\#48](https://github.com/diagrams/diagrams-cairo/pull/48) ([byorgey](https://github.com/byorgey))++- DImage implemented [\#47](https://github.com/diagrams/diagrams-cairo/pull/47) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Units [\#46](https://github.com/diagrams/diagrams-cairo/pull/46) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Gradient [\#37](https://github.com/diagrams/diagrams-cairo/pull/37) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++## [v1.1.0.1](https://github.com/diagrams/diagrams-cairo/tree/v1.1.0.1) (2014-03-19)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.1...v1.1.0.1)++## [v1.1](https://github.com/diagrams/diagrams-cairo/tree/v1.1) (2014-03-09)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.0.1.2...v1.1)++**New features**++- It is now possible to directly output animated GIFs, using the+ `gifMain` function++**Closed issues:**++- Color conversions have huge impact on performance [\#44](https://github.com/diagrams/diagrams-cairo/issues/44)++**Merged pull requests:**++- Fix documentation typo \(subtable -\> suitable\) [\#45](https://github.com/diagrams/diagrams-cairo/pull/45) ([robx](https://github.com/robx))++## [v1.0.1.2](https://github.com/diagrams/diagrams-cairo/tree/v1.0.1.2) (2014-02-06)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.0.1.1...v1.0.1.2)++**Closed issues:**++- Build failure for GHC 7.4 [\#42](https://github.com/diagrams/diagrams-cairo/issues/42)++## [v1.0.1.1](https://github.com/diagrams/diagrams-cairo/tree/v1.0.1.1) (2014-01-30)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.0.1...v1.0.1.1)++## [v1.0.1](https://github.com/diagrams/diagrams-cairo/tree/v1.0.1) (2014-01-26)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v1.0...v1.0.1)++**Merged pull requests:**++- Add Hashable instance for Options Cairo R2 [\#41](https://github.com/diagrams/diagrams-cairo/pull/41) ([byorgey](https://github.com/byorgey))++- Making animated GIFs directly from diagrams using Cairo. [\#40](https://github.com/diagrams/diagrams-cairo/pull/40) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++## [v1.0](https://github.com/diagrams/diagrams-cairo/tree/v1.0) (2013-11-25)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v0.7...v1.0)++**New Features**++- Re-implement via new backend `RTree` interface.++- Use new command-line interface from `diagrams-lib`.++- Export `B` as an alias for `Cairo` token.++**Fixed bugs:**++- opacity does not affect text [\#15](https://github.com/diagrams/diagrams-cairo/issues/15)++**Merged pull requests:**++- Backend tree conversion [\#36](https://github.com/diagrams/diagrams-cairo/pull/36) ([byorgey](https://github.com/byorgey))++- Lens [\#35](https://github.com/diagrams/diagrams-cairo/pull/35) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++## [v0.7](https://github.com/diagrams/diagrams-cairo/tree/v0.7) (2013-08-09)++[Full Changelog](https://github.com/diagrams/diagrams-cairo/compare/v0.6...v0.7)++**New features**++- New `renderCairo` function for more convenient use of the cairo+ backend.++- Lots of Haddock documentation improvements.++**Fixed bugs:**++- Lines should not be filled [\#32](https://github.com/diagrams/diagrams-cairo/issues/32)++**Merged pull requests:**++- Updates for new trail API. [\#31](https://github.com/diagrams/diagrams-cairo/pull/31) ([byorgey](https://github.com/byorgey))++## [v0.6](https://github.com/diagrams/diagrams-cairo/tree/v0.6) (2012-12-12)++**New features**++- New `--list` option for `multiMain` to list all available diagrams++- Major documentation improvements++- New modules:++ + `Diagrams.Backend.Cairo.Ptr`, for rendering directly to buffers+ in memory++ + `Diagrams.Backend.Cairo.List`, for rendering to a list of lists+ of pixels.++**API changes**++- Removal of `StyleParam` from `Diagrams.Backend.Cairo.Text`, change+ functions in that module to accept `Style R2`. Usage can be fixed+ by applying these style functions to `mempty`.++- GTK rendering has been split out into a new package, diagrams-gtk.+++ The `Diagrams.Backend.Cairo.Gtk` module is now+ `Diagrams.Backend.Gtk` in the `diagrams-gtk` package.+++ The `CairoOptions` record has a new boolean `cairoBypassAdjust`+ option; when set, the backend should bypass calling `adjustDia2D`.+++ The GTK output type is gone.+++ There is a new `RenderOnly` output type, for when you don't+ care about the `IO` action but only want the cairo `Render` action.++**Fixed bugs:**++- old-time and 7.6 [\#21](https://github.com/diagrams/diagrams-cairo/issues/21)++- Use of deprecated 'try' function in Diagrams.Backend.Cairo.Internal [\#12](https://github.com/diagrams/diagrams-cairo/issues/12)++- Better error message when image file does not exist [\#11](https://github.com/diagrams/diagrams-cairo/issues/11)++- Path doesn't get resized correctly when no transformations are applied to it [\#6](https://github.com/diagrams/diagrams-cairo/issues/6)++- Make Cairo backend smarter about missing attributes [\#4](https://github.com/diagrams/diagrams-cairo/issues/4)++- Attribute transformations are not handled correctly when rendering [\#3](https://github.com/diagrams/diagrams-cairo/issues/3)++**Closed issues:**++- vector-space-0.8.5 breaks compilation [\#27](https://github.com/diagrams/diagrams-cairo/issues/27)++- ‘cairoBypassAdjust’ undocumented [\#23](https://github.com/diagrams/diagrams-cairo/issues/23)++- Improve diagrams-cairo documentation [\#10](https://github.com/diagrams/diagrams-cairo/issues/10)++**Merged pull requests:**++- Additional rendering functions, for Ptr Word8 and \[\[Colour a\]\] [\#25](https://github.com/diagrams/diagrams-cairo/pull/25) ([haasn](https://github.com/haasn))++- `old-time` to `time` [\#22](https://github.com/diagrams/diagrams-cairo/pull/22) ([fryguybob](https://github.com/fryguybob))++- split out gtk rendering into a separate package [\#20](https://github.com/diagrams/diagrams-cairo/pull/20) ([byorgey](https://github.com/byorgey))++- use requiredScaleT in place of deprecated adjustSize [\#17](https://github.com/diagrams/diagrams-cairo/pull/17) ([byorgey](https://github.com/byorgey))++- call setDefault2DAttributes even when bypassing size adjustments [\#16](https://github.com/diagrams/diagrams-cairo/pull/16) ([byorgey](https://github.com/byorgey))++## [v0.5.0.2]() (13 May 2012)++* Allow building under `mtl` 2.1.*++## [v0.5.0.1]() (9 March 2012)++* Remove statement in package description that a development version+ of `gtk2hs` must be used with GHC 7.4; this is no longer true as of+ the 0.12.3 release of `gtk2hs`.++## [v0.5]() (March 2012)++**New features**++- New `Diagrams.Backend.Cairo.Text` module by Michael Sloan, with+ functions for creating appropriately sized text objects by+ querying cairo for the size, and related supporting functions.++- Basic support for animation with `animMain` function, by+ generating frames sampled at regular intervals.++- Proper vertical alignment of default text based on font+ parameters (Michael Sloan).++- Requesting just a width or height now causes the other to be+ computed appropriately.++**API changes**++- Move `Diagrams.Backend.Cairo` to+ `Diagrams.Backend.Cairo.Internal` and export everything.+ `Diagrams.Backend.Cairo` now just re-exports selected functions+ from `Internal`. This allows anyone who wants access to the+ helper/utility functions to import `Internal`.++**Dependency/version changes**++- relax `cmdargs` upper bound++- GHC 7.4.1 compatibility: update `base`, `filepath`, and+ `old-time` upper bounds++**Bug fixes**++- [\#54](http://code.google.com/p/diagrams/issues/detail?id=54): Generate warning for missing image files (Ian Ross).++## [v0.4]() (22 October 2011)++* New features:++ + Support for drawing directly to Gtk widgets++ + Support for path fill rule attribute++* New/improved examples++* Improved documentation++* Bug fixes:++ + Warning for unsupported image types (#41)++## [v0.3]() (18 June 2011)++* Some new/improved examples++* New features:++ + simple text support++ + simple support for external PNG images++## [v0.2]() (3 June 2011)++* add `Typeable` and other instances for `Cairo` type++* generalize `Result` type to `(IO (), Render ())`, so programs that+ don't want to generate a file but just want a `Render` operation+ (*e.g.* to use to paint a gtk window) can use the second component.++* add support for opacity attribute and path clipping++## [v0.1.2]() (18 May 2011)++* link to new website++## [v0.1.1]() (18 May 2011)++* fix tic-tac-toe example++## [v0.1]() (17 May 2011)++* initial preview release+++\* *This Change Log was automatically generated by (and hand edited) [github_changelog_generator](https://github.com/skywinder/Github-Changelog-Generator)*
− CHANGES.markdown
@@ -1,212 +0,0 @@-1.1.0.2 (19 March 2014)------------------------- - Allow `lens-4.1`--1.1.0.1 (18 March 2014)-------------------------- - Allow `optparse-applicative-0.8`--1.1 (8 March 2014)---------------------* **New features**-- - It is now possible to directly output animated GIFs, using the- `gifMain` function.--* **Dependency/version changes**-- - allow `diagrams-core-1.1` and `diagrams-lib-1.1`- - allow `unix-2.7`- - allow `vector-0.10`--* **Bug fixes**-- - Don't explicitly draw final segment of a loop if it is straight- ([#38](https://github.com/diagrams/diagrams-cairo/issues/38))--1.0.1.2 (6 February 2014)---------------------------- - Require diagrams-lib >= 1.0.1--1.0.1.1: 30 January 2014--------------------------- - Work around bug in GHC 7.4.2, which can't derive Generic for associated- data types.--1.0.1: 26 January 2014------------------------- - Add `Hashable (Options Cairo R2)` instance--1.0: 25 November 2013------------------------ - Re-implement via new backend `RTree` interface.- - Use new command-line interface from `diagrams-lib`.- - Export `B` as an alias for `Cairo` token.--0.7: 9 August 2013---------------------* **New features**-- - New `renderCairo` function for more convenient use of the cairo- backend.- - Lots of Haddock documentation improvements.--* **New instances**-- - `Show` instance for `Options Cairo R2`.--0.6: 11 December 2012------------------------* **New features**-- - New `--list` option for `multiMain` to list all available diagrams-- - Major documentation improvements-- - New modules:-- + `Diagrams.Backend.Cairo.Ptr`, for rendering directly to buffers- in memory-- + `Diagrams.Backend.Cairo.List`, for rendering to a list of lists- of pixels.--* **API changes**-- - Removal of `StyleParam` from `Diagrams.Backend.Cairo.Text`, change- functions in that module to accept `Style R2`. Usage can be fixed- by applying these style functions to `mempty`.-- - GTK rendering has been split out into a new package, diagrams-gtk.-- + The `Diagrams.Backend.Cairo.Gtk` module is now- `Diagrams.Backend.Gtk` in the `diagrams-gtk` package.-- + The `CairoOptions` record has a new boolean `cairoBypassAdjust`- option; when set, the backend should bypass calling `adjustDia2D`.-- + The GTK output type is gone.-- + There is a new `RenderOnly` output type, for when you don't- care about the `IO` action but only want the cairo `Render` action.--* **Dependency/version changes**-- - Upper bounds relaxed to allow- `base`-4.6, `unix`-2.6, `cmdargs`-0.10, `split`-0.2.*, `mtl`-2.1-- - Add a dependency on `time`, and conditional compilation to use- either ClockTime or UTCTime depending on the version of the- `directory` package-- - Add dependency on `colour`-- - Lower bound on `cairo` raised to 0.12.4--* **Bug fixes**-- - Fixed looped compile mode, which was repeatedly trying to compile- when the code contained errors, instead of trying once and then- waiting for a change.-- - Fix a bug where default attributes were not being set when using- the "bypass" mode used by the gtk backend. ([\#16](https://github.com/diagrams/diagrams-cairo/pull/16))--0.5.0.2 : 13 May 2012------------------------* Allow building under `mtl` 2.1.*--0.5.0.1 : 9 March 2012-------------------------* Remove statement in package description that a development version- of `gtk2hs` must be used with GHC 7.4; this is no longer true as of- the 0.12.3 release of `gtk2hs`.--0.5: 9 March 2012--------------------* **New features**- - New `Diagrams.Backend.Cairo.Text` module by Michael Sloan, with- functions for creating appropriately sized text objects by- querying cairo for the size, and related supporting functions.- - Basic support for animation with `animMain` function, by- generating frames sampled at regular intervals.- - Proper vertical alignment of default text based on font- parameters (Michael Sloan).- - Requesting just a width or height now causes the other to be- computed appropriately.--* **API changes**- - Move `Diagrams.Backend.Cairo` to- `Diagrams.Backend.Cairo.Internal` and export everything.- `Diagrams.Backend.Cairo` now just re-exports selected functions- from `Internal`. This allows anyone who wants access to the- helper/utility functions to import `Internal`.--* **Dependency/version changes**- - relax `cmdargs` upper bound- - GHC 7.4.1 compatibility: update `base`, `filepath`, and- `old-time` upper bounds--* **Bug fixes**- - [\#54](http://code.google.com/p/diagrams/issues/detail?id=54): Generate warning for missing image files (Ian Ross).--0.4: 22 October 2011-----------------------* New features:- + Support for drawing directly to Gtk widgets- + Support for path fill rule attribute--* New/improved examples--* Improved documentation--* Bug fixes:- + Warning for unsupported image types (#41)--0.3: 18 June 2011--------------------* Some new/improved examples--* New features:- + simple text support- + simple support for external PNG images--0.2: 3 June 2011-------------------* add `Typeable` and other instances for `Cairo` type--* generalize `Result` type to `(IO (), Render ())`, so programs that- don't want to generate a file but just want a `Render` operation- (*e.g.* to use to paint a gtk window) can use the second component.--* add support for opacity attribute and path clipping--0.1.2: 18 May 2011---------------------* link to new website--0.1.1: 18 May 2011---------------------* fix tic-tac-toe example--0.1: 17 May 2011-------------------* initial preview release
LICENSE view
@@ -1,11 +1,15 @@-Copyright 2011-2013 diagrams-cairo team:+Copyright 2011-2015 diagrams-cairo team: Daniel Bergey <bergey@alum.mit.edu>+ Christopher Chalmers <c.chalmers@me.com> Sam Griffin <sam.griffin@gmail.com> Niklas Haas <nand@lavabit.com> John Lato <jwlato@gmail.com>+ Chris Mears <chris@cmears.id.au> Jeffrey Rosenbluth <Jeffrey.Rosenbluth@gmail.com> Ian Ross <ian@skybluetrades.net>+ Justus Sagemüller <sagemueller@geo.uni-koeln.de>+ Ryan Scott <ryan.gl.scott@ku.edu> Michael Sloan <mgsloan@gmail.com> Luite Stegeman <stegeman@gmail.com> Kanchalai Suveepattananont <ksuvee@seas.upenn.edu>
README.markdown view
@@ -1,4 +1,4 @@-[](http://travis-ci.org/diagrams/diagrams-cairo)+[](http://travis-ci.org/diagrams/diagrams-cairo) _diagrams-cairo_ is a rendering backend for [diagrams], a powerful, flexible, declarative domain-specific language for creating vector graphics,@@ -23,9 +23,14 @@ A simple example that uses _diagrams-cairo_ to draw a blue circle: ```haskell+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+ import Diagrams.Prelude import Diagrams.Backend.Cairo.CmdLine +d :: Diagram B d = circle 1 # fc blue main = mainWith (pad 1.1 d)
diagrams-cairo.cabal view
@@ -1,9 +1,18 @@ Name: diagrams-cairo-Version: 1.1.0.2+Version: 1.5 Synopsis: Cairo backend for diagrams drawing EDSL Description: A full-featured backend for rendering diagrams using the cairo rendering engine. .+ This ultimately depends on a C library, via+ Haskell's FFI, and can be difficult to install on+ some platforms. If you are just looking for a+ quick way to visualize diagrams, try the+ diagrams-svg backend; if you want raster output+ like PNG, try the diagrams-rasterific backend; if+ you want to embed diagrams in LaTeX documents,+ try diagrams-pgf.+ . * "Diagrams.Backend.Cairo.CmdLine" - if you're just getting started with diagrams, begin here. .@@ -15,17 +24,13 @@ Users should normally not need to import this module. .- * "Diagrams.Backend.Cairo.Text" - cairo-specific- text support, including automatic bounding- boxes.- . * "Diagrams.Backend.Cairo.List" - render diagrams to two-dimensional lists of colors (/i.e./ pixels). . * "Diagrams.Backend.Cairo.Ptr" - render diagrams to buffers in memory.-Homepage: http://projects.haskell.org/diagrams+Homepage: https://diagrams.github.io License: BSD3 License-file: LICENSE Author: Brent Yorgey@@ -33,9 +38,10 @@ Bug-reports: http://github.com/diagrams/diagrams-cairo/issues Category: Graphics Build-type: Simple-Cabal-version: >=1.10-Extra-source-files: CHANGES.markdown, README.markdown-Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1+Cabal-version: 2.0+Extra-source-files: README.markdown+Extra-doc-files: CHANGELOG.md+Tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 Source-repository head type: git location: http://github.com/diagrams/diagrams-cairo.git@@ -48,32 +54,29 @@ Diagrams.Backend.Cairo.Ptr Diagrams.Backend.Cairo.Text Hs-source-dirs: src- Build-depends: base >= 4.2 && < 4.8,- mtl >= 2.0 && < 2.2,- process,- directory,+ Build-depends: base >=4.2 && <4.21,+ mtl >=2.0 && <2.4, filepath,- old-time,- time,- diagrams-core >= 1.0 && < 1.2,- diagrams-lib >= 1.0.1 && < 1.2,- cairo >= 0.12.4 && < 0.13,+ diagrams-core >=1.3 && <1.6,+ diagrams-lib >=1.3 && <1.6,+ cairo >=0.12.4 && <0.14,+ pango >=0.12.5 && <0.14, colour,- split >= 0.1.2 && < 0.3,- containers >= 0.3 && < 0.6,- lens >= 3.8 && < 4.2,- data-default-class >= 0.0.1 && < 0.1,- statestack >= 0.2 && < 0.3,- JuicyPixels >= 3.1.3.2 && < 3.2,- vector >= 0.10.0 && < 0.11,- bytestring >= 0.9 && < 0.11,- optparse-applicative >= 0.7 && < 0.9,- hashable >= 1.1 && < 1.3- if impl(ghc < 7.6)- Build-depends: ghc-prim+ split >=0.1.2 && <0.3,+ containers >=0.3 && <0.8,+ lens >=3.8 && <5.4,+ data-default >=0.8 && <0.9,+ statestack >=0.2 && <0.4,+ JuicyPixels >=3.1.3.2 && <3.4,+ vector >=0.10.0 && <0.14,+ array >=0.4.0 && <0.6,+ bytestring >=0.9 && <0.12 || ^>=0.12.0,+ optparse-applicative >=0.13 && <0.20,+ transformers >=0.3 && <0.7,+ hashable >=1.1 && <1.6 default-language: Haskell2010 if !os(windows) cpp-options: -DCMDLINELOOP- Build-depends: unix >= 2.4 && < 2.8+ Build-depends: unix >=2.4 && <2.9
src/Diagrams/Backend/Cairo.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeFamilies, CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- |@@ -26,36 +27,37 @@ -- 'Diagrams.Core.Types.Backend' instance for @Cairo@. In particular, -- 'Diagrams.Core.Types.renderDia' has the generic type ----- > renderDia :: b -> Options b v -> QDiagram b v m -> Result b v+-- > 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, 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 ~ Cairo@ and @v ~ R2@, we have+-- backend type, @v@ the vector space, @n@ the numeric 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 ~ Cairo@, @v ~ V2@, and+-- @n ~ Double@, we have ----- > data family Options Cairo R2 = CairoOptions--- > { _cairoFileName :: String -- ^ The name of the file you want generated--- > , _cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output--- > , _cairoOutputType :: OutputType -- ^ the output format and associated options--- > , _cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering?+-- > data family Options Cairo V2 Double = CairoOptions+-- > { _cairoFileName :: String -- ^ The name of the file you want generated+-- > , _cairoSizeSpec :: SizeSpec V2 Double -- ^ The requested size of the output+-- > , _cairoOutputType :: OutputType -- ^ the output format and associated options+-- > , _cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? -- > } -- -- @--- type family Result Cairo R2 = (IO (), 'Graphics.Rendering.Cairo.Render' ())+-- type family Result Cairo V2 Double = (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- -- So the type of 'renderDia' resolves to -- -- @--- renderDia :: Cairo -> Options Cairo R2 -> QDiagram Cairo R2 m -> (IO (), 'Graphics.Rendering.Cairo.Render' ())+-- renderDia :: Cairo -> Options Cairo V2 Double -> QQDiagram Cairo V2 Double Any m -> (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- -- which you could call like so: -- -- @--- renderDia Cairo (CairoOptions \"foo.png\" (Width 250) PNG False) (myDiagram :: Diagram Cairo R2)+-- renderDia Cairo (CairoOptions \"foo.png\" (Width 250) PNG False) (myDiagram :: QDiagram Cairo V2 Double Any) -- @ -- -- This would return a pair; the first element is an @IO ()@ action@@ -63,7 +65,8 @@ -- rendering action which can be used, for example, to directly draw -- to a Gtk window. Note the type annotation on @myDiagram@ which may -- be necessary to fix the type variable @m@; this example uses the--- type synonym @Diagram b v = QDiagram b v Any@ to fix @m = Any@.+-- type synonym @Diagram b = QDiagram b (V b) (N b) Any@ to fix @m = Any@+-- and fix @v@ and @n@ to backend specific types. -- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo@@ -95,10 +98,10 @@ , B ) where -import System.FilePath (takeExtension)+import System.FilePath (takeExtension) -import Diagrams.Backend.Cairo.Internal-import Diagrams.Prelude+import Diagrams.Backend.Cairo.Internal+import Diagrams.Prelude -- $CairoOptions --@@ -106,21 +109,17 @@ -- associated data families, so we must just provide it manually. -- This module defines ----- > data family Options Cairo R2 = CairoOptions--- > { _cairoFileName :: String -- ^ The name of the file you want generated--- > , _cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output--- > , _cairoOutputType :: OutputType -- ^ the output format and associated options--- > }+-- > data family Options Cairo V2 Double = CairoOptions+-- > { _cairoFileName :: String -- ^ The name of the file you want generated+-- > , _cairoSizeSpec :: SizeSpec V2 Double -- ^ The requested size of the output+-- > , _cairoOutputType :: OutputType -- ^ the output format and associated options+-- > , _cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering?+-- > } -- -- See the documentation at the top of "Diagrams.Backend.Cairo" for -- information on how to make use of this.------ /Important note/: a bug in GHC 7.0.x and 7.4.1 prevents--- re-exporting this data family. (Strangely, this bug seems to be--- present in 7.0 and 7.4 but not 7.2.) To bring CairoOptions into--- scope when using GHC 7.0.x or 7.4 you must import--- "Diagrams.Backend.Cairo.Internal". + -- | Render a diagram using the cairo backend, writing to the given -- output file and using the requested size. The output type (PNG, -- PS, PDF, or SVG) is determined automatically from the output file@@ -129,7 +128,7 @@ -- This function is provided as a convenience; if you need more -- flexibility than it provides, you can call 'renderDia' directly, -- as described above.-renderCairo :: FilePath -> SizeSpec2D -> Diagram Cairo R2 -> IO ()+renderCairo :: FilePath -> SizeSpec V2 Double -> QDiagram Cairo V2 Double Any -> IO () renderCairo outFile sizeSpec d = fst (renderDia Cairo (CairoOptions outFile sizeSpec outTy False) d) where
src/Diagrams/Backend/Cairo/CmdLine.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -54,7 +54,7 @@ -- information. -- -- For a tutorial on command-line diagram creation see--- <http://projects.haskell.org/diagrams/doc/cmdline.html>.+-- <https://diagrams.github.io/doc/cmdline.html>. -- ----------------------------------------------------------------------------- @@ -75,6 +75,7 @@ -- * GIF support , GifOpts(..)+ , gifRender -- * Backend tokens @@ -82,63 +83,40 @@ , B ) where -import Codec.Picture-import Codec.Picture.ColorQuant (defaultPaletteOptions)-import Data.Vector.Storable (unsafeFromForeignPtr0)-import Foreign.ForeignPtr.Safe (ForeignPtr)-import qualified Data.ByteString.Lazy as L (ByteString, writeFile)-import Data.Word (Word8)-import Options.Applicative--import Control.Lens ((^.), Lens', makeLenses)+import Codec.Picture+import Codec.Picture.ColorQuant (defaultPaletteOptions)+import qualified Data.ByteString.Lazy as L (ByteString, writeFile)+import Data.Vector.Storable (unsafeFromForeignPtr0)+import Data.Word (Word8)+import Options.Applicative -import Diagrams.Prelude hiding (width, height, interval, Image, (<>)- , option)-import Diagrams.Backend.Cairo-import Diagrams.Backend.Cairo.Ptr (renderForeignPtrOpaque)-import Diagrams.Backend.CmdLine+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Ptr (renderForeignPtrOpaque)+import Diagrams.Backend.CmdLine+import Diagrams.Prelude hiding (height, interval,+ option, output, width) -- Below hack is needed because GHC 7.0.x has a bug regarding export -- of data family constructors; see comments in Diagrams.Backend.Cairo #if __GLASGOW_HASKELL__ < 702 || __GLASGOW_HASKELL__ >= 704-import Diagrams.Backend.Cairo.Internal+import Diagrams.Backend.Cairo.Internal #endif -#if __GLASGOW_HASKELL__ < 706-import Prelude hiding (catch)+#if __GLASGOW_HASKELL__ < 710+import Foreign.ForeignPtr.Safe (ForeignPtr) #else-import Prelude+import Foreign.ForeignPtr (ForeignPtr) #endif -import Data.List.Split+import Data.List.Split -#ifdef CMDLINELOOP-import Data.Maybe (fromMaybe)-import Control.Monad (when, mplus)-import Control.Lens (_1)+-- | Extra options for animated GIFs.+data GifOpts = GifOpts { _dither :: Bool+ , _noLooping :: Bool+ , _loopRepeat :: Maybe Int} -import System.Environment (getArgs, getProgName)-import System.Directory (getModificationTime)-import System.Process (runProcess, waitForProcess)-import System.IO (openFile, hClose, IOMode(..),- hSetBuffering, BufferMode(..), stdout)-import System.Exit (ExitCode(..))-import Control.Concurrent (threadDelay)-import Control.Exception (catch, SomeException(..), bracket)+makeLenses ''GifOpts -import System.Posix.Process (executeFile)-#if MIN_VERSION_directory(1,2,0)-import Data.Time.Clock (UTCTime,getCurrentTime)-type ModuleTime = UTCTime-getModuleTime :: IO ModuleTime-getModuleTime = getCurrentTime-#else-import System.Time (ClockTime, getClockTime)-type ModuleTime = ClockTime-getModuleTime :: IO ModuleTime-getModuleTime = getClockTime-#endif-#endif -- $mainwith -- The 'mainWith' method unifies all of the other forms of @main@ and is now@@ -149,7 +127,7 @@ -- will produce a program that looks for additional number and color arguments. -- -- > ... definitions ...--- > f :: Int -> Colour Double -> Diagram Cairo R2+-- > f :: Int -> Colour Double -> Diagram Cairo -- > f i c = ... -- > -- > main = mainWith f@@ -211,30 +189,15 @@ -- $ ./MyDiagram -o dia.pdf -h 200 -w 200 -l -i 10 -- @ -defaultMain :: Diagram Cairo R2 -> IO ()+defaultMain :: QDiagram Cairo V2 Double Any -> IO () defaultMain = mainWith -#ifdef CMDLINELOOP-output' :: Lens' (MainOpts (Diagram Cairo R2)) FilePath-output' = _1 . output--instance Mainable (Diagram Cairo R2) where- type MainOpts (Diagram Cairo R2) = (DiagramOpts, DiagramLoopOpts)-- mainRender (opts,loopOpts) d = do- chooseRender opts d- when (loopOpts^.loop) (waitForChange Nothing loopOpts)-#else-output' :: Lens' (MainOpts (Diagram Cairo R2)) FilePath-output' = output--instance Mainable (Diagram Cairo R2) where- type MainOpts (Diagram Cairo R2) = DiagramOpts+instance Mainable (QDiagram Cairo V2 Double Any) where+ type MainOpts (QDiagram Cairo V2 Double Any) = DiagramOpts mainRender opts d = chooseRender opts d-#endif -chooseRender :: DiagramOpts -> Diagram Cairo R2 -> IO ()+chooseRender :: DiagramOpts -> QDiagram Cairo V2 Double Any -> IO () chooseRender opts d = case splitOn "." (opts ^. output) of [""] -> putStrLn "No output file given."@@ -249,9 +212,9 @@ Cairo ( CairoOptions (opts^.output)- (mkSizeSpec- (fromIntegral <$> opts ^. width )- (fromIntegral <$> opts ^. height)+ (fromIntegral <$> mkSizeSpec2D+ (opts ^. width )+ (opts ^. height) ) outTy False@@ -278,12 +241,12 @@ -- $ ./MultiTest --selection bar -o Bar.png -w 200 -- @ -multiMain :: [(String, Diagram Cairo R2)] -> IO ()+multiMain :: [(String, QDiagram Cairo V2 Double Any)] -> IO () multiMain = mainWith -instance Mainable [(String, Diagram Cairo R2)] where- type MainOpts [(String, Diagram Cairo R2)]- = (MainOpts (Diagram Cairo R2), DiagramMultiOpts)+instance Mainable [(String, QDiagram Cairo V2 Double Any)] where+ type MainOpts [(String, QDiagram Cairo V2 Double Any)]+ = (MainOpts (QDiagram Cairo V2 Double Any), DiagramMultiOpts) mainRender = defaultMultiMainRender @@ -303,62 +266,13 @@ -- -- The @--fpu@ option can be used to control how many frames will be -- output for each second (unit time) of animation.-animMain :: Animation Cairo R2 -> IO ()+animMain :: Animation Cairo V2 Double -> IO () animMain = mainWith -instance Mainable (Animation Cairo R2) where- type MainOpts (Animation Cairo R2) = (MainOpts (Diagram Cairo R2), DiagramAnimOpts)-- mainRender = defaultAnimMainRender output'--#ifdef CMDLINELOOP-waitForChange :: Maybe ModuleTime -> DiagramLoopOpts -> IO ()-waitForChange lastAttempt opts = do- prog <- getProgName- args <- getArgs- hSetBuffering stdout NoBuffering- go prog args lastAttempt- where go prog args lastAtt = do- threadDelay (1000000 * opts^.interval)- -- putStrLn $ "Checking... (last attempt = " ++ show lastAttempt ++ ")"- (newBin, newAttempt) <- recompile lastAtt prog (opts^.src)- if newBin- then executeFile prog False args Nothing- else go prog args $ newAttempt `mplus` lastAtt---- | @recompile t prog@ attempts to recompile @prog@, assuming the--- last attempt was made at time @t@. If @t@ is @Nothing@ assume--- the last attempt time is the same as the modification time of the--- binary. If the source file modification time is later than the--- last attempt time, then attempt to recompile, and return the time--- of this attempt. Otherwise (if nothing has changed since the--- last attempt), return @Nothing@. Also return a Bool saying--- whether a successful recompilation happened.-recompile :: Maybe ModuleTime -> String -> Maybe String -> IO (Bool, Maybe ModuleTime)-recompile lastAttempt prog mSrc = do- let errFile = prog ++ ".errors"- srcFile = fromMaybe (prog ++ ".hs") mSrc- binT <- maybe (getModTime prog) (return . Just) lastAttempt- srcT <- getModTime srcFile- if (srcT > binT)- then do- putStr "Recompiling..."- status <- bracket (openFile errFile WriteMode) hClose $ \h ->- waitForProcess =<< runProcess "ghc" ["--make", srcFile]- Nothing Nothing Nothing Nothing (Just h)-- if (status /= ExitSuccess)- then putStrLn "" >> putStrLn (replicate 75 '-') >> readFile errFile >>= putStr- else putStrLn "done."-- curTime <- getModuleTime- return (status == ExitSuccess, Just curTime)-- else return (False, Nothing)+instance Mainable (Animation Cairo V2 Double) where+ type MainOpts (Animation Cairo V2 Double) = (DiagramOpts, DiagramAnimOpts) - where getModTime f = catch (Just <$> getModificationTime f)- (\(SomeException _) -> return Nothing)-#endif+ mainRender opts d = defaultAnimMainRender chooseRender output opts d -- | @gifMain@ takes a list of diagram and delay time pairs and produces a -- command line program to generate an animated GIF, with options @GifOpts@.@@ -386,16 +300,9 @@ -- --looping-off Turn looping off -- --loop-repeat ARG Number of times to repeat -- @-gifMain :: [(Diagram Cairo R2, GifDelay)] -> IO ()+gifMain :: [(QDiagram Cairo V2 Double Any, GifDelay)] -> IO () gifMain = mainWith --- | Extra options for animated GIFs.-data GifOpts = GifOpts { _dither :: Bool- , _noLooping :: Bool- , _loopRepeat :: Maybe Int}--makeLenses ''GifOpts- -- | Command line parser for 'GifOpts'. -- @--dither@ turn dithering on. -- @--looping-off@ turn looping off, i.e play GIF once.@@ -408,12 +315,12 @@ <*> switch ( long "looping-off" <> help "Turn looping off" )- <*> ( optional . option )+ <*> ( optional . option auto ) ( long "loop-repeat" <> help "Number of times to repeat" ) -instance Mainable [(Diagram Cairo R2, GifDelay)] where- type MainOpts [(Diagram Cairo R2, GifDelay)] = (DiagramOpts, GifOpts)+instance Mainable [(QDiagram Cairo V2 Double Any, GifDelay)] where+ type MainOpts [(QDiagram Cairo V2 Double Any, GifDelay)] = (DiagramOpts, GifOpts) mainRender (dOpts, gOpts) ds = gifRender (dOpts, gOpts) ds @@ -425,7 +332,7 @@ encodeGifAnimation' :: [GifDelay] -> GifLooping -> Bool- -> [Image PixelRGB8] -> Either String (L.ByteString)+ -> [Image PixelRGB8] -> Either String L.ByteString encodeGifAnimation' delays looping dithering lst = encodeGifImages looping triples where@@ -444,7 +351,7 @@ | num == 0 || denom == 0 = i | otherwise = round (num / denom * fromIntegral i) -gifRender :: (DiagramOpts, GifOpts) -> [(Diagram Cairo R2, GifDelay)] -> IO ()+gifRender :: (DiagramOpts, GifOpts) -> [(QDiagram Cairo V2 Double Any, GifDelay)] -> IO () gifRender (dOpts, gOpts) lst = case splitOn "." (dOpts^.output) of [""] -> putStrLn "No output file given"@@ -461,7 +368,7 @@ Just n -> LoopingRepeat (fromIntegral n) dias = map fst lst delays = map snd lst- (diaWidth, diaHeight) = size2D (head dias)+ V2 diaWidth diaHeight = size (head dias) fPtrs <- mapM (renderForeignPtrOpaque w h) dias let imageRGB8s = map (imageRGB8FromUnsafePtr w h) fPtrs result = writeGifAnimation'@@ -473,4 +380,4 @@ case result of Left s -> putStrLn s Right io -> io- | otherwise -> putStrLn $ "File name must end with .gif"+ | otherwise -> putStrLn "File name must end with .gif"
src/Diagrams/Backend/Cairo/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-}@@ -5,8 +6,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -38,32 +41,38 @@ ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Internal where -import Diagrams.Core.Compile (RNode (..), RTree, toRTree)+import Diagrams.Core.Compile import Diagrams.Core.Transform -import Diagrams.Prelude hiding (opacity, view)+import Diagrams.Prelude hiding (font, opacity, view) import Diagrams.TwoD.Adjust (adjustDia2D, setDefault2DAttributes)-import Diagrams.TwoD.Image import Diagrams.TwoD.Path (Clip (Clip), getFillRule)-import Diagrams.TwoD.Size (requiredScaleT)-import Diagrams.TwoD.Text+import Diagrams.TwoD.Text hiding (font) import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM+import qualified Graphics.Rendering.Pango as P +import Codec.Picture+import Codec.Picture.Types (convertImage, packPixel,+ promoteImage)++ import Control.Exception (try)-import Control.Lens hiding (transform, ( # )) import Control.Monad (when)+import Control.Monad.IO.Class import qualified Control.Monad.StateStack as SS-import Control.Monad.Trans (lift, liftIO)-import Data.Default.Class+import Control.Monad.Trans (lift)+import qualified Data.Array.MArray as MA+import Data.Bits (rotateL, (.&.)) import qualified Data.Foldable as F-import Data.Hashable (Hashable(..))+import Data.Hashable (Hashable (..)) import Data.List (isSuffixOf) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Tree import Data.Typeable+import Data.Word (Word32) import GHC.Generics (Generic) -- | This data declaration is simply used as a token to distinguish@@ -76,6 +85,9 @@ type B = Cairo +type instance V Cairo = V2+type instance N Cairo = Double+ -- | Output types supported by cairo, including four different file -- types (PNG, PS, PDF, SVG). If you want to output directly to GTK -- windows, see the @diagrams-gtk@ package.@@ -94,7 +106,7 @@ -- | Custom state tracked in the 'RenderM' monad. data CairoState- = CairoState { _accumStyle :: Style R2+ = CairoState { _accumStyle :: Style V2 Double -- ^ The current accumulated style. , _ignoreFill :: Bool -- ^ Whether or not we saw any lines in the most@@ -133,60 +145,51 @@ restore :: RenderM () restore = liftC C.restore >> SS.restore -instance Backend Cairo R2 where- data Render Cairo R2 = C (RenderM ())- type Result Cairo R2 = (IO (), C.Render ())- data Options Cairo R2 = CairoOptions+instance Backend Cairo V2 Double where+ data Render Cairo V2 Double = C (RenderM ())+ type Result Cairo V2 Double = (IO (), C.Render ())+ data Options Cairo V2 Double = CairoOptions { _cairoFileName :: String -- ^ The name of the file you want generated- , _cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output+ , _cairoSizeSpec :: SizeSpec V2 Double -- ^ The requested size of the output , _cairoOutputType :: OutputType -- ^ the output format and associated options , _cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? }- deriving (Show)-- doRender _ (CairoOptions file size out _) (C r) = (renderIO, r')- where r' = runRenderM r- renderIO = do- let surfaceF s = C.renderWith s r'-- -- Everything except Dims is arbitrary. The backend- -- should have first run 'adjustDia' to update the- -- final size of the diagram with explicit dimensions,- -- so normally we would only expect to get Dims anyway.- (w,h) = case size of- Width w' -> (w',w')- Height h' -> (h',h')- Dims w' h' -> (w',h')- Absolute -> (100,100)-- case out of- PNG ->- C.withImageSurface C.FormatARGB32 (round w) (round h) $ \surface -> do- surfaceF surface- C.surfaceWriteToPNG surface file- PS -> C.withPSSurface file w h surfaceF- PDF -> C.withPDFSurface file w h surfaceF- SVG -> C.withSVGSurface file w h surfaceF- RenderOnly -> return ()+ deriving (Show, Eq) - -- renderData :: Monoid' m => b -> QDiagram b v m -> Render b v- renderData _ = renderRTree . toRTree+ renderRTree _ opts t = (renderIO, r)+ where+ r = runRenderM .runC . toRender $ t+ renderIO = do+ let surfaceF s = C.renderWith s r+ V2 w h = specToSize 1 (opts^.cairoSizeSpec)+ case opts^.cairoOutputType of+ PNG ->+ C.withImageSurface C.FormatARGB32 (round w) (round h) $ \surface -> do+ surfaceF surface+ C.surfaceWriteToPNG surface (opts^.cairoFileName)+ PS -> C.withPSSurface (opts^.cairoFileName) w h surfaceF+ PDF -> C.withPDFSurface (opts^.cairoFileName) w h surfaceF+ SVG -> C.withSVGSurface (opts^.cairoFileName) w h surfaceF+ RenderOnly -> return () adjustDia c opts d = if _cairoBypassAdjust opts- then (opts, d # setDefault2DAttributes)- else adjustDia2D _cairoSizeSpec- setCairoSizeSpec- c opts (d # reflectY)- where setCairoSizeSpec sz o = o { _cairoSizeSpec = sz }+ then (opts, mempty, d # setDefault2DAttributes)+ else let (opts', transformation, d') = adjustDia2D cairoSizeSpec c opts (d # reflectY)+ in (opts', transformation <> reflectionY, d') -runC :: Render Cairo R2 -> RenderM ()+runC :: Render Cairo V2 Double -> RenderM () runC (C r) = r -instance Monoid (Render Cairo R2) where+instance Semigroup (Render Cairo V2 Double) where+ C rd1 <> C rd2 = C (rd1 >> rd2)++instance Monoid (Render Cairo V2 Double) where mempty = C $ return ()- (C rd1) `mappend` (C rd2) = C (rd1 >> rd2)+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+#endif -instance Hashable (Options Cairo R2) where+instance Hashable (Options Cairo V2 Double) where hashWithSalt s (CairoOptions fn sz out adj) = s `hashWithSalt` fn `hashWithSalt`@@ -194,39 +197,34 @@ out `hashWithSalt` adj -renderRTree :: RTree Cairo R2 a -> Render Cairo R2-renderRTree (Node (RPrim accTr p) _) = render Cairo (transform accTr p)-renderRTree (Node (RStyle sty) ts) = C $ do+toRender :: RTree Cairo V2 Double a -> Render Cairo V2 Double+toRender (Node (RPrim p) _) = render Cairo p+toRender (Node (RStyle sty) rs) = C $ do save cairoStyle sty accumStyle %= (<> sty)- runC $ F.foldMap renderRTree ts- restore-renderRTree (Node (RFrozenTr tr) ts) = C $ do- save- liftC $ cairoTransf tr- runC $ F.foldMap renderRTree ts+ runC $ F.foldMap toRender rs restore-renderRTree (Node _ ts) = F.foldMap renderRTree ts+toRender (Node _ rs) = F.foldMap toRender rs -cairoFileName :: Lens' (Options Cairo R2) String+cairoFileName :: Lens' (Options Cairo V2 Double) String cairoFileName = lens (\(CairoOptions {_cairoFileName = f}) -> f) (\o f -> o {_cairoFileName = f}) -cairoSizeSpec :: Lens' (Options Cairo R2) SizeSpec2D+cairoSizeSpec :: Lens' (Options Cairo V2 Double) (SizeSpec V2 Double) cairoSizeSpec = lens (\(CairoOptions {_cairoSizeSpec = s}) -> s) (\o s -> o {_cairoSizeSpec = s}) -cairoOutputType :: Lens' (Options Cairo R2) OutputType+cairoOutputType :: Lens' (Options Cairo V2 Double) OutputType cairoOutputType = lens (\(CairoOptions {_cairoOutputType = t}) -> t) (\o t -> o {_cairoOutputType = t}) -cairoBypassAdjust :: Lens' (Options Cairo R2) Bool+cairoBypassAdjust :: Lens' (Options Cairo V2 Double) Bool cairoBypassAdjust = lens (\(CairoOptions {_cairoBypassAdjust = b}) -> b) (\o b -> o {_cairoBypassAdjust = b}) -- | Render an object that the cairo backend knows how to render.-renderC :: (Renderable a Cairo, V a ~ R2) => a -> RenderM ()+renderC :: (Renderable a Cairo, V a ~ V2, N a ~ Double) => a -> RenderM () renderC = runC . render Cairo -- | Get an accumulated style attribute from the render monad state.@@ -238,11 +236,10 @@ -- size, fill rule, line width, cap, join, and dashing). Other -- attributes (font face, slant, weight; fill color, stroke color, -- opacity) must be accumulated.-cairoStyle :: Style v -> RenderM ()+cairoStyle :: Style v Double -> RenderM () cairoStyle s = sequence_ . catMaybes $ [ handle clip- , handle fSize , handle lFillRule , handle lWidth , handle lCap@@ -252,7 +249,6 @@ where handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ()) handle f = f `fmap` getAttr s clip = mapM_ (\p -> cairoPath p >> liftC C.clip) . op Clip- fSize = liftC . C.setFontSize . getFontSize lFillRule = liftC . C.setFillRule . fromFillRule . getFillRule lWidth = liftC . C.setLineWidth . getLineWidth lCap = liftC . C.setLineCap . fromLineCap . getLineCap@@ -260,22 +256,18 @@ lDashing (getDashing -> Dashing ds offs) = liftC $ C.setDash ds offs -fromFontSlant :: FontSlant -> C.FontSlant-fromFontSlant FontSlantNormal = C.FontSlantNormal-fromFontSlant FontSlantItalic = C.FontSlantItalic-fromFontSlant FontSlantOblique = C.FontSlantOblique--fromFontWeight :: FontWeight -> C.FontWeight-fromFontWeight FontWeightNormal = C.FontWeightNormal-fromFontWeight FontWeightBold = C.FontWeightBold+fromFontSlant :: FontSlant -> P.FontStyle+fromFontSlant FontSlantNormal = P.StyleNormal+fromFontSlant FontSlantItalic = P.StyleItalic+fromFontSlant FontSlantOblique = P.StyleOblique --- | Apply the opacity from a style to a given color.-applyOpacity :: Color c => c -> Style v -> AlphaColour Double-applyOpacity c s = dissolve (fromMaybe 1 $ getOpacity <$> getAttr s) (toAlphaColour c)+fromFontWeight :: FontWeight -> P.Weight+fromFontWeight FontWeightBold = P.WeightBold+fromFontWeight _ = P.WeightNormal -- | Multiply the current transformation matrix by the given 2D -- transformation.-cairoTransf :: T2 -> C.Render ()+cairoTransf :: T2 Double -> C.Render () cairoTransf t = C.transform m where m = CM.Matrix a1 a2 b1 b2 c1 c2 (unr2 -> (a1,a2)) = apply t unitX@@ -296,14 +288,14 @@ fromFillRule Winding = C.FillRuleWinding fromFillRule EvenOdd = C.FillRuleEvenOdd -instance Renderable (Segment Closed R2) Cairo where+instance Renderable (Segment Closed V2 Double) Cairo where render _ (Linear (OffsetClosed v)) = C . liftC $ uncurry C.relLineTo (unr2 v) render _ (Cubic (unr2 -> (x1,y1)) (unr2 -> (x2,y2)) (OffsetClosed (unr2 -> (x3,y3)))) = C . liftC $ C.relCurveTo x1 y1 x2 y2 x3 y3 -instance Renderable (Trail R2) Cairo where+instance Renderable (Trail V2 Double) Cairo where render _ = withTrail renderLine renderLoop where renderLine ln = C $ do@@ -322,20 +314,19 @@ liftC C.closePath -instance Renderable (Path R2) Cairo where+instance Renderable (Path V2 Double) Cairo where render _ p = C $ do cairoPath p-- f <- getStyleAttrib (toAlphaColour . getFillColor)- s <- getStyleAttrib (toAlphaColour . getLineColor)+ f <- getStyleAttrib getFillTexture+ s <- getStyleAttrib getLineTexture ign <- use ignoreFill- setSourceColor f+ setTexture f when (isJust f && not ign) $ liftC C.fillPreserve- setSourceColor s+ setTexture s liftC C.stroke -- Add a path to the Cairo context, without stroking or filling it.-cairoPath :: Path R2 -> RenderM ()+cairoPath :: Path V2 Double -> RenderM () cairoPath (Path trs) = do liftC C.newPath ignoreFill .= False@@ -345,19 +336,54 @@ liftC $ uncurry C.moveTo p renderC tr +addStop :: MonadIO m => C.Pattern -> GradientStop Double -> m ()+addStop p s = C.patternAddColorStopRGBA p (s^.stopFraction) r g b a+ where+ (r,g,b,a) = colorToSRGBA (s^.stopColor)++cairoSpreadMethod :: SpreadMethod -> C.Extend+cairoSpreadMethod GradPad = C.ExtendPad+cairoSpreadMethod GradReflect = C.ExtendReflect+cairoSpreadMethod GradRepeat = C.ExtendRepeat+ -- XXX should handle opacity in a more straightforward way, using -- cairo's built-in support for transparency? See also -- https://github.com/diagrams/diagrams-cairo/issues/15 .-setSourceColor :: Maybe (AlphaColour Double) -> RenderM ()-setSourceColor Nothing = return ()-setSourceColor (Just c) = do+setTexture :: Maybe (Texture Double) -> RenderM ()+setTexture Nothing = return ()+setTexture (Just (SC (SomeColor c))) = do o <- fromMaybe 1 <$> getStyleAttrib getOpacity liftC (C.setSourceRGBA r g b (o*a)) where (r,g,b,a) = colorToSRGBA c+setTexture (Just (LG g)) = liftC $+ C.withLinearPattern x0 y0 x1 y1 $ \pat -> do+ mapM_ (addStop pat) (g^.lGradStops)+ C.patternSetMatrix pat m+ C.patternSetExtend pat (cairoSpreadMethod (g^.lGradSpreadMethod))+ C.setSource pat+ where+ m = CM.Matrix a1 a2 b1 b2 c1 c2+ [[a1, a2], [b1, b2], [c1, c2]] = matrixHomRep (inv (g^.lGradTrans))+ (x0, y0) = unp2 (g^.lGradStart)+ (x1, y1) = unp2 (g^.lGradEnd)+setTexture (Just (RG g)) = liftC $+ C.withRadialPattern x0 y0 r0 x1 y1 r1 $ \pat -> do+ mapM_ (addStop pat) (g^.rGradStops)+ C.patternSetMatrix pat m+ C.patternSetExtend pat (cairoSpreadMethod (g^.rGradSpreadMethod))+ C.setSource pat+ where+ m = CM.Matrix a1 a2 b1 b2 c1 c2+ [[a1, a2], [b1, b2], [c1, c2]] = matrixHomRep (inv (g^.rGradTrans))+ (r0, r1) = (g^.rGradRadius0, g^.rGradRadius1)+ (x0', y0') = unp2 (g^.rGradCenter0)+ (x1', y1') = unp2 (g^.rGradCenter1)+ (x0, y0, x1, y1) = (x0' * (r1 - r0) / r1, y0' * (r1 - r0) / r1, x1' ,y1') -- Can only do PNG files at the moment...-instance Renderable Image Cairo where- render _ (Image file sz tr) = C . liftC $ do+instance Renderable (DImage Double External) Cairo where+ render _ (DImage path w h tr) = C . liftC $ do+ let ImageRef file = path if ".png" `isSuffixOf` file then do C.save@@ -366,11 +392,12 @@ :: IO (Either IOError C.Surface)) case pngSurfChk of Right pngSurf -> do- w <- C.imageSurfaceGetWidth pngSurf- h <- C.imageSurfaceGetHeight pngSurf- cairoTransf $ requiredScaleT sz (fromIntegral w, fromIntegral h)- C.setSourceSurface pngSurf (-fromIntegral w / 2)- (-fromIntegral h / 2)+ w' <- C.imageSurfaceGetWidth pngSurf+ h' <- C.imageSurfaceGetHeight pngSurf+ let sz = fromIntegral <$> dims2D w h+ cairoTransf $ requiredScaling sz (fromIntegral <$> V2 w' h')+ C.setSourceSurface pngSurf (-fromIntegral w' / 2)+ (-fromIntegral h' / 2) Left _ -> liftIO . putStrLn $ "Warning: can't read image file <" ++ file ++ ">"@@ -382,30 +409,110 @@ , " images in .png format. Ignoring <" ++ file ++ ">." ] --- see http://www.cairographics.org/tutorial/#L1understandingtext-instance Renderable Text Cairo where- render _ (Text tr al str) = C $ do- ff <- fromMaybe "" <$> getStyleAttrib getFont- fs <- fromMaybe C.FontSlantNormal <$> getStyleAttrib (fromFontSlant . getFontSlant)- fw <- fromMaybe C.FontWeightNormal <$> getStyleAttrib (fromFontWeight . getFontWeight)- f <- getStyleAttrib (toAlphaColour . getFillColor)+-- Copied from Rasterific backend. This function should probably be in JuicyPixels!+toImageRGBA8 :: DynamicImage -> Image PixelRGBA8+toImageRGBA8 (ImageRGBA8 i) = i+toImageRGBA8 (ImageRGB8 i) = promoteImage i+toImageRGBA8 (ImageYCbCr8 i) = promoteImage (convertImage i :: Image PixelRGB8)+toImageRGBA8 (ImageY8 i) = promoteImage i+toImageRGBA8 (ImageYA8 i) = promoteImage i+toImageRGBA8 (ImageCMYK8 i) = promoteImage (convertImage i :: Image PixelRGB8)+toImageRGBA8 _ = error "Unsupported Pixel type"++instance Renderable (DImage Double Embedded) Cairo where+ -- render _ (DImage path w h tr) =+ render _ (DImage iD _w _h tr) = C . liftC $ do+ C.save+ cairoTransf (tr <> reflectionY)+ + let fmt = C.FormatARGB32+ dataSurf <- liftIO $ C.createImageSurface fmt w h+ + surData :: C.SurfaceData Int Word32+ <- liftIO $ C.imageSurfaceGetPixels dataSurf+ + stride <- C.imageSurfaceGetStride dataSurf+ + _ <- forMOf imageIPixels img $ \(x, y, px) -> do+ let p = y * (stride`div`4) + x+ liftIO . MA.writeArray surData p $ toARGB px+ return px+ + C.surfaceMarkDirty dataSurf+ + w' <- C.imageSurfaceGetWidth dataSurf+ h' <- C.imageSurfaceGetHeight dataSurf+ let sz = fromIntegral <$> dims2D w h+ cairoTransf $ requiredScaling sz (fromIntegral <$> V2 w' h')+ C.setSourceSurface dataSurf (-fromIntegral w' / 2)+ (-fromIntegral h' / 2)+ + C.paint+ C.restore+ where+ ImageRaster dImg = iD+ img@(Image w h _) = toImageRGBA8 dImg+ ++{-# INLINE toARGB #-}+-- Actually the name should be toBGRA, since that's the component order used by Cairo.+-- Really, what's happening here is just a swap of the R and B channels.+-- It seems a lot like this is dependent on endianness; perhaps we should handle this...+toARGB :: PixelRGBA8 -> Word32+toARGB px = ga + rotateL rb 16+ where rgba = packPixel px+ rb = rgba .&. 0x00FF00FF+ ga = rgba .&. 0xFF00FF00++if' :: Monad m => (a -> m ()) -> Maybe a -> m ()+if' = maybe (return ())++instance Renderable (Text Double) Cairo where+ render _ txt = C $ do save- setSourceColor f+ setTexture =<< getStyleAttrib getFillTexture+ sty <- use accumStyle+ layout <- liftC $ layoutStyledText sty txt+ -- Uncomment the lines below to draw a rectangle at the extent of each Text+ -- let (w, h) = unr2 $ ref ^* 2 -- XXX Debugging+ -- cairoPath $ rect w h -- XXX Debugging liftC $ do- C.selectFontFace ff fs fw- -- XXX should use reflection font matrix here instead?- cairoTransf (tr <> reflectionY)- (refX, refY) <- case al of- BoxAlignedText xt yt -> do- tExt <- C.textExtents str- fExt <- C.fontExtents- let l = C.textExtentsXbearing tExt- r = C.textExtentsXadvance tExt- b = C.fontExtentsDescent fExt- t = C.fontExtentsAscent fExt- return (lerp l r xt, lerp (-b) t yt)- BaselineText -> return (0, 0)- cairoTransf (moveOriginBy (r2 (refX, -refY)) mempty)- C.showText str+ -- C.setLineWidth 0.5 -- XXX Debugging+ -- C.stroke -- XXX Debugging+ -- C.newPath -- XXX Debugging+ P.showLayout layout C.newPath restore++layoutStyledText :: Style V2 Double -> Text Double -> C.Render P.PangoLayout+layoutStyledText sty (Text tt al str) =+ let tr = tt <> reflectionY+ styAttr :: AttributeClass a => (a -> b) -> Maybe b+ styAttr f = fmap f $ getAttr sty+ ff = styAttr getFont+ fs = styAttr fromFontSlant+ fw = styAttr fromFontWeight+ size' = styAttr getFontSize+ in do+ cairoTransf tr -- non-uniform scale+ layout <- P.createLayout str+ -- set font, including size+ liftIO $ do+ font <- P.fontDescriptionNew+ if' (P.fontDescriptionSetFamily font) ff+ if' (P.fontDescriptionSetStyle font) fs+ if' (P.fontDescriptionSetWeight font) fw+ if' (P.fontDescriptionSetSize font) size'+ P.layoutSetFontDescription layout $ Just font+ -- geometric translation+ ref <- liftIO $ case al of+ BoxAlignedText xt yt -> do+ (_,P.PangoRectangle _ _ w h) <- P.layoutGetExtents layout+ return $ r2 (w * xt, h * (1 - yt))+ BaselineText -> do+ baseline <- P.layoutIterGetBaseline =<< P.layoutGetIter layout+ return $ r2 (0, baseline)+ let t = moveOriginBy ref mempty :: T2 Double+ cairoTransf t+ P.updateLayout layout+ return layout
src/Diagrams/Backend/Cairo/List.hs view
@@ -1,4 +1,4 @@-+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.List@@ -13,7 +13,10 @@ module Diagrams.Backend.Cairo.List where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))+#endif+ import Control.Exception (bracket) import Data.Colour@@ -22,8 +25,8 @@ import Diagrams.Backend.Cairo (Cairo) import Diagrams.Backend.Cairo.Ptr (renderPtr)+import Diagrams.Prelude (Any, QDiagram, V2) import Graphics.Rendering.Cairo (Format (..))-import Diagrams.Prelude (Diagram, R2) import Foreign.Marshal.Alloc (free) import Foreign.Marshal.Array (peekArray)@@ -31,7 +34,7 @@ -- | Render to a regular list of Colour values. renderToList :: (Ord a, Floating a) =>- Int -> Int -> Diagram Cairo R2 -> IO [[AlphaColour a]]+ Int -> Int -> QDiagram Cairo V2 Double Any -> IO [[AlphaColour a]] renderToList w h d = f 0 <$> bracket (renderPtr w h FormatARGB32 d) free (peekArray $ w*h*4) where
src/Diagrams/Backend/Cairo/Ptr.hs view
@@ -1,4 +1,4 @@-+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.Ptr@@ -12,31 +12,37 @@ module Diagrams.Backend.Cairo.Ptr where -import Data.Word (Word8)+import Data.Word (Word8) -import Diagrams.Prelude (Diagram, R2, SizeSpec2D (..), renderDia)-import Diagrams.Backend.Cairo-import Diagrams.Backend.Cairo.Internal+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Internal+import Diagrams.Prelude (Any, QDiagram, V2, dims2D,+ renderDia) -import Foreign.ForeignPtr.Safe (ForeignPtr, newForeignPtr)-import Foreign.Marshal.Alloc (finalizerFree)-import Foreign.Marshal.Array (mallocArray, pokeArray)-import Foreign.Ptr (Ptr, castPtr)+import Foreign.Marshal.Alloc (finalizerFree)+import Foreign.Marshal.Array (mallocArray, pokeArray)+import Foreign.Ptr (Ptr, castPtr) -import Graphics.Rendering.Cairo ( Format (..)- , formatStrideForWidth- , renderWith- , withImageSurfaceForData- )+import Graphics.Rendering.Cairo (Format (..),+ formatStrideForWidth,+ renderWith,+ withImageSurfaceForData) +#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+import Foreign.ForeignPtr.Safe (ForeignPtr, newForeignPtr)+#else+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)+#endif+ -- | Render a diagram to a new buffer in memory, with the format ARGB32. -renderPtr :: Int -> Int -> Format -> Diagram Cairo R2 -> IO (Ptr Word8)+renderPtr :: Int -> Int -> Format -> QDiagram Cairo V2 Double Any -> IO (Ptr Word8) renderPtr w h fmt d = do let stride = formatStrideForWidth fmt w size = stride * h opt = CairoOptions- { _cairoSizeSpec = Dims (fromIntegral w) (fromIntegral h)+ { _cairoSizeSpec = fromIntegral <$> dims2D w h , _cairoOutputType = RenderOnly , _cairoBypassAdjust = False , _cairoFileName = ""@@ -51,8 +57,8 @@ -- | Like 'renderPtr' but automatically garbage collected by Haskell. -renderForeignPtr :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8)+renderForeignPtr :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8) renderForeignPtr w h d = renderPtr w h FormatARGB32 d >>= newForeignPtr finalizerFree -renderForeignPtrOpaque :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8)+renderForeignPtrOpaque :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8) renderForeignPtrOpaque w h d = renderPtr w h FormatRGB24 d >>= newForeignPtr finalizerFree
src/Diagrams/Backend/Cairo/Text.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}------------------------------------------------------------------------------ -- | -- Module : Diagrams.Backend.Cairo.Text--- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE)+-- Copyright : (c) 2015 Diagrams-cairo team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com --@@ -14,57 +11,35 @@ -- envelopes, use 'textLineBounded', 'textLineBoundedIO', -- 'textVisualBounded', or 'textVisualBoundedIO'. ----- Many of these functions take a 'Style' 'R2' parameter, determining the--- style to apply to the text before rendering / querying information about--- the text. These 'Style' 'R2' parameters can be created a variety of ways,--- but the most direct will likely be by applying style-transforming functions--- such as 'font', 'fontSize', 'fontSlant', and 'fontWeight' to 'mempty'.--- This works because there are instances of 'HasStyle' and 'Monoid' for--- @'Style' v@.----------------------------------------------------------------------------------module Diagrams.Backend.Cairo.Text- (- -- * Primitives-- -- | These create diagrams instantiated with extent-based envelopes.- textLineBoundedIO, textVisualBoundedIO-- -- ** Unsafe-- -- | These are convenient unsafe variants of the above operations- -- using 'unsafePerformIO'. In practice, they should be fairly- -- safe as the results depend only on the parameters and the- -- font information (which ought to stay the same during a given- -- execution).-- , kerningCorrection, textLineBounded, textVisualBounded-- -- * Extents-- -- ** Data Structures- , TextExtents(TextExtents), bearing, textSize, advance- , FontExtents(FontExtents), ascent, descent, height, maxAdvance-- -- ** Queries+-- Many of these functions take a 'Style' 'V2' 'Double' parameter,+-- determining the style to apply to the text before rendering /+-- querying information about the text. These 'Style' 'V2' 'Double'+-- parameters can be created a variety of ways, but the most direct+-- will likely be by applying style-transforming functions such as+-- 'font', 'fontSize', 'fontSlant', and 'fontWeight' to 'mempty'.+-- This works because there are instances of 'HasStyle' and 'Monoid'+-- for @'Style' v@. - , getTextExtents, getFontExtents, getExtents- , kerningCorrectionIO+module Diagrams.Backend.Cairo.Text+ (+ -- | These create diagrams instantiated with extent-based envelopes.+ textLineBoundedIO+ , textVisualBoundedIO - -- * Utilities- , queryCairo, unsafeCairo- , cairoWithStyle- ) where+ -- * Utilities+ , queryCairo, unsafeCairo+ ) where import Diagrams.Backend.Cairo.Internal-import Diagrams.BoundingBox+import qualified Diagrams.BoundingBox as BB import Diagrams.Prelude hiding (height, view)--import Control.Lens (makeLenses, view)-import System.IO.Unsafe+import Diagrams.TwoD.Text hiding (font) import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P +import System.IO.Unsafe+ -- | Executes a cairo action on a dummy, zero-size image surface, in order to -- query things like font information. queryCairo :: C.Render a -> IO a@@ -74,106 +49,22 @@ unsafeCairo :: C.Render a -> a unsafeCairo = unsafePerformIO . queryCairo --- | Executes the given cairo action, with styling applied.-cairoWithStyle :: C.Render a -> Style R2 -> C.Render a-cairoWithStyle f style = do- C.save- runRenderM (cairoStyle style)- result <- f- C.restore- return result---- | A more convenient data structure for the results of a text-extents query.-data TextExtents = TextExtents- { _bearing, _textSize, _advance :: R2 }--makeLenses ''TextExtents--processTextExtents :: C.TextExtents -> TextExtents-processTextExtents (C.TextExtents xb yb w h xa ya)- = TextExtents (r2 (xb,yb)) (r2 (w,h)) (r2 (xa,ya))---- | Get the extents of a string of text, given a style to render it with.-getTextExtents :: Style R2 -> String -> C.Render TextExtents-getTextExtents style txt- = cairoWithStyle (processTextExtents <$> C.textExtents txt) style---- | A more convenient data structure for the results of a font-extents query.-data FontExtents = FontExtents- { _ascent, _descent, _height :: Double- , _maxAdvance :: R2- }--makeLenses ''FontExtents--processFontExtents :: C.FontExtents -> FontExtents-processFontExtents (C.FontExtents a d h mx my)- = FontExtents a d h (r2 (mx,my))---- | Gets the intrinsic extents of a font.-getFontExtents :: Style R2 -> C.Render FontExtents-getFontExtents style- = cairoWithStyle (processFontExtents <$> C.fontExtents) style---- | Gets both the 'FontExtents' and 'TextExtents' of the string with the a--- particular style applied. This is more efficient than calling both--- 'getFontExtents' and 'getTextExtents'.-getExtents :: Style R2 -> String -> C.Render (FontExtents, TextExtents)-getExtents style str = cairoWithStyle (do- fe <- processFontExtents <$> C.fontExtents- te <- processTextExtents <$> C.textExtents str- return (fe, te)- ) style---- | Queries the amount of horizontal offset that needs to be applied in order to--- position the second character properly, in the event that it is 'hcat'-ed--- 'baselineText'.-kerningCorrectionIO :: Style R2 -> Char -> Char -> IO Double-kerningCorrectionIO style a b = do- let ax t = fst . unr2 . view advance <$> queryCairo (getTextExtents style t)- l <- ax [a, b]- la <- ax [a]- lb <- ax [b]- return $ l - la - lb- -- | Creates text diagrams with their envelopes set such that using -- @'vcat' . map ('textLineBounded' style)@ stacks them in the way that--- the font designer intended.-textLineBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2)-textLineBoundedIO style str = do- (fe, te) <- queryCairo $ getExtents style str- let box = fromCorners (p2 (0, negate $ view descent fe))- (p2 (fst . unr2 $ view advance te, view ascent fe))- return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str+-- the font designer intended. Pango refers to this as logical extents.+textLineBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo)+textLineBoundedIO = textLineIO fst -- | Creates a text diagram with its envelope set to enclose the glyphs of the text, -- including leading (though not trailing) whitespace.-textVisualBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2)-textVisualBoundedIO style str = do- te <- queryCairo $ getTextExtents style str- let box = fromCorners (origin .+^ view bearing te)- ((origin .+^ view bearing te) .+^ view textSize te)- return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str---- | Queries the amount of horizontal offset that needs to be applied--- in order to position the second character properly, in the event--- that it is 'hcat'-ed 'baselineText'. See 'kerningCorrectionIO';--- this variant uses 'unsafePerformIO' but should be fairly safe in--- practice.-kerningCorrection :: Style R2 -> Char -> Char -> Double-kerningCorrection style a = unsafePerformIO . kerningCorrectionIO style a---- | Creates text diagrams with their envelopes set such that using--- @'vcat' . map ('textLineBounded' style)@ stacks them in the way--- that the font designer intended. See 'textLineBoundedIO'; this--- variant uses 'unsafePerformIO' but should be fairly safe in--- practice.-textLineBounded :: Style R2 -> String -> Diagram Cairo R2-textLineBounded style = unsafePerformIO . textLineBoundedIO style+textVisualBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo)+textVisualBoundedIO = textLineIO snd --- | Creates a text diagram with its envelope set to enclose the--- glyphs of the text, including leading (though not trailing)--- whitespace. See 'textVisualBoundedIO'; this variant uses--- 'unsafePerformIO' but should be fairly safe in practice.-textVisualBounded :: Style R2 -> String -> Diagram Cairo R2-textVisualBounded style = unsafePerformIO . textVisualBoundedIO style+-- | Abstract common code from @textLineBoundedIO@ and @textVisualBoundedIO@+-- textLineIO :: ((a,a) -> a) -> Style V2 Double -> Text Double -> IO (Diagram Cairo)+textLineIO :: ((P.PangoRectangle,P.PangoRectangle) -> P.PangoRectangle) -> Style V2 Double -> Text Double -> IO (Diagram Cairo)+textLineIO pick sty txt = do+ layout <- queryCairo $ layoutStyledText sty txt+ P.PangoRectangle x y w h <- pick <$> P.layoutGetExtents layout+ let bb = BB.fromCorners (mkP2 x y) (mkP2 (x + w) (y + h))+ return $ mkQD (Prim txt) (getEnvelope bb) mempty mempty mempty