diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,353 @@ +# Change Log + +## [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,265 +0,0 @@ -1.2.0.7 (2 April 2015) ----------------------- - - - allow `lens-4.9` - -1.2.0.6 (13 Jan 2015) ---------------------- - -- Allow `lens-4.7` - -1.2.0.5 (25 December 2014) --------------------------- - -- Allow `JuicyPixels-3.2` - -1.2.0.4 (17 November 2014) --------------------------- - -- Allow `lens-4.6` - -1.2.0.3 (8 October 2014) ------------------------- - -- Allow `optparse-applicative-0.11` - -1.2.0.2 (7 September 2014) --------------------------- - -- Allow optparse-applicative-0.10 - -1.2.0.1 (22 August 2014) ------------------------- - -- Allow lens-4.4 -- Allow cairo-0.13 and pango-0.13 - -1.2 (27 May 2014) ------------------ - -* **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. - -* **Dependency/version changes - - - Allow `opt-parse-applicative-0.9` - - Allow `lens-4.2` - - Allow `mtl-2.2` - - Allow `transformers-0.4` - -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,11 +1,13 @@ -Copyright 2011-2013 diagrams-cairo team: +Copyright 2011-2015 diagrams-cairo team: Daniel Bergey + Christopher Chalmers Sam Griffin Niklas Haas John Lato Jeffrey Rosenbluth Ian Ross + Ryan Scott Michael Sloan Luite Stegeman Kanchalai Suveepattananont 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, 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: 1.2.0.7 +Version: 1.3 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,10 +24,6 @@ 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). @@ -34,8 +39,8 @@ 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.3 +Extra-source-files: CHANGELOG.md, README.markdown +Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 Source-repository head type: git location: http://github.com/diagrams/diagrams-cairo.git @@ -46,17 +51,12 @@ Diagrams.Backend.Cairo.Internal Diagrams.Backend.Cairo.List Diagrams.Backend.Cairo.Ptr - Diagrams.Backend.Cairo.Text Hs-source-dirs: src - Build-depends: base >= 4.2 && < 4.8, + Build-depends: base >= 4.2 && < 4.9, mtl >= 2.0 && < 2.3, - process, - directory, filepath, - old-time, - time, - diagrams-core >= 1.2 && < 1.3, - diagrams-lib >= 1.2 && < 1.3, + diagrams-core >= 1.3 && < 1.4, + diagrams-lib >= 1.3 && < 1.4, cairo >= 0.12.4 && < 0.14, pango >= 0.12.5 && < 0.14, colour, 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 #-} ----------------------------------------------------------------------------- -- | @@ -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 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,7 +1,7 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -75,6 +75,7 @@ -- * GIF support , GifOpts(..) + , gifRender -- * Backend tokens @@ -82,63 +83,32 @@ , 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, (<>) - ,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 - -#ifdef CMDLINELOOP -import Data.Maybe (fromMaybe) -import Control.Monad (when, mplus) -import Control.Lens (_1) - -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) - -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 +import Data.List.Split -- $mainwith -- The 'mainWith' method unifies all of the other forms of @main@ and is now @@ -149,7 +119,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 +181,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, DiagramLoopOpts) - mainRender opts d = chooseRender opts d -#endif + mainRender (opts, l) d = chooseRender opts d >> defaultLoopRender l -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 +204,9 @@ Cairo ( CairoOptions (opts^.output) - (mkSizeSpec - (fromIntegral <$> opts ^. width ) - (fromIntegral <$> opts ^. height) + (fromIntegral <$> mkSizeSpec2D + (opts ^. width ) + (opts ^. height) ) outTy False @@ -278,12 +233,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 +258,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), DiagramLoopOpts) - where getModTime f = catch (Just <$> getModificationTime f) - (\(SomeException _) -> return Nothing) -#endif + mainRender (opts, l) d = defaultAnimMainRender chooseRender output opts d >> defaultLoopRender l -- | @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,12 +292,12 @@ -- --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 +data GifOpts = GifOpts { _dither :: Bool + , _noLooping :: Bool , _loopRepeat :: Maybe Int} makeLenses ''GifOpts @@ -412,8 +318,8 @@ ( 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 +331,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 +350,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 +367,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 +379,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" 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 @@ -45,20 +45,17 @@ import Diagrams.TwoD.Adjust (adjustDia2D, setDefault2DAttributes) import Diagrams.TwoD.Path (Clip (Clip), getFillRule) -import Diagrams.TwoD.Size (requiredScaleT, sizePair) -import Diagrams.TwoD.Text hiding (font) +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 qualified Graphics.Rendering.Pango as P 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) -import Data.Default.Class import qualified Data.Foldable as F import Data.Hashable (Hashable (..)) import Data.List (isSuffixOf) @@ -77,6 +74,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. @@ -95,7 +95,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 @@ -134,12 +134,12 @@ 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? } @@ -150,7 +150,7 @@ r = runRenderM .runC . toRender $ t renderIO = do let surfaceF s = C.renderWith s r - (w,h) = sizePair (opts^.cairoSizeSpec) + V2 w h = specToSize 1 (opts^.cairoSizeSpec) case opts^.cairoOutputType of PNG -> C.withImageSurface C.FormatARGB32 (round w) (round h) $ \surface -> do @@ -165,14 +165,14 @@ then (opts, mempty, d # setDefault2DAttributes) else adjustDia2D cairoSizeSpec c opts (d # reflectY) -runC :: Render Cairo R2 -> RenderM () +runC :: Render Cairo V2 Double -> RenderM () runC (C r) = r -instance Monoid (Render Cairo R2) where +instance Monoid (Render Cairo V2 Double) where mempty = C $ return () (C rd1) `mappend` (C rd2) = C (rd1 >> rd2) -instance Hashable (Options Cairo R2) where +instance Hashable (Options Cairo V2 Double) where hashWithSalt s (CairoOptions fn sz out adj) = s `hashWithSalt` fn `hashWithSalt` @@ -180,7 +180,7 @@ out `hashWithSalt` adj -toRender :: RTree Cairo R2 a -> Render Cairo R2 +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 @@ -190,24 +190,24 @@ restore 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. @@ -219,7 +219,7 @@ -- 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 @@ -233,11 +233,11 @@ handle f = f `fmap` getAttr s clip = mapM_ (\p -> cairoPath p >> liftC C.clip) . op Clip lFillRule = liftC . C.setFillRule . fromFillRule . getFillRule - lWidth = liftC . C.setLineWidth . fromOutput . getLineWidth + lWidth = liftC . C.setLineWidth . getLineWidth lCap = liftC . C.setLineCap . fromLineCap . getLineCap lJoin = liftC . C.setLineJoin . fromLineJoin . getLineJoin lDashing (getDashing -> Dashing ds offs) = - liftC $ C.setDash (map fromOutput ds) (fromOutput offs) + liftC $ C.setDash ds offs fromFontSlant :: FontSlant -> P.FontStyle fromFontSlant FontSlantNormal = P.StyleNormal @@ -248,13 +248,9 @@ fromFontWeight FontWeightNormal = P.WeightNormal fromFontWeight FontWeightBold = P.WeightBold --- | 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) - -- | 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 @@ -275,14 +271,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 @@ -301,7 +297,7 @@ liftC C.closePath -instance Renderable (Path R2) Cairo where +instance Renderable (Path V2 Double) Cairo where render _ p = C $ do cairoPath p f <- getStyleAttrib getFillTexture @@ -313,7 +309,7 @@ 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 @@ -323,7 +319,7 @@ liftC $ uncurry C.moveTo p renderC tr -addStop :: MonadIO m => C.Pattern -> GradientStop -> m () +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) @@ -336,7 +332,7 @@ -- 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 -> RenderM () +setTexture :: Maybe (Texture Double) -> RenderM () setTexture Nothing = return () setTexture (Just (SC (SomeColor c))) = do o <- fromMaybe 1 <$> getStyleAttrib getOpacity @@ -362,13 +358,13 @@ 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)) + (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') + (x0, y0, x1, y1) = (x0' * (r1 - r0) / r1, y0' * (r1 - r0) / r1, x1' ,y1') -- Can only do PNG files at the moment... -instance Renderable (DImage External) Cairo where +instance Renderable (DImage Double External) Cairo where render _ (DImage path w h tr) = C . liftC $ do let ImageRef file = path if ".png" `isSuffixOf` file @@ -381,8 +377,8 @@ Right pngSurf -> do w' <- C.imageSurfaceGetWidth pngSurf h' <- C.imageSurfaceGetHeight pngSurf - let sz = Dims (fromIntegral w) (fromIntegral h) - cairoTransf $ requiredScaleT sz (fromIntegral w', fromIntegral h') + let sz = fromIntegral <$> dims2D w h + cairoTransf $ requiredScaling sz (fromIntegral <$> V2 w' h') C.setSourceSurface pngSurf (-fromIntegral w' / 2) (-fromIntegral h' / 2) Left _ -> @@ -399,17 +395,13 @@ if' :: Monad m => (a -> m ()) -> Maybe a -> m () if' = maybe (return ()) -instance Renderable Text Cairo where - render _ (Text tt tn al str) = C $ do - let tr = tn <> reflectionY +instance Renderable (Text Double) Cairo where + render _ (Text tt al str) = C $ do + let tr = tt <> reflectionY ff <- getStyleAttrib getFont fs <- getStyleAttrib (fromFontSlant . getFontSlant) fw <- getStyleAttrib (fromFontWeight . getFontWeight) - isLocal <- fromMaybe True <$> getStyleAttrib getFontSizeIsLocal - size <- getStyleAttrib (fromOutput . getFontSize) - let fSize | size == Nothing = Nothing - | isLocal = (avgScale tt *) <$> size - | otherwise = size + size' <- getStyleAttrib getFontSize f <- getStyleAttrib getFillTexture save setTexture f @@ -421,13 +413,13 @@ if' (P.fontDescriptionSetFamily font) ff if' (P.fontDescriptionSetStyle font) fs if' (P.fontDescriptionSetWeight font) fw - if' (P.fontDescriptionSetSize font) fSize + if' (P.fontDescriptionSetSize font) size' P.layoutSetFontDescription layout $ Just font -- XXX should use reflection font matrix here instead? case al of BoxAlignedText xt yt -> do (_,P.PangoRectangle _ _ w h) <- P.layoutGetExtents layout - return $ r2 ((lerp 0 w xt), (lerp h 0 yt)) + return $ r2 (w * xt, h * (1 - yt)) BaselineText -> do baseline <- P.layoutIterGetBaseline =<< P.layoutGetIter layout return $ r2 (0, baseline) @@ -438,7 +430,8 @@ -- C.setLineWidth 0.5 -- XXX Debugging -- C.stroke -- XXX Debugging -- C.newPath -- XXX Debugging - cairoTransf $ moveOriginBy ref mempty + let t = moveOriginBy ref mempty :: T2 Double + cairoTransf t P.updateLayout layout P.showLayout layout C.newPath 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,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 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,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 diff --git a/src/Diagrams/Backend/Cairo/Text.hs b/src/Diagrams/Backend/Cairo/Text.hs deleted file mode 100644 --- a/src/Diagrams/Backend/Cairo/Text.hs +++ /dev/null @@ -1,195 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} ------------------------------------------------------------------------------ --- | --- Module : Diagrams.Backend.Cairo.Text --- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE) --- License : BSD-style (see LICENSE) --- Maintainer : diagrams-discuss@googlegroups.com --- --- This module provides convenience functions for querying information --- from cairo. In particular, this provides utilities for information --- about fonts, and creating text primitives with bounds based on the --- font being used. To render text with automatically determined --- 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@. --- --- NOTE that this module has a couple significant caveats: --- --- * There are some known bugs --- () which --- are not easily fixable (they are probably bugs in cairo itself, --- but since we are using the \"toy text API\" they will never be --- fixed). --- --- * The functions in this module will only --- work with text whose font size is measured in @Local@ units. --- --- This module should thus be considered experimental/unsupported; if --- it works for you, great, but if not you are probably out of luck. --- See the @SVGFonts@ package for better-supported ways to accomplish --- similar things. --- -------------------------------------------------------------------------------- -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 - - , getTextExtents, getFontExtents, getExtents - , kerningCorrectionIO - - -- * Utilities - , queryCairo, unsafeCairo - , cairoWithStyle - ) where - -import Diagrams.Backend.Cairo.Internal -import Diagrams.BoundingBox -import Diagrams.Prelude hiding (height, view) - -import Control.Lens (makeLenses, view) -import System.IO.Unsafe - -import qualified Graphics.Rendering.Cairo as C - --- | 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' using 'unsafePerformIO'. -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 - --- | 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 - --- | 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