diagrams-cairo-1.3.1.1/0000755000000000000000000000000012754645372012742 5ustar0000000000000000diagrams-cairo-1.3.1.1/README.markdown0000644000000000000000000000432412754645372015446 0ustar0000000000000000[![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, 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 import Diagrams.Prelude import Diagrams.Backend.Cairo.CmdLine 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. diagrams-cairo-1.3.1.1/Setup.hs0000644000000000000000000000011012754645372014366 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain diagrams-cairo-1.3.1.1/CHANGELOG.md0000644000000000000000000003346612754645372014567 0ustar0000000000000000## [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)* diagrams-cairo-1.3.1.1/LICENSE0000644000000000000000000000416312754645372013753 0ustar0000000000000000Copyright 2011-2015 diagrams-cairo team: Daniel Bergey Christopher Chalmers Sam Griffin Niklas Haas John Lato Chris Mears Jeffrey Rosenbluth Ian Ross Justus Sagemüller Ryan Scott Michael Sloan Luite Stegeman Kanchalai Suveepattananont Robert Vollmert Ryan Yates Brent Yorgey 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. diagrams-cairo-1.3.1.1/diagrams-cairo.cabal0000644000000000000000000000727712754645372016625 0ustar0000000000000000Name: diagrams-cairo Version: 1.3.1.1 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. . * "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 == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 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.2 && < 4.10, mtl >= 2.0 && < 2.3, filepath, 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, split >= 0.1.2 && < 0.3, containers >= 0.3 && < 0.6, lens >= 3.8 && < 4.15, data-default-class >= 0.0.1 && < 0.2, statestack >= 0.2 && < 0.3, JuicyPixels >= 3.1.3.2 && < 3.3, vector >= 0.10.0 && < 0.12, array >= 0.4.0 && < 0.6, bytestring >= 0.9 && < 0.11, optparse-applicative >= 0.10 && < 0.14, transformers >= 0.3 && <0.6, hashable >= 1.1 && < 1.3 if impl(ghc < 7.6) Build-depends: ghc-prim default-language: Haskell2010 if !os(windows) cpp-options: -DCMDLINELOOP Build-depends: unix >= 2.4 && < 2.8 diagrams-cairo-1.3.1.1/src/0000755000000000000000000000000012754645372013531 5ustar0000000000000000diagrams-cairo-1.3.1.1/src/Diagrams/0000755000000000000000000000000012754645372015260 5ustar0000000000000000diagrams-cairo-1.3.1.1/src/Diagrams/Backend/0000755000000000000000000000000012754645372016607 5ustar0000000000000000diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo.hs0000644000000000000000000001275312754645372020210 0ustar0000000000000000{-# 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 (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- -- So the type of 'renderDia' resolves to -- -- @ -- 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 :: 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 diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo/0000755000000000000000000000000012754645372017644 5ustar0000000000000000diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo/Text.hs0000644000000000000000000000624012754645372021126 0ustar0000000000000000-- | -- 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 Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Pango as P import System.IO.Unsafe -- | Executes a cairo action on a dummy, zero-size image surface, in order to -- query things like font information. queryCairo :: C.Render a -> IO a 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.PangoRectangle,P.PangoRectangle) -> P.PangoRectangle) -> Style V2 Double -> Text Double -> IO (Diagram Cairo) textLineIO pick sty txt = do layout <- queryCairo $ layoutStyledText sty txt P.PangoRectangle x y w h <- pick <$> P.layoutGetExtents layout let bb = BB.fromCorners (mkP2 x y) (mkP2 (x + w) (y + h)) return $ mkQD (Prim txt) (getEnvelope bb) mempty mempty mempty diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo/Ptr.hs0000644000000000000000000000477712754645372020764 0ustar0000000000000000{-# 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 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 -> 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 diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo/List.hs0000644000000000000000000000340012754645372021110 0ustar0000000000000000{-# 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 Graphics.Rendering.Cairo (Format (..)) import Foreign.Marshal.Alloc (free) import Foreign.Marshal.Array (peekArray) -- | Render to a regular list of Colour values. renderToList :: (Ord a, Floating a) => Int -> Int -> 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" diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo/Internal.hs0000644000000000000000000004723012754645372021762 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- 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 -> Graphics.Rendering.Cairo.Type@, /i.e./ -- they convert from a diagrams type to a cairo type of the same name. ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Internal where import Diagrams.Core.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 Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM import qualified Graphics.Rendering.Pango as P import Codec.Picture import Codec.Picture.Types (convertImage, promoteImage, packPixel) 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.Foldable as F import Data.Hashable (Hashable (..)) import Data.List (isSuffixOf) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Tree import Data.Typeable import qualified Data.Array.MArray as MA import Data.Word (Word32) import Data.Bits (rotateL, (.&.)) import GHC.Generics (Generic) -- | This data declaration is simply used as a token to distinguish -- the cairo backend: (1) when calling functions where the type -- inference engine would otherwise have 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; 'Graphics.Rendering.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) 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 Monoid (Render Cairo V2 Double) where mempty = C $ return () (C rd1) `mappend` (C rd2) = C (rd1 >> rd2) 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.FontStyle fromFontSlant FontSlantNormal = P.StyleNormal fromFontSlant FontSlantItalic = P.StyleItalic fromFontSlant FontSlantOblique = P.StyleOblique fromFontWeight :: FontWeight -> P.Weight fromFontWeight FontWeightNormal = P.WeightNormal 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 P.showLayout layout C.newPath restore layoutStyledText :: Style V2 Double -> Text Double -> C.Render P.PangoLayout layoutStyledText sty (Text tt al str) = let tr = tt <> reflectionY styAttr :: AttributeClass a => (a -> b) -> Maybe b styAttr f = fmap f $ getAttr sty ff = styAttr getFont fs = styAttr fromFontSlant fw = styAttr fromFontWeight size' = styAttr getFontSize in do cairoTransf tr -- non-uniform scale layout <- P.createLayout str -- set font, including size liftIO $ do font <- P.fontDescriptionNew if' (P.fontDescriptionSetFamily font) ff if' (P.fontDescriptionSetStyle font) fs if' (P.fontDescriptionSetWeight font) fw if' (P.fontDescriptionSetSize font) size' P.layoutSetFontDescription layout $ Just font -- geometric translation ref <- liftIO $ case al of BoxAlignedText xt yt -> do (_,P.PangoRectangle _ _ w h) <- P.layoutGetExtents layout return $ r2 (w * xt, h * (1 - yt)) BaselineText -> do baseline <- P.layoutIterGetBaseline =<< P.layoutGetIter layout return $ r2 (0, baseline) let t = moveOriginBy ref mempty :: T2 Double cairoTransf t P.updateLayout layout return layout diagrams-cairo-1.3.1.1/src/Diagrams/Backend/Cairo/CmdLine.hs0000644000000000000000000003426412754645372021524 0ustar0000000000000000{-# 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 -- . -- ----------------------------------------------------------------------------- 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 -- | @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 -- | 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 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"