diagrams-gi-cairo (empty) → 1.4.2
raw patch · 11 files changed
+1890/−0 lines, 11 filesdep +JuicyPixelsdep +arraydep +basesetup-changed
Dependencies added: JuicyPixels, array, base, bytestring, colour, containers, diagrams-core, diagrams-lib, filepath, gi-cairo, gi-cairo-connector, gi-cairo-render, gi-pango, gi-pangocairo, hashable, mtl, optparse-applicative, split, statestack, text, unix, vector
Files
- CHANGELOG.md +430/−0
- LICENSE +47/−0
- README.markdown +81/−0
- Setup.hs +3/−0
- diagrams-gi-cairo.cabal +86/−0
- src/Diagrams/Backend/Cairo.hs +141/−0
- src/Diagrams/Backend/Cairo/CmdLine.hs +382/−0
- src/Diagrams/Backend/Cairo/Internal.hs +527/−0
- src/Diagrams/Backend/Cairo/List.hs +52/−0
- src/Diagrams/Backend/Cairo/Ptr.hs +64/−0
- src/Diagrams/Backend/Cairo/Text.hs +77/−0
+ CHANGELOG.md view
@@ -0,0 +1,430 @@+## [v1.4.2](https://github.com/diagrams/diagrams-gi-cairo/tree/v1.4.2) (2022-12-06)++- Initial release of `diagrams-gi-cairo`.+- Builds with GHC 8.10, 9.0, 9.2, and 9.4++# Changelog for predecessor package, diagrams-cairo++## [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++## [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)*
+ LICENSE view
@@ -0,0 +1,47 @@+Copyright 2011-2015 diagrams-cairo team:++ Daniel Bergey <bergey@alum.mit.edu>+ Christopher Chalmers <c.chalmers@me.com>+ Sam Griffin <sam.griffin@gmail.com>+ Niklas Haas <nand@lavabit.com>+ John Lato <jwlato@gmail.com>+ Chris Mears <chris@cmears.id.au>+ Jeffrey Rosenbluth <Jeffrey.Rosenbluth@gmail.com>+ Ian Ross <ian@skybluetrades.net>+ Justus Sagemüller <sagemueller@geo.uni-koeln.de>+ Ryan Scott <ryan.gl.scott@ku.edu>+ Michael Sloan <mgsloan@gmail.com>+ Luite Stegeman <stegeman@gmail.com>+ Kanchalai Suveepattananont <ksuvee@seas.upenn.edu>+ Robert Vollmert <rvollmert@gmx.net>+ Ryan Yates <fryguybob@gmail.com>+ Brent Yorgey <byorgey@cis.upenn.edu>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Brent Yorgey nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.markdown view
@@ -0,0 +1,81 @@+[](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,+using the [Haskell programming language][haskell].++[diagrams]: http://projects.haskell.org/diagrams/+[haskell]: http://www.haskell.org/haskellwiki/Haskell++_diagrams-cairo_ is implemented using the [cairo] rendering engine and+is a fully-featured, officially supported backend for diagrams.++[cairo]: http://www.cairographics.org/++# Installation++```+cabal update && cabal install gtk2hs-buildtools diagrams-cairo+```++# Basic usage++A simple example that uses _diagrams-cairo_ to draw a blue circle:++```haskell+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++import Diagrams.Prelude+import Diagrams.Backend.Cairo.CmdLine++d :: Diagram B+d = circle 1 # fc blue++main = mainWith (pad 1.1 d)+```++Save this to file named `Circle.hs` and compile it:++```+ghc --make Circle.hs+```++This will generate an executable which, when run, outputs a blue+circle to some file. Run the executable with the `--help` option to+find out more about how to call it.++```+$ ./Circle --help+./Circle++Usage: ./Circle [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT]+ [--loop] [-s|--src ARG] [-i|--interval INTERVAL]+ Command-line diagram generation.++Available options:+ -?,--help Show this help text+ -w,--width WIDTH Desired WIDTH of the output image+ -h,--height HEIGHT Desired HEIGHT of the output image+ -o,--output OUTPUT OUTPUT file+ -l,--loop Run in a self-recompiling loop+ -s,--src ARG Source file to watch+ -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds.+ommand-line diagram generation.+```++The output type will be automatically determined from the file+extension. Currently PNG, PDF, PS, and SVG are supported.++```+$ ./Circle -o circle.png -w 400+```++The command above generates a PNG file with a width of 400px.++# Advanced usage++Instead of just creating a standalone executable, the cairo backend+can also be called from within a larger program. For more+information, see the Diagram.Backend.Cairo module.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ diagrams-gi-cairo.cabal view
@@ -0,0 +1,86 @@+Name: diagrams-gi-cairo+Version: 1.4.2+Synopsis: Cairo backend for diagrams drawing EDSL+Description: A full-featured backend for rendering+ diagrams using the cairo rendering engine.+ This is intended to be+ a drop-in replacement for diagrams-cairo, built+ on top of the more up-to-date gi-cairo package.+ .+ 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.+ .+ * "Diagrams.Backend.Cairo" - look at this next.+ The general API for the cairo backend.+ .+ * "Diagrams.Backend.Cairo.Internal" - the+ implementation guts of the cairo backend.+ Users should normally not need to import this+ module.+ .+ * "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+License: BSD3+License-file: LICENSE+Author: Brent Yorgey+Maintainer: diagrams-discuss@googlegroups.com+Bug-reports: http://github.com/diagrams/diagrams-cairo/issues+Category: Graphics+Build-type: Simple+Cabal-version: >=1.10+Extra-source-files: CHANGELOG.md, README.markdown+Tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2+Source-repository head+ type: git+ location: http://github.com/diagrams/diagrams-cairo.git++Library+ Exposed-modules: Diagrams.Backend.Cairo+ Diagrams.Backend.Cairo.CmdLine+ Diagrams.Backend.Cairo.Internal+ Diagrams.Backend.Cairo.List+ Diagrams.Backend.Cairo.Ptr+ Diagrams.Backend.Cairo.Text+ Hs-source-dirs: src+ Build-depends: base >= 4.14 && < 4.18,+ text,+ mtl,+ filepath,+ diagrams-core,+ diagrams-lib,+ gi-cairo,+ gi-cairo-render,+ gi-cairo-connector,+ gi-pango,+ gi-pangocairo,+ colour,+ split,+ containers,+ statestack,+ JuicyPixels,+ vector,+ array,+ bytestring,+ optparse-applicative,+ hashable++ default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances -Wno-partial-type-signatures++ if !os(windows)+ cpp-options: -DCMDLINELOOP+ Build-depends: unix
+ src/Diagrams/Backend/Cairo.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Cairo+-- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- A full-featured rendering backend for diagrams using the+-- cairo rendering engine.+--+-- To invoke the cairo backend, you have three options.+--+-- * 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, @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 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 V2 Double = (IO (), 'GI.Cairo.Render' ())+-- @+--+-- So the type of 'renderDia' resolves to+--+-- @+-- renderDia :: Cairo -> Options Cairo V2 Double -> QQDiagram Cairo V2 Double Any m -> (IO (), 'GI.Cairo.Render' ())+-- @+--+-- which you could call like so:+--+-- @+-- 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+-- 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++ ( -- * Rendering+ renderCairo++ -- * Cairo-supported output formats+ , OutputType(..)++ -- * Cairo-specific options+ -- $CairoOptions++-- The below CPP hack is needed because GHC 7.0.x has a bug regarding+-- (re?)export of data family constructors; in particular the below+-- export causes the error "Not in scope: type constructor or class+-- `Options'" even though+-- http://www.haskell.org/haskellwiki/GHC/Type_families#Import_and_export+-- seems to indicate it should be supported. When using 7.0.x one+-- must import Diagrams.Backend.Cairo.Internal in order to bring+-- CairoOptions into scope.+-- GHC 7.4.0 regression?+#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 704+ , Options(..)+#endif++ -- * Backend token+ , Cairo(..)+ , B+ ) where++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 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.+++-- | 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.+--+-- 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
+ src/Diagrams/Backend/Cairo/CmdLine.hs view
@@ -0,0 +1,382 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Cairo.CmdLine+-- Copyright : (c) 2013 Diagrams-cairo team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Convenient creation of command-line-driven executables for+-- rendering diagrams using the cairo backend.+--+-- * 'defaultMain' creates an executable which can render a single+-- diagram at various options.+--+-- * 'multiMain' is like 'defaultMain' but allows for a list of+-- diagrams from which the user can choose one to render.+--+-- * '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.+--+-- * Use a function with 'mainWith'. This may require making+-- 'Parseable' instances for custom argument types.+--+-- * Make a new 'Mainable' instance. This may require a newtype+-- wrapper on your diagram type to avoid the existing instances.+-- This gives you more control over argument parsing, intervening+-- steps, and diagram creation.+--+-- * Build option records and pass them along with a diagram to 'mainRender'+-- from "Diagrams.Backend.CmdLine".+--+-- * 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+-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.+--+-----------------------------------------------------------------------------++module Diagrams.Backend.Cairo.CmdLine+ (+ -- * General form of @main@+ -- $mainwith++ mainWith++ -- * Supported forms of @main@++ , defaultMain+ , multiMain+ , animMain+ , gifMain++ -- * GIF support++ , GifOpts(..)+ , gifRender++ -- * Backend tokens++ , Cairo+ , B+ ) where++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+#endif++#if __GLASGOW_HASKELL__ < 710+import Foreign.ForeignPtr.Safe (ForeignPtr)+#else+import Foreign.ForeignPtr (ForeignPtr)+#endif++import Data.List.Split++-- $mainwith+-- The 'mainWith' method unifies all of the other forms of @main@ and is now+-- the recommended way to build a command-line diagrams program. It works as a+-- direct replacement for 'defaultMain', '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+++-- | This is the simplest way to render diagrams, and is intended to+-- be used like so:+--+-- > ... other definitions ...+-- > myDiagram = ...+-- >+-- > main = defaultMain myDiagram+--+-- Compiling a source file like the above example will result in an+-- executable which takes command-line options for setting the size,+-- output file, and so on, and renders @myDiagram@ with the+-- specified options.+--+-- On Unix systems, the generated executable also supports a+-- rudimentary \"looped\" mode, which watches the source file for+-- changes and recompiles itself on the fly.+--+-- Pass @--help@ to the generated executable to see all available+-- options. Currently it looks something like+--+-- @+-- ./Program+--+-- Usage: ./Program [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT]+-- [--loop] [-s|--src ARG] [-i|--interval INTERVAL]+-- Command-line diagram generation.+--+-- Available options:+-- -?,--help Show this help text+-- -w,--width WIDTH Desired WIDTH of the output image+-- -h,--height HEIGHT Desired HEIGHT of the output image+-- -o,--output OUTPUT OUTPUT file+-- -l,--loop Run in a self-recompiling loop+-- -s,--src ARG Source file to watch+-- -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds.+-- @+--+-- For example, a couple common scenarios include+--+-- @+-- $ ghc --make MyDiagram+--+-- # output image.png with a width of 400px (and auto-determined height)+-- $ ./MyDiagram -o image.png -w 400+--+-- # output 200x200 dia.pdf, then watch for changes every 10 seconds+-- $ ./MyDiagram -o dia.pdf -h 200 -w 200 -l -i 10+-- @++defaultMain :: QDiagram Cairo V2 Double Any -> IO ()+defaultMain = mainWith++instance Mainable (QDiagram Cairo V2 Double Any) where+ type MainOpts (QDiagram Cairo V2 Double Any) = (DiagramOpts, DiagramLoopOpts)++ mainRender (opts, l) d = chooseRender opts d >> defaultLoopRender l++chooseRender :: DiagramOpts -> QDiagram Cairo V2 Double Any -> IO ()+chooseRender opts d =+ 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+ "png" -> PNG+ "ps" -> PS+ "pdf" -> PDF+ "svg" -> SVG+ _ -> PDF+ fst $ renderDia+ Cairo+ ( CairoOptions+ (opts^.output)+ (fromIntegral <$> mkSizeSpec2D+ (opts ^. width )+ (opts ^. height)+ )+ outTy+ False+ )+ d+ | otherwise -> putStrLn $ "Unknown file type: " ++ last ps++-- | @multiMain@ is like 'defaultMain', except instead of a single+-- diagram it takes a list of diagrams paired with names as input.+-- The generated executable then takes a @--selection@ option+-- specifying the name of the diagram that should be rendered. The+-- list of available diagrams may also be printed by passing the+-- option @--list@.+--+-- Example usage:+--+-- @+-- $ ghc --make MultiTest+-- [1 of 1] Compiling Main ( MultiTest.hs, MultiTest.o )+-- Linking MultiTest ...+-- $ ./MultiTest --list+-- Available diagrams:+-- foo bar+-- $ ./MultiTest --selection bar -o Bar.png -w 200+-- @++multiMain :: [(String, QDiagram Cairo V2 Double Any)] -> IO ()+multiMain = mainWith++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+-- by rendering one image for each frame, named by extending the given+-- output file name by consecutive integers. For example if the given+-- output file name is @foo\/blah.png@, the frames will be saved in+-- @foo\/blah001.png@, @foo\/blah002.png@, and so on (the number of+-- padding digits used depends on the total number of frames). It is+-- up to the user to take these images and stitch them together into+-- an actual animation format (using, /e.g./ @ffmpeg@).+--+-- Of course, this is a rather crude method of rendering animations;+-- more sophisticated methods will likely be added in the future.+--+-- The @--fpu@ option can be used to control how many frames will be+-- output for each second (unit time) of animation.+animMain :: Animation Cairo V2 Double -> IO ()+animMain = mainWith++instance Mainable (Animation Cairo V2 Double) where+ type MainOpts (Animation Cairo V2 Double) = ((DiagramOpts, DiagramAnimOpts), DiagramLoopOpts)++ mainRender (opts, l) d = defaultAnimMainRender chooseRender output opts d >> defaultLoopRender l++-- | Extra options for animated GIFs.+data GifOpts = GifOpts { _dither :: Bool+ , _noLooping :: Bool+ , _loopRepeat :: Maybe Int}++makeLenses ''GifOpts++-- | Command line parser for 'GifOpts'.+-- @--dither@ turn dithering on.+-- @--looping-off@ turn looping off, i.e play GIF once.+-- @--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" )++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++-- | @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++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"
+ src/Diagrams/Backend/Cairo/Internal.hs view
@@ -0,0 +1,527 @@+{-# 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 #-}+{-# OPTIONS -fno-warn-incomplete-uni-patterns #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Cairo.Internal+-- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- This module contains the internal implementation guts of the+-- diagrams cairo backend. If you want to see how the cairo backend+-- works under the hood, you are in the right place (try clicking on+-- the \"Source\" links). (Guts under the hood, what an awful mixed+-- metaphor.) If you know what you are doing and really want access+-- to the internals of the implementation, you are also in the right+-- place. Otherwise, you should have no need of this module; import+-- "Diagrams.Backend.Cairo.CmdLine" or "Diagrams.Backend.Cairo"+-- instead.+--+-- The one exception is that this module may have to be imported+-- 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 -> GI.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.Compile+import Diagrams.Core.Transform++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 GI.Cairo.Render as C+import qualified GI.Cairo.Render.Matrix as CM+import qualified GI.Cairo.Render.Connector as C+import qualified GI.Pango as P+import qualified GI.PangoCairo as P++import Codec.Picture+import Codec.Picture.Types (convertImage, packPixel,+ promoteImage)+++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)+import Data.Text (pack)++-- | 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 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.+data OutputType =+ 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; see the @diagrams-gtk@ package).+ deriving (Eq, Ord, Read, Show, Bounded, Enum, Typeable, Generic)++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; 'GI.Cairo.Render' is cairo's own rendering+-- monad.+type RenderM a = SS.StateStackT CairoState C.Render a++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 = SS.save >> liftC C.save++-- | Restore the context from a stack.+restore :: RenderM ()+restore = liftC C.restore >> SS.restore++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)++ renderRTree _ opts t = (renderIO, r)+ where+ r = runRenderM .runC . toRender $ t+ renderIO = do+ let surfaceF s = C.renderWith s r+ V2 w h = specToSize 1 (opts^.cairoSizeSpec)+ case opts^.cairoOutputType of+ PNG ->+ C.withImageSurface C.FormatARGB32 (round w) (round h) $ \surface -> do+ surfaceF surface+ C.surfaceWriteToPNG surface (opts^.cairoFileName)+ PS -> C.withPSSurface (opts^.cairoFileName) w h surfaceF+ PDF -> C.withPDFSurface (opts^.cairoFileName) w h surfaceF+ SVG -> C.withSVGSurface (opts^.cairoFileName) w h surfaceF+ RenderOnly -> return ()++ adjustDia c opts d = if _cairoBypassAdjust opts+ then (opts, mempty, d # setDefault2DAttributes)+ else let (opts', transformation, d') = adjustDia2D cairoSizeSpec c opts (d # reflectY)+ in (opts', transformation <> reflectionY, d')++runC :: Render Cairo V2 Double -> RenderM ()+runC (C r) = r++instance Semigroup (Render Cairo V2 Double) where+ C rd1 <> C rd2 = C (rd1 >> rd2)++instance Monoid (Render Cairo V2 Double) where+ mempty = C $ return ()+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+#endif++instance Hashable (Options Cairo V2 Double) where+ hashWithSalt s (CairoOptions fn sz out adj)+ = s `hashWithSalt`+ fn `hashWithSalt`+ sz `hashWithSalt`+ out `hashWithSalt`+ adj++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++cairoFileName :: Lens' (Options Cairo V2 Double) String+cairoFileName = lens (\(CairoOptions {_cairoFileName = f}) -> f)+ (\o f -> o {_cairoFileName = f})++cairoSizeSpec :: Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)+cairoSizeSpec = lens (\(CairoOptions {_cairoSizeSpec = s}) -> s)+ (\o s -> o {_cairoSizeSpec = 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 clip+ , handle lFillRule+ , handle lWidth+ , handle lCap+ , handle lJoin+ , handle lDashing+ ]+ where handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ())+ 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 . getLineWidth+ lCap = liftC . C.setLineCap . fromLineCap . getLineCap+ lJoin = liftC . C.setLineJoin . fromLineJoin . getLineJoin+ lDashing (getDashing -> Dashing ds offs) =+ liftC $ C.setDash ds offs++fromFontSlant :: FontSlant -> P.Style+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 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++fromLineCap :: LineCap -> C.LineCap+fromLineCap LineCapButt = C.LineCapButt+fromLineCap LineCapRound = C.LineCapRound+fromLineCap LineCapSquare = C.LineCapSquare++fromLineJoin :: LineJoin -> C.LineJoin+fromLineJoin LineJoinMiter = C.LineJoinMiter+fromLineJoin LineJoinRound = C.LineJoinRound+fromLineJoin LineJoinBevel = C.LineJoinBevel++fromFillRule :: FillRule -> C.FillRule+fromFillRule Winding = C.FillRuleWinding+fromFillRule EvenOdd = C.FillRuleEvenOdd++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 V2 Double) Cairo where+ render _ = withTrail renderLine renderLoop+ where+ renderLine ln = C $ do+ mapM_ renderC (lineSegments ln)++ -- 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 (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+ cairoTransf (tr <> reflectionY)+ pngSurfChk <- liftIO (try $ C.imageSurfaceCreateFromPNG file+ :: IO (Either IOError C.Surface))+ case pngSurfChk of+ Right pngSurf -> do+ 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 ++ ">"+ C.paint+ C.restore+ else+ liftIO . putStr . unlines $+ [ "Warning: Cairo backend can currently only render embedded"+ , " images in .png format. Ignoring <" ++ file ++ ">."+ ]++-- 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+ context <- C.getContext+ P.showLayout context layout+ C.newPath+ restore++layoutStyledText :: Style V2 Double -> Text Double -> C.Render P.Layout+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+ context <- C.getContext+ cairoTransf tr -- non-uniform scale+ layout <- P.createLayout context+ P.layoutSetText layout (pack str) (-1)+ -- set font, including size+ liftIO $ do+ font <- P.fontDescriptionNew+ if' (P.fontDescriptionSetFamily font) $ fmap pack 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+ (_,prect) <- P.layoutGetExtents layout+ (realToFrac -> w) <- P.getRectangleWidth prect+ (realToFrac -> h) <- P.getRectangleHeight prect+ return $ r2 (w * xt, h * (1 - yt))+ BaselineText -> do+ (realToFrac -> baseline) <- P.layoutIterGetBaseline =<< P.layoutGetIter layout+ return $ r2 (0, baseline)+ let t = moveOriginBy ref mempty :: T2 Double+ cairoTransf t+ P.updateLayout context layout+ return layout
+ src/Diagrams/Backend/Cairo/List.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Cairo.List+-- Copyright : (c) 2012 Diagrams-cairo team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Render a diagram directly to a list of lists of Colour values+-- (/i.e./ pixels).+--+-----------------------------------------------------------------------------++module Diagrams.Backend.Cairo.List where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif++import Control.Exception (bracket)++import Data.Colour+import Data.Colour.SRGB (sRGB)+import Data.Word (Word8)++import Diagrams.Backend.Cairo (Cairo)+import Diagrams.Backend.Cairo.Ptr (renderPtr)+import Diagrams.Prelude (Any, QDiagram, V2)+import GI.Cairo.Render (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 -> 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+ 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 x = fromIntegral x / fromIntegral a+ c = sRGB (l r) (l g) (l b) `withOpacity` (fromIntegral a / 255)++ in case f (n+1) xs of+ [] -> [[c]]+ cs:ys -> (c:cs) : ys++ f _ _ = error "renderToList: Internal format error"
+ src/Diagrams/Backend/Cairo/Ptr.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Cairo.Ptr+-- Copyright : (c) 2012 Diagrams-cairo team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Render diagrams to buffers in memory.+--+-----------------------------------------------------------------------------++module Diagrams.Backend.Cairo.Ptr where++import Data.Word (Word8)++import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Internal+import Diagrams.Prelude (Any, QDiagram, V2, dims2D,+ renderDia)++import Foreign.Marshal.Alloc (finalizerFree)+import Foreign.Marshal.Array (mallocArray, pokeArray)+import Foreign.Ptr (Ptr, castPtr)++import GI.Cairo.Render (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 -> 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 = fromIntegral <$> dims2D w h+ , _cairoOutputType = RenderOnly+ , _cairoBypassAdjust = False+ , _cairoFileName = ""+ }+ (_, r) = renderDia Cairo opt d++ b <- mallocArray size+ pokeArray b (replicate size 0)+ withImageSurfaceForData b fmt w h stride (`renderWith` r)++ return (castPtr b)++-- | Like 'renderPtr' but automatically garbage collected by Haskell.++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
+ src/Diagrams/Backend/Cairo/Text.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE ViewPatterns #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Cairo.Text+-- Copyright : (c) 2015 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' '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@.++module Diagrams.Backend.Cairo.Text+ (+ -- | These create diagrams instantiated with extent-based envelopes.+ textLineBoundedIO+ , textVisualBoundedIO++ -- * Utilities+ , queryCairo, unsafeCairo+ ) where++import Diagrams.Backend.Cairo.Internal+import qualified Diagrams.BoundingBox as BB+import Diagrams.Prelude hiding (height, view)+import Diagrams.TwoD.Text hiding (font)++import qualified GI.Cairo.Render as C+import qualified GI.Pango as P++import System.IO.Unsafe++-- | Executes a cairo action on a dummy, zero-size image surface, in order to+-- query things like font information.+queryCairo :: C.Render a -> IO a+queryCairo c = C.withImageSurface C.FormatA1 0 0 (`C.renderWith` c)++-- | Unsafely invokes 'queryCairo' using 'unsafePerformIO'.+unsafeCairo :: C.Render a -> a+unsafeCairo = unsafePerformIO . queryCairo++-- | Creates text diagrams with their envelopes set such that using+-- @'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 V2 Double -> Text Double -> IO (Diagram Cairo)+textVisualBoundedIO = textLineIO snd++-- | Abstract common code from @textLineBoundedIO@ and @textVisualBoundedIO@+-- textLineIO :: ((a,a) -> a) -> Style V2 Double -> Text Double -> IO (Diagram Cairo)+textLineIO :: ((P.Rectangle,P.Rectangle) -> P.Rectangle) -> Style V2 Double -> Text Double -> IO (Diagram Cairo)+textLineIO pick sty txt = do+ layout <- queryCairo $ layoutStyledText sty txt+ prect <- pick <$> P.layoutGetExtents layout+ (realToFrac -> x) <- P.getRectangleX prect+ (realToFrac -> y) <- P.getRectangleY prect+ (realToFrac -> w) <- P.getRectangleWidth prect+ (realToFrac -> h) <- P.getRectangleHeight prect+ let bb = BB.fromCorners (mkP2 x y) (mkP2 (x + w) (y + h))+ return $ mkQD (Prim txt) (getEnvelope bb) mempty mempty mempty