diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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)* diff --git a/CHANGES.markdown b/CHANGES.markdown deleted file mode 100644 --- a/CHANGES.markdown +++ /dev/null @@ -1,148 +0,0 @@ -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 - diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,12 +1,19 @@ -Copyright 2011-2012 diagrams-cairo team: +Copyright 2011-2015 diagrams-cairo team: + Daniel Bergey + Christopher Chalmers Sam Griffin Niklas Haas John Lato + Chris Mears + Jeffrey Rosenbluth Ian Ross + Justus Sagemüller + Ryan Scott Michael Sloan Luite Stegeman Kanchalai Suveepattananont + Robert Vollmert Ryan Yates Brent Yorgey diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,4 +1,4 @@ -[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-cairo.png)](http://travis-ci.org/diagrams/diagrams-cairo) +[![Build Status](https://travis-ci.org/diagrams/diagrams-cairo.png?branch=master)](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,12 +23,17 @@ 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 = defaultMain (pad 1.1 d) +main = mainWith (pad 1.1 d) ``` Save this to file named `Circle.hs` and compile it: @@ -43,16 +48,21 @@ ``` $ ./Circle --help -Command-line diagram generation. +./Circle -Circle [OPTIONS] +Usage: ./Circle [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] + [--loop] [-s|--src ARG] [-i|--interval INTERVAL] + Command-line diagram generation. -Common flags: - -w --width=INT Desired width of the output image - -h --height=INT Desired height of the output image - -o --output=FILE Output file - -? --help Display help message - -V --version Print version information +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. +ommand-line diagram generation. ``` The output type will be automatically determined from the file diff --git a/diagrams-cairo.cabal b/diagrams-cairo.cabal --- a/diagrams-cairo.cabal +++ b/diagrams-cairo.cabal @@ -1,9 +1,18 @@ Name: diagrams-cairo -Version: 0.6 +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.2.1, GHC == 7.4.2, GHC == 7.6.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,21 +54,29 @@ Diagrams.Backend.Cairo.Ptr Diagrams.Backend.Cairo.Text Hs-source-dirs: src - Build-depends: base >= 4.2 && < 4.7, - 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 >= 0.6 && < 0.7, - diagrams-lib >= 0.6 && < 0.7, - cairo >= 0.12.4 && < 0.13, - cmdargs >= 0.6 && < 0.11, + 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 + 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.7 + Build-depends: unix >=2.4 && <2.9 diff --git a/src/Diagrams/Backend/Cairo.hs b/src/Diagrams/Backend/Cairo.hs --- a/src/Diagrams/Backend/Cairo.hs +++ b/src/Diagrams/Backend/Cairo.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TypeFamilies, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | @@ -10,52 +11,72 @@ -- A full-featured rendering backend for diagrams using the -- cairo rendering engine. -- --- To invoke the cairo backend, use methods from the --- 'Diagrams.Core.Types.Backend' instance for @Cairo@. In particular, --- 'Diagrams.Core.Types.renderDia' has the generic type +-- To invoke the cairo backend, you have three options. -- --- > renderDia :: b -> Options b v -> QDiagram b v m -> Result b v +-- * You can use the "Diagrams.Backend.Cairo.CmdLine" module to create +-- standalone executables which output images when invoked. -- +-- * You can use the 'renderCairo' function provided by this module, +-- which gives 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). +-- +-- * Finally, for the most flexibility, you can directly +-- use methods from the +-- 'Diagrams.Core.Types.Backend' instance for @Cairo@. 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, 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? -- > } -- -- @ --- data family Render Cairo R2 = C ('RenderM' ()) +-- type family Result Cairo V2 Double = (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- +-- So the type of 'renderDia' resolves to +-- -- @ --- type family Result Cairo R2 = (IO (), 'Graphics.Rendering.Cairo.Render' ()) +-- renderDia :: Cairo -> Options Cairo V2 Double -> QQDiagram Cairo V2 Double Any m -> (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- --- So the type of 'renderDia' resolves to +-- which you could call like so: -- -- @ --- renderDia :: Cairo -> Options Cairo R2 -> QDiagram Cairo R2 m -> (IO (), 'Graphics.Rendering.Cairo.Render' ()) +-- renderDia Cairo (CairoOptions \"foo.png\" (Width 250) PNG False) (myDiagram :: QDiagram Cairo V2 Double Any) -- @ -- --- which you could call like @renderDia Cairo (CairoOptions "foo.png" --- (Width 250) PNG) myDiagram@. This would return a pair; the first --- element is an @IO ()@ action which will write out @foo.png@ to --- disk, and the second is a cairo rendering action which can be used, --- for example, to directly draw to a Gtk window. +-- This would return a pair; the first element is an @IO ()@ action +-- which will write out @foo.png@ to disk, and the second is a cairo +-- 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 = QDiagram b (V b) (N b) Any@ to fix @m = Any@ +-- and fix @v@ and @n@ to backend specific types. -- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo - ( -- * Cairo-supported output formats - OutputType(..) + ( -- * Rendering + renderCairo + -- * Cairo-supported output formats + , OutputType(..) + -- * Cairo-specific options -- $CairoOptions @@ -74,29 +95,47 @@ -- * Backend token , Cairo(..) + , B ) where -import Diagrams.Backend.Cairo.Internal +import System.FilePath (takeExtension) +import Diagrams.Backend.Cairo.Internal +import Diagrams.Prelude + -- $CairoOptions -- -- Unfortunately, Haddock does not yet support documentation for -- 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 --- > } --- --- So, for example, you could call the 'renderDia' function (from --- "Graphics.Rendering.Diagrams.Core") like this: +-- > 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? +-- > } -- --- > renderDia Cairo (CairoOptions "foo.png" (Width 250) PNG) myDiagram +-- See the documentation at the top of "Diagrams.Backend.Cairo" for +-- information on how to make use of this. + + +-- | 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 +-- extension. -- --- /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". +-- 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 -> SizeSpec V2 Double -> QDiagram Cairo V2 Double Any -> IO () +renderCairo outFile sizeSpec d + = fst (renderDia Cairo (CairoOptions outFile sizeSpec outTy False) d) + where + outTy = + case takeExtension outFile of + ".png" -> PNG + ".ps" -> PS + ".pdf" -> PDF + ".svg" -> SVG + _ -> PNG diff --git a/src/Diagrams/Backend/Cairo/CmdLine.hs b/src/Diagrams/Backend/Cairo/CmdLine.hs --- a/src/Diagrams/Backend/Cairo/CmdLine.hs +++ b/src/Diagrams/Backend/Cairo/CmdLine.hs @@ -1,8 +1,14 @@ -{-# LANGUAGE DeriveDataTypeable, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.CmdLine --- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE) +-- Copyright : (c) 2013 Diagrams-cairo team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- @@ -18,124 +24,122 @@ -- * 'animMain' is like 'defaultMain' but for animations instead of -- diagrams. -- +-- * `gifMain` creates an executable to generate an animated GIF. +-- +-- * '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 suitable 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. -- --- * A simple but somewhat inflexible approach is to wrap up --- 'defaultMain' (or 'multiMain', or 'animMain') in a call to --- 'System.Environment.withArgs'. +-- * Use a function with 'mainWith'. This may require making +-- 'Parseable' instances for custom argument types. -- --- * A more flexible approach is to directly call 'renderDia'; see --- "Diagrams.Backend.Cairo" for more information. +-- * 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". +-- +-- * A more flexible approach is to use the 'renderCairo' function +-- provided in the "Diagrams.Backend.Cairo" module. +-- +-- * For the most flexibility, you can call the generic 'renderDia' +-- function directly; see "Diagrams.Backend.Cairo" for more +-- information. +-- +-- For a tutorial on command-line diagram creation see +-- . +-- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.CmdLine - ( defaultMain + ( + -- * General form of @main@ + -- $mainwith + + mainWith + + -- * Supported forms of @main@ + + , defaultMain , multiMain , animMain + , gifMain + -- * GIF support + + , GifOpts(..) + , gifRender + + -- * Backend tokens + , Cairo + , B ) where -import Data.List (intercalate) -import Diagrams.Prelude hiding (width, height, interval) -import Diagrams.Backend.Cairo +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.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 -import System.Console.CmdArgs.Implicit hiding (args) - -import Prelude hiding (catch) - -import Data.Maybe (fromMaybe) -import Control.Monad (when, forM_, mplus) -import Data.List.Split - -import Text.Printf - -import System.Environment (getArgs, getProgName) -import System.Directory (getModificationTime) -import System.FilePath (addExtension, splitExtension) -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) - -#ifdef CMDLINELOOP -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 +#if __GLASGOW_HASKELL__ < 710 +import Foreign.ForeignPtr.Safe (ForeignPtr) #else -import System.Time (ClockTime, getClockTime) -type ModuleTime = ClockTime -getModuleTime :: IO ModuleTime -getModuleTime = getClockTime -#endif +import Foreign.ForeignPtr (ForeignPtr) #endif -data DiagramOpts = DiagramOpts - { width :: Maybe Int - , height :: Maybe Int - , output :: FilePath - , list :: Bool - , selection :: Maybe String - , fpu :: Double -#ifdef CMDLINELOOP - , loop :: Bool - , src :: Maybe String - , interval :: Int -#endif - } - deriving (Show, Data, Typeable) +import Data.List.Split -diagramOpts :: String -> Bool -> DiagramOpts -diagramOpts prog sel = DiagramOpts - { width = def - &= typ "INT" - &= help "Desired width of the output image" +-- | Extra options for animated GIFs. +data GifOpts = GifOpts { _dither :: Bool + , _noLooping :: Bool + , _loopRepeat :: Maybe Int} - , height = def - &= typ "INT" - &= help "Desired height of the output image" +makeLenses ''GifOpts - , output = def - &= typFile - &= help "Output file" - , selection = def - &= help "Name of the diagram to render" - &= (if sel then typ "NAME" else ignore) +-- $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', 'multiMain', or 'animMain' 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 Cairo +-- > f i c = ... +-- > +-- > main = mainWith f +-- +-- We can run this program as follows: +-- +-- > $ ghc --make MyDiagram +-- > +-- > # output image.png built by `f 20 red` +-- > $ ./MyDiagram -o image.png -w 200 20 red - , list = def - &= (if sel then help "List all available diagrams" else ignore) - , fpu = 30 - &= typ "FLOAT" - &= help "Frames per unit time (for animations)" -#ifdef CMDLINELOOP - , loop = False - &= help "Run in a self-recompiling loop" - , src = def - &= typFile - &= help "Source file to watch" - , interval = 1 &= typ "SECONDS" - &= help "When running in a loop, check for changes every n seconds." -#endif - } - &= summary "Command-line diagram generation." - &= program prog - -- | This is the simplest way to render diagrams, and is intended to -- be used like so: -- @@ -157,21 +161,20 @@ -- options. Currently it looks something like -- -- @ --- Command-line diagram generation. +-- ./Program -- --- Foo [OPTIONS] +-- Usage: ./Program [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] +-- [--loop] [-s|--src ARG] [-i|--interval INTERVAL] +-- Command-line diagram generation. -- --- Common flags: --- -w --width=INT Desired width of the output image --- -h --height=INT Desired height of the output image --- -o --output=FILE Output file --- -f --fpu=FLOAT Frames per unit time (for animations) --- -l --loop Run in a self-recompiling loop --- -s --src=FILE Source file to watch --- -i --interval=SECONDS When running in a loop, check for changes every n --- seconds. --- -? --help Display help message --- -V --version Print version information +-- 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. -- @ -- -- For example, a couple common scenarios include @@ -186,19 +189,17 @@ -- $ ./MyDiagram -o dia.pdf -h 200 -w 200 -l -i 10 -- @ -defaultMain :: Diagram Cairo R2 -> IO () -defaultMain d = do - prog <- getProgName - args <- getArgs - opts <- cmdArgs (diagramOpts prog False) - chooseRender opts d -#ifdef CMDLINELOOP - when (loop opts) (waitForChange Nothing opts prog args) -#endif +defaultMain :: QDiagram Cairo V2 Double Any -> IO () +defaultMain = mainWith -chooseRender :: DiagramOpts -> Diagram Cairo R2 -> IO () +instance Mainable (QDiagram Cairo V2 Double Any) where + type MainOpts (QDiagram Cairo V2 Double Any) = DiagramOpts + + mainRender opts d = chooseRender opts d + +chooseRender :: DiagramOpts -> QDiagram Cairo V2 Double Any -> IO () chooseRender opts d = - case splitOn "." (output opts) of + case splitOn "." (opts ^. output) of [""] -> putStrLn "No output file given." ps | last ps `elem` ["png", "ps", "pdf", "svg"] -> do let outTy = case last ps of @@ -210,10 +211,10 @@ fst $ renderDia Cairo ( CairoOptions - (output opts) - (mkSizeSpec - (fromIntegral <$> width opts) - (fromIntegral <$> height opts) + (opts^.output) + (fromIntegral <$> mkSizeSpec2D + (opts ^. width ) + (opts ^. height) ) outTy False @@ -240,25 +241,15 @@ -- $ ./MultiTest --selection bar -o Bar.png -w 200 -- @ -multiMain :: [(String, Diagram Cairo R2)] -> IO () -multiMain ds = do - prog <- getProgName - opts <- cmdArgs (diagramOpts prog True) - if list opts - then showDiaList (map fst ds) - else - case selection opts of - Nothing -> putStrLn "No diagram selected." >> showDiaList (map fst ds) - Just sel -> case lookup sel ds of - Nothing -> putStrLn $ "Unknown diagram: " ++ sel - Just d -> chooseRender opts d +multiMain :: [(String, QDiagram Cairo V2 Double Any)] -> IO () +multiMain = mainWith --- | Display the list of diagrams available for rendering. -showDiaList :: [String] -> IO () -showDiaList ds = do - putStrLn "Available diagrams:" - putStrLn $ " " ++ intercalate " " ds +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 + -- | @animMain@ is like 'defaultMain', but renders an animation -- instead of a diagram. It takes as input an animation and produces -- a command-line program which will crudely \"render\" the animation @@ -275,67 +266,118 @@ -- -- 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 anim = do - prog <- getProgName - opts <- cmdArgs (diagramOpts prog False) - let frames = simulate (toRational $ fpu opts) anim - nDigits = length . show . length $ frames - forM_ (zip [1..] frames) $ \(i,d) -> - chooseRender (indexize nDigits i opts) d +animMain :: Animation Cairo V2 Double -> IO () +animMain = mainWith --- | @indexize d n@ adds the integer index @n@ to the end of the --- output file name, padding with zeros if necessary so that it uses --- at least @d@ digits. -indexize :: Int -> Integer -> DiagramOpts -> DiagramOpts -indexize nDigits i opts = opts { output = output' } - where fmt = "%0" ++ show nDigits ++ "d" - output' = addExtension (base ++ printf fmt (i::Integer)) ext - (base, ext) = splitExtension (output opts) +instance Mainable (Animation Cairo V2 Double) where + type MainOpts (Animation Cairo V2 Double) = (DiagramOpts, DiagramAnimOpts) -#ifdef CMDLINELOOP -waitForChange :: Maybe ModuleTime -> DiagramOpts -> String -> [String] -> IO () -waitForChange lastAttempt opts prog args = do - hSetBuffering stdout NoBuffering - go lastAttempt - where go lastAtt = do - threadDelay (1000000 * interval opts) - -- putStrLn $ "Checking... (last attempt = " ++ show lastAttempt ++ ")" - (newBin, newAttempt) <- recompile lastAtt prog (src opts) - if newBin - then executeFile prog False args Nothing - else go $ newAttempt `mplus` lastAtt + mainRender opts d = defaultAnimMainRender chooseRender output opts d --- | @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) +-- | @gifMain@ takes a list of diagram and delay time pairs and produces a +-- command line program to generate an animated GIF, with options @GifOpts@. +-- "Delay times are in 1/100ths of a second." +-- +-- Example usage: +-- +-- @ +-- $ ghc --make GifTest +-- [1 of 1] Compiling Main ( GifTest.hs, GifTest.o ) +-- Linking GifTest ... +-- ./GifTest --help +-- GifTest +-- +-- Usage: GifTest [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] +-- [--dither] [--looping-off] [--loop-repeat ARG] +-- 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 +-- --dither Turn on dithering. +-- --looping-off Turn looping off +-- --loop-repeat ARG Number of times to repeat +-- @ +gifMain :: [(QDiagram Cairo V2 Double Any, GifDelay)] -> IO () +gifMain = mainWith - if (status /= ExitSuccess) - then putStrLn "" >> putStrLn (replicate 75 '-') >> readFile errFile >>= putStr - else putStrLn "done." +-- | Command line parser for 'GifOpts'. +-- @--dither@ turn dithering on. +-- @--looping-off@ turn looping off, i.e play GIF once. +-- @--loop-repeat@ number of times to repeat the GIF after the first playing. +-- this option is only used if @--looping-off@ is not set. +instance Parseable GifOpts where + parser = GifOpts <$> switch + ( long "dither" + <> help "Turn on dithering." ) + <*> switch + ( long "looping-off" + <> help "Turn looping off" ) + <*> ( optional . option auto ) + ( long "loop-repeat" + <> help "Number of times to repeat" ) - curTime <- getModuleTime - return (status == ExitSuccess, Just curTime) +instance Mainable [(QDiagram Cairo V2 Double Any, GifDelay)] where + type MainOpts [(QDiagram Cairo V2 Double Any, GifDelay)] = (DiagramOpts, GifOpts) - else return (False, Nothing) + mainRender (dOpts, gOpts) ds = gifRender (dOpts, gOpts) ds - where getModTime f = catch (Just <$> getModificationTime f) - (\(SomeException _) -> return Nothing) -#endif +imageRGB8FromUnsafePtr :: Int -> Int -> ForeignPtr Word8 -> Image PixelRGB8 +imageRGB8FromUnsafePtr w h ptr = pixelMap f cImg + where + f (PixelRGBA8 b g r _) = PixelRGB8 r g b + cImg = Image w h $ unsafeFromForeignPtr0 ptr (w * h * 4) + + +encodeGifAnimation' :: [GifDelay] -> GifLooping -> Bool + -> [Image PixelRGB8] -> Either String L.ByteString +encodeGifAnimation' delays looping dithering lst = + encodeGifImages looping triples + where + triples = zipWith (\(x,z) y -> (x, y, z)) doubles delays + doubles = [(pal, img) + | (img, pal) <- palettize + defaultPaletteOptions {enableImageDithering=dithering} <$> lst] + +writeGifAnimation' :: FilePath -> [GifDelay] -> GifLooping -> Bool + -> [Image PixelRGB8] -> Either String (IO ()) +writeGifAnimation' path delays looping dithering img = + L.writeFile path <$> encodeGifAnimation' delays looping dithering img + +scaleInt :: Int -> Double -> Double -> Int +scaleInt i num denom + | num == 0 || denom == 0 = i + | otherwise = round (num / denom * fromIntegral i) + +gifRender :: (DiagramOpts, GifOpts) -> [(QDiagram Cairo V2 Double Any, GifDelay)] -> IO () +gifRender (dOpts, gOpts) lst = + case splitOn "." (dOpts^.output) of + [""] -> putStrLn "No output file given" + ps | last ps == "gif" -> do + let (w, h) = case (dOpts^.width, dOpts^.height) of + (Just w', Just h') -> (w', h') + (Just w', Nothing) -> (w', scaleInt w' diaHeight diaWidth) + (Nothing, Just h') -> (scaleInt h' diaWidth diaHeight, h') + (Nothing, Nothing) -> (100, 100) + looping = if gOpts^.noLooping + then LoopingNever + else case gOpts^.loopRepeat of + Nothing -> LoopingForever + Just n -> LoopingRepeat (fromIntegral n) + dias = map fst lst + delays = map snd lst + V2 diaWidth diaHeight = size (head dias) + fPtrs <- mapM (renderForeignPtrOpaque w h) dias + let imageRGB8s = map (imageRGB8FromUnsafePtr w h) fPtrs + result = writeGifAnimation' + (dOpts^.output) + delays + looping + (gOpts^.dither) + imageRGB8s + case result of + Left s -> putStrLn s + Right io -> io + | otherwise -> putStrLn "File name must end with .gif" diff --git a/src/Diagrams/Backend/Cairo/Internal.hs b/src/Diagrams/Backend/Cairo/Internal.hs --- a/src/Diagrams/Backend/Cairo/Internal.hs +++ b/src/Diagrams/Backend/Cairo/Internal.hs @@ -1,12 +1,17 @@ -{-# LANGUAGE TypeFamilies - , MultiParamTypeClasses - , FlexibleInstances - , FlexibleContexts - , ExistentialQuantification - , TypeSynonymInstances - , DeriveDataTypeable - , ViewPatterns - #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -29,210 +34,246 @@ -- sometimes to work around an apparent bug in certain versions of -- GHC, which results in a \"not in scope\" error for 'CairoOptions'. -- +-- The types of all the @fromX@ functions look funny in the Haddock +-- output, which displays them like @Type -> Type@. In fact they are +-- all of the form @Type -> Graphics.Rendering.Cairo.Type@, /i.e./ +-- they convert from a diagrams type to a cairo type of the same name. ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Internal where -import Diagrams.Core.Transform +import Diagrams.Core.Compile +import Diagrams.Core.Transform -import Diagrams.Prelude -import Diagrams.TwoD.Path (Clip(..), getFillRule) -import Diagrams.TwoD.Text -import Diagrams.TwoD.Image -import Diagrams.TwoD.Adjust (adjustDia2D, setDefault2DAttributes) -import Diagrams.TwoD.Size (requiredScaleT) +import Diagrams.Prelude hiding (font, opacity, view) +import Diagrams.TwoD.Adjust (adjustDia2D, + setDefault2DAttributes) +import Diagrams.TwoD.Path (Clip (Clip), getFillRule) +import Diagrams.TwoD.Text hiding (font) -import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM +import qualified Graphics.Rendering.Pango as P -import Control.Monad.State -import Data.Maybe (catMaybes, fromMaybe) -import Data.List (isSuffixOf) +import Codec.Picture +import Codec.Picture.Types (convertImage, packPixel, + promoteImage) -import Control.Exception (try) -import qualified Data.Foldable as F - -import Data.Typeable +import Control.Exception (try) +import Control.Monad (when) +import Control.Monad.IO.Class +import qualified Control.Monad.StateStack as SS +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.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 -- the cairo backend: (1) when calling functions where the type --- inference engine would otherwise have know way to know which +-- inference engine would otherwise have no way to know which -- backend you wanted to use, and (2) as an argument to the -- 'Backend' and 'Renderable' type classes. data Cairo = Cairo deriving (Eq,Ord,Read,Show,Typeable) +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. +-- windows, see the @diagrams-gtk@ package. data OutputType = - PNG -- ^ Portable Network Graphics output. - | PS -- ^ PostScript output - | PDF -- ^ Portable Document Format output. - | SVG -- ^ Scalable Vector Graphics output. + PNG -- ^ Portable Network Graphics output. + | PS -- ^ PostScript output + | PDF -- ^ Portable Document Format output. + | SVG -- ^ Scalable Vector Graphics output. | RenderOnly -- ^ Don't output any file; the returned @IO ()@ - -- action will do nothing, but the @Render ()@ action - -- can be used (e.g. to draw to a Gtk window) + -- action will do nothing, but the @Render ()@ + -- action can be used (/e.g./ to draw to a Gtk + -- window; see the @diagrams-gtk@ package). + deriving (Eq, Ord, Read, Show, Bounded, Enum, Typeable, Generic) -instance Monoid (Render Cairo R2) where - mempty = C $ return () - (C rd1) `mappend` (C rd2) = C (rd1 >> rd2) +instance Hashable OutputType +-- | Custom state tracked in the 'RenderM' monad. +data CairoState + = CairoState { _accumStyle :: Style V2 Double + -- ^ The current accumulated style. + , _ignoreFill :: Bool + -- ^ Whether or not we saw any lines in the most + -- recent path (as opposed to loops). If we did, + -- we should ignore any fill attribute. + -- diagrams-lib separates lines and loops into + -- separate path primitives so we don't have to + -- worry about seeing them together in the same + -- path. + } + +$(makeLenses ''CairoState) + +instance Default CairoState where + def = CairoState + { _accumStyle = mempty + , _ignoreFill = False + } + -- | The custom monad in which intermediate drawing options take -- place; 'Graphics.Rendering.Cairo.Render' is cairo's own rendering --- monad. At one point @RenderM@ really did use @StateT@, but then --- the state got taken out... but the @StateT@ remains, now with a --- zen-like state of type unit, \"just in case\". Think of it as a --- good luck charm. -type RenderM a = StateT () C.Render a -- no state for now +-- monad. +type RenderM a = SS.StateStackT CairoState C.Render a --- simple, stupid implementations of save and restore for now, since --- it suffices to just reset the text alignment to "centered" on --- restore. But if need be we can switch to a more sophisticated --- implementation using an "undoable state" monad which lets you save --- (push state onto a stack) and restore (pop from the stack). +liftC :: C.Render a -> RenderM a +liftC = lift +runRenderM :: RenderM a -> C.Render a +runRenderM = flip SS.evalStateStackT def + -- | Push the current context onto a stack. save :: RenderM () -save = lift C.save +save = SS.save >> liftC C.save -- | Restore the context from a stack. restore :: RenderM () -restore = lift C.restore +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 - { 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? +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 :: 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, Eq) - withStyle _ s t (C r) = C $ do - save - cairoMiscStyle s - r - lift $ do - cairoTransf t - cairoStrokeStyle s - C.stroke - restore + 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 () - doRender _ (CairoOptions file size out _) (C r) = (renderIO, r') - where r' = evalStateT r () - renderIO = do - let surfaceF s = C.renderWith s r' + adjustDia c opts d = if _cairoBypassAdjust opts + then (opts, mempty, d # setDefault2DAttributes) + else let (opts', transformation, d') = adjustDia2D cairoSizeSpec c opts (d # reflectY) + in (opts', transformation <> reflectionY, d') - -- 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) +runC :: Render Cairo V2 Double -> RenderM () +runC (C r) = r - 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 () +instance Semigroup (Render Cairo V2 Double) where + C rd1 <> C rd2 = C (rd1 >> rd2) - 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 } +instance Monoid (Render Cairo V2 Double) where + mempty = C $ return () +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif -renderC :: (Renderable a Cairo, V a ~ R2) => a -> RenderM () -renderC a = case (render Cairo a) of C r -> r +instance Hashable (Options Cairo V2 Double) where + hashWithSalt s (CairoOptions fn sz out adj) + = s `hashWithSalt` + fn `hashWithSalt` + sz `hashWithSalt` + out `hashWithSalt` + adj --- | Handle \"miscellaneous\" style attributes (clip, font stuff, fill --- color and fill rule). -cairoMiscStyle :: Style v -> RenderM () -cairoMiscStyle s = - sequence_ - . catMaybes $ [ handle clip - , handle fSize - , handleFontFace - , handle fColor - , handle lFillRule - ] - where handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ()) - handle f = f `fmap` getAttr s - clip = mapM_ (\p -> renderC p >> lift C.clip) . getClip - fSize = lift . C.setFontSize . getFontSize - fFace = fromMaybe "" $ getFont <$> getAttr s - fSlant = fromFontSlant . fromMaybe FontSlantNormal - $ getFontSlant <$> getAttr s - fWeight = fromFontWeight . fromMaybe FontWeightNormal - $ getFontWeight <$> getAttr s - handleFontFace = Just . lift $ C.selectFontFace fFace fSlant fWeight - fColor c = lift $ setSource (getFillColor c) s - lFillRule = lift . C.setFillRule . fromFillRule . getFillRule +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 toRender rs + restore +toRender (Node _ rs) = F.foldMap toRender rs -fromFontSlant :: FontSlant -> C.FontSlant -fromFontSlant FontSlantNormal = C.FontSlantNormal -fromFontSlant FontSlantItalic = C.FontSlantItalic -fromFontSlant FontSlantOblique = C.FontSlantOblique +cairoFileName :: Lens' (Options Cairo V2 Double) String +cairoFileName = lens (\(CairoOptions {_cairoFileName = f}) -> f) + (\o f -> o {_cairoFileName = f}) -fromFontWeight :: FontWeight -> C.FontWeight -fromFontWeight FontWeightNormal = C.FontWeightNormal -fromFontWeight FontWeightBold = C.FontWeightBold +cairoSizeSpec :: Lens' (Options Cairo V2 Double) (SizeSpec V2 Double) +cairoSizeSpec = lens (\(CairoOptions {_cairoSizeSpec = s}) -> s) + (\o s -> o {_cairoSizeSpec = s}) --- | Handle style attributes having to do with stroke. -cairoStrokeStyle :: Style v -> C.Render () -cairoStrokeStyle s = +cairoOutputType :: Lens' (Options Cairo V2 Double) OutputType +cairoOutputType = lens (\(CairoOptions {_cairoOutputType = t}) -> t) + (\o t -> o {_cairoOutputType = t}) + +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 ~ V2, N a ~ Double) => a -> RenderM () +renderC = runC . render Cairo + +-- | Get an accumulated style attribute from the render monad state. +getStyleAttrib :: AttributeClass a => (a -> b) -> RenderM (Maybe b) +getStyleAttrib f = (fmap f . getAttr) <$> use accumStyle + +-- | Handle those style attributes for which we can immediately emit +-- cairo instructions as we encounter them in the tree (clip, font +-- 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 Double -> RenderM () +cairoStyle s = sequence_ - . catMaybes $ [ handle fColor - , handle lColor -- see Note [color order] + . catMaybes $ [ handle clip + , handle lFillRule , handle lWidth , handle lCap , handle lJoin , handle lDashing ] - where handle :: (AttributeClass a) => (a -> C.Render ()) -> Maybe (C.Render ()) + where handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ()) handle f = f `fmap` getAttr s - fColor c = setSource (getFillColor c) s >> C.fillPreserve - lColor c = setSource (getLineColor c) s - lWidth = C.setLineWidth . getLineWidth - lCap = C.setLineCap . fromLineCap . getLineCap - lJoin = C.setLineJoin . fromLineJoin . getLineJoin + clip = mapM_ (\p -> cairoPath p >> liftC C.clip) . op Clip + lFillRule = liftC . C.setFillRule . fromFillRule . getFillRule + lWidth = liftC . C.setLineWidth . getLineWidth + lCap = liftC . C.setLineCap . fromLineCap . getLineCap + lJoin = liftC . C.setLineJoin . fromLineJoin . getLineJoin lDashing (getDashing -> Dashing ds offs) = - C.setDash ds offs + liftC $ C.setDash ds offs -setSource :: Color c => c -> Style v -> C.Render () -setSource c s = C.setSourceRGBA r g b a' - where (r,g,b,a) = colorToRGBA c - a' = case getOpacity <$> getAttr s of - Nothing -> a - Just d -> a * d +fromFontSlant :: FontSlant -> P.FontStyle +fromFontSlant FontSlantNormal = P.StyleNormal +fromFontSlant FontSlantItalic = P.StyleItalic +fromFontSlant FontSlantOblique = P.StyleOblique +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 (unr2 -> (b1,b2)) = apply t unitY (unr2 -> (c1,c2)) = transl t -{- ~~~~ Note [color order] - - It's important for the line and fill colors to be handled in the - given order (fill color first, then line color) because of the way - Cairo handles them (both are taken from the sourceRGBA). --} - fromLineCap :: LineCap -> C.LineCap fromLineCap LineCapButt = C.LineCapButt fromLineCap LineCapRound = C.LineCapRound @@ -247,28 +288,102 @@ fromFillRule Winding = C.FillRuleWinding fromFillRule EvenOdd = C.FillRuleEvenOdd -instance Renderable (Segment R2) Cairo where - render _ (Linear v) = C . lift $ uncurry C.relLineTo (unr2 v) +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)) - (unr2 -> (x3,y3))) - = C . lift $ C.relCurveTo x1 y1 x2 y2 x3 y3 + (OffsetClosed (unr2 -> (x3,y3)))) + = C . liftC $ C.relCurveTo x1 y1 x2 y2 x3 y3 -instance Renderable (Trail R2) Cairo where - render _ (Trail segs c) = C $ do - mapM_ renderC segs - lift $ when c C.closePath +instance Renderable (Trail V2 Double) Cairo where + render _ = withTrail renderLine renderLoop + where + renderLine ln = C $ do + mapM_ renderC (lineSegments ln) -instance Renderable (Path R2) Cairo where - render _ (Path trs) = C $ lift C.newPath >> F.mapM_ renderTrail trs - where renderTrail (unp2 -> p, tr) = do - lift $ uncurry C.moveTo p - renderC tr + -- remember that we saw a Line, so we will ignore fill attribute + ignoreFill .= True + renderLoop lp = C $ do + case loopSegments lp of + -- let closePath handle the last segment if it is linear + (segs, Linear _) -> mapM_ renderC segs + -- otherwise we have to draw it explicitly + _ -> mapM_ renderC (lineSegments . cutLoop $ lp) + + liftC C.closePath + +instance Renderable (Path V2 Double) Cairo where + render _ p = C $ do + cairoPath p + f <- getStyleAttrib getFillTexture + s <- getStyleAttrib getLineTexture + ign <- use ignoreFill + setTexture f + when (isJust f && not ign) $ liftC C.fillPreserve + setTexture s + liftC C.stroke + +-- Add a path to the Cairo context, without stroking or filling it. +cairoPath :: Path V2 Double -> RenderM () +cairoPath (Path trs) = do + liftC C.newPath + ignoreFill .= False + F.mapM_ renderTrail trs + where + renderTrail (viewLoc -> (unp2 -> p, tr)) = do + 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 . +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 . lift $ 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 @@ -277,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 ++ ">" @@ -293,23 +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 - lift $ do - C.save - -- 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.restore +-- 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 + 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.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 diff --git a/src/Diagrams/Backend/Cairo/List.hs b/src/Diagrams/Backend/Cairo/List.hs --- a/src/Diagrams/Backend/Cairo/List.hs +++ b/src/Diagrams/Backend/Cairo/List.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.List @@ -13,32 +13,36 @@ module Diagrams.Backend.Cairo.List where -import Control.Applicative ((<$>)) -import Control.Exception (bracket) +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>)) +#endif -import Data.Colour -import Data.Colour.SRGB (sRGB) -import Data.Word (Word8) +import Control.Exception (bracket) -import Diagrams.Prelude (Diagram, R2) -import Diagrams.Backend.Cairo (Cairo) -import Diagrams.Backend.Cairo.Ptr (renderPtr) +import Data.Colour +import Data.Colour.SRGB (sRGB) +import Data.Word (Word8) -import Foreign.Marshal.Alloc (free) -import Foreign.Marshal.Array (peekArray) +import Diagrams.Backend.Cairo (Cairo) +import Diagrams.Backend.Cairo.Ptr (renderPtr) +import Diagrams.Prelude (Any, QDiagram, V2) +import Graphics.Rendering.Cairo (Format (..)) +import Foreign.Marshal.Alloc (free) +import Foreign.Marshal.Array (peekArray) + -- | 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 d) free (peekArray $ w*h*4) + f 0 <$> bracket (renderPtr w h FormatARGB32 d) free (peekArray $ w*h*4) where f :: (Ord a, Floating a) => Int -> [Word8] -> [[AlphaColour a]] f _ [] = [] f n xs | n >= w = [] : f 0 xs f n (g:b:r:a:xs) = - let l n = fromIntegral n / fromIntegral a + let l x = fromIntegral x / fromIntegral a c = sRGB (l r) (l g) (l b) `withOpacity` (fromIntegral a / 255) in case f (n+1) xs of diff --git a/src/Diagrams/Backend/Cairo/Ptr.hs b/src/Diagrams/Backend/Cairo/Ptr.hs --- a/src/Diagrams/Backend/Cairo/Ptr.hs +++ b/src/Diagrams/Backend/Cairo/Ptr.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.Ptr @@ -12,44 +12,53 @@ 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 -> Diagram Cairo R2 -> IO (Ptr Word8) -renderPtr w h d = do - let stride = formatStrideForWidth FormatARGB32 w +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) - , cairoOutputType = RenderOnly - , cairoBypassAdjust = False - , cairoFileName = "" + { _cairoSizeSpec = fromIntegral <$> dims2D w h + , _cairoOutputType = RenderOnly + , _cairoBypassAdjust = False + , _cairoFileName = "" } (_, r) = renderDia Cairo opt d b <- mallocArray size pokeArray b (replicate size 0) - withImageSurfaceForData b FormatARGB32 w h stride (`renderWith` r) + withImageSurfaceForData b fmt w h stride (`renderWith` r) return (castPtr b) -- | Like 'renderPtr' but automatically garbage collected by Haskell. -renderForeignPtr :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8) -renderForeignPtr w h d = renderPtr w h d >>= newForeignPtr finalizerFree +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 -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8) +renderForeignPtrOpaque w h d = renderPtr w h FormatRGB24 d >>= newForeignPtr finalizerFree diff --git a/src/Diagrams/Backend/Cairo/Text.hs b/src/Diagrams/Backend/Cairo/Text.hs --- a/src/Diagrams/Backend/Cairo/Text.hs +++ b/src/Diagrams/Backend/Cairo/Text.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE RankNTypes #-} ------------------------------------------------------------------------------ -- | -- 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 -- @@ -13,146 +11,60 @@ -- 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 extents-based envelopes - textLineBoundedIO, textVisualBoundedIO - - -- ** Unsafe - - -- | These are convenient unsafe variants of the above operations - -- postfixed with \"IO\". They should be pretty well-behaved as the - -- results just depend on the parameters and the font information - -- (which ought to stay the same during a given execution). - - , kerningCorrection, textLineBounded, textVisualBounded - - -- * Extents - - -- ** Data Structures - , TextExtents(..), FontExtents(..) - - -- ** 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.Prelude +import Diagrams.Backend.Cairo.Internal +import qualified Diagrams.BoundingBox as BB +import Diagrams.Prelude hiding (height, view) +import Diagrams.TwoD.Text hiding (font) -import Control.Monad.State -import System.IO.Unsafe +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P -import qualified Graphics.Rendering.Cairo as C +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 queryCairo c = C.withImageSurface C.FormatA1 0 0 (`C.renderWith` c) --- | Unsafely invokes @queryCairo@. +-- | Unsafely invokes 'queryCairo' using 'unsafePerformIO'. unsafeCairo :: C.Render a -> a unsafeCairo = unsafePerformIO . queryCairo --- | Executes the given cairo action, with styling applied. --- This does not do all styling - just attributes that are processed by --- \"cairoMiscStyle\", which does clip, fill color, fill rule, and, --- importantly for this module, font face, style, and weight. -cairoWithStyle :: C.Render a -> Style R2 -> C.Render a -cairoWithStyle f style = do - C.save - evalStateT (cairoMiscStyle 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 } - -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 - } - -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 . 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 $ descent fe)) - (p2 (fst . unr2 $ advance te, ascent fe)) - return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str +-- @'vcat' . map ('textLineBounded' style)@ stacks them in the way that +-- 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 .+^ bearing te) - ((origin .+^ bearing te) .+^ textSize te) - return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str - -kerningCorrection :: Style R2 -> Char -> Char -> Double -kerningCorrection style a = unsafePerformIO . kerningCorrectionIO style a +textVisualBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo) +textVisualBoundedIO = textLineIO snd -textLineBounded, textVisualBounded :: Style R2 -> String -> Diagram Cairo R2 -textLineBounded style = unsafePerformIO . textLineBoundedIO style -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