diagrams-cairo-0.7/0000755000000000000000000000000012201204405012416 5ustar0000000000000000diagrams-cairo-0.7/LICENSE0000644000000000000000000000351512201204405013427 0ustar0000000000000000Copyright 2011-2013 diagrams-cairo team: Sam Griffin Niklas Haas John Lato Ian Ross Michael Sloan Luite Stegeman Kanchalai Suveepattananont 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-0.7/CHANGES.markdown0000644000000000000000000001073512201204405015240 0ustar00000000000000000.7: 9 August 2013 ------------------ * **New features** - New `renderCairo` function for more convenient use of the cairo backend. - Lots of Haddock documentation improvements. * **New instances** - `Show` instance for `Options Cairo R2`. 0.6: 11 December 2012 --------------------- * **New features** - New `--list` option for `multiMain` to list all available diagrams - Major documentation improvements - New modules: + `Diagrams.Backend.Cairo.Ptr`, for rendering directly to buffers in memory + `Diagrams.Backend.Cairo.List`, for rendering to a list of lists of pixels. * **API changes** - Removal of `StyleParam` from `Diagrams.Backend.Cairo.Text`, change functions in that module to accept `Style R2`. Usage can be fixed by applying these style functions to `mempty`. - GTK rendering has been split out into a new package, diagrams-gtk. + The `Diagrams.Backend.Cairo.Gtk` module is now `Diagrams.Backend.Gtk` in the `diagrams-gtk` package. + The `CairoOptions` record has a new boolean `cairoBypassAdjust` option; when set, the backend should bypass calling `adjustDia2D`. + The GTK output type is gone. + There is a new `RenderOnly` output type, for when you don't care about the `IO` action but only want the cairo `Render` action. * **Dependency/version changes** - Upper bounds relaxed to allow `base`-4.6, `unix`-2.6, `cmdargs`-0.10, `split`-0.2.*, `mtl`-2.1 - Add a dependency on `time`, and conditional compilation to use either ClockTime or UTCTime depending on the version of the `directory` package - Add dependency on `colour` - Lower bound on `cairo` raised to 0.12.4 * **Bug fixes** - Fixed looped compile mode, which was repeatedly trying to compile when the code contained errors, instead of trying once and then waiting for a change. - Fix a bug where default attributes were not being set when using the "bypass" mode used by the gtk backend. ([\#16](https://github.com/diagrams/diagrams-cairo/pull/16)) 0.5.0.2 : 13 May 2012 --------------------- * Allow building under `mtl` 2.1.* 0.5.0.1 : 9 March 2012 ---------------------- * Remove statement in package description that a development version of `gtk2hs` must be used with GHC 7.4; this is no longer true as of the 0.12.3 release of `gtk2hs`. 0.5: 9 March 2012 ----------------- * **New features** - New `Diagrams.Backend.Cairo.Text` module by Michael Sloan, with functions for creating appropriately sized text objects by querying cairo for the size, and related supporting functions. - Basic support for animation with `animMain` function, by generating frames sampled at regular intervals. - Proper vertical alignment of default text based on font parameters (Michael Sloan). - Requesting just a width or height now causes the other to be computed appropriately. * **API changes** - Move `Diagrams.Backend.Cairo` to `Diagrams.Backend.Cairo.Internal` and export everything. `Diagrams.Backend.Cairo` now just re-exports selected functions from `Internal`. This allows anyone who wants access to the helper/utility functions to import `Internal`. * **Dependency/version changes** - relax `cmdargs` upper bound - GHC 7.4.1 compatibility: update `base`, `filepath`, and `old-time` upper bounds * **Bug fixes** - [\#54](http://code.google.com/p/diagrams/issues/detail?id=54): Generate warning for missing image files (Ian Ross). 0.4: 22 October 2011 -------------------- * New features: + Support for drawing directly to Gtk widgets + Support for path fill rule attribute * New/improved examples * Improved documentation * Bug fixes: + Warning for unsupported image types (#41) 0.3: 18 June 2011 ----------------- * Some new/improved examples * New features: + simple text support + simple support for external PNG images 0.2: 3 June 2011 ---------------- * add `Typeable` and other instances for `Cairo` type * generalize `Result` type to `(IO (), Render ())`, so programs that don't want to generate a file but just want a `Render` operation (*e.g.* to use to paint a gtk window) can use the second component. * add support for opacity attribute and path clipping 0.1.2: 18 May 2011 ------------------ * link to new website 0.1.1: 18 May 2011 ------------------ * fix tic-tac-toe example 0.1: 17 May 2011 ---------------- * initial preview release diagrams-cairo-0.7/README.markdown0000644000000000000000000000355712201204405015131 0ustar0000000000000000[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-cairo.png)](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 = defaultMain (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 Command-line diagram generation. Circle [OPTIONS] Common flags: -w --width=INT Desired width of the output image -h --height=INT Desired height of the output image -o --output=FILE Output file -? --help Display help message -V --version Print version information ``` 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-0.7/Setup.hs0000644000000000000000000000011012201204405014042 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain diagrams-cairo-0.7/diagrams-cairo.cabal0000644000000000000000000000551712201204405016274 0ustar0000000000000000Name: diagrams-cairo Version: 0.7 Synopsis: Cairo backend for diagrams drawing EDSL Description: A full-featured backend for rendering diagrams using the cairo rendering engine. . * "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.Text" - cairo-specific text support, including automatic bounding boxes. . * "Diagrams.Backend.Cairo.List" - render diagrams to two-dimensional lists of colors (/i.e./ pixels). . * "Diagrams.Backend.Cairo.Ptr" - render diagrams to buffers in memory. Homepage: http://projects.haskell.org/diagrams 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: CHANGES.markdown, README.markdown Tested-with: GHC == 7.4.2, GHC == 7.6.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.7, mtl >= 2.0 && < 2.2, process, directory, filepath, old-time, time, diagrams-core >= 0.7 && < 0.8, diagrams-lib >= 0.7 && < 0.8, cairo >= 0.12.4 && < 0.13, cmdargs >= 0.6 && < 0.11, colour, split >= 0.1.2 && < 0.3 default-language: Haskell2010 if !os(windows) cpp-options: -DCMDLINELOOP Build-depends: unix >= 2.4 && < 2.7 diagrams-cairo-0.7/src/0000755000000000000000000000000012201204405013205 5ustar0000000000000000diagrams-cairo-0.7/src/Diagrams/0000755000000000000000000000000012201204405014734 5ustar0000000000000000diagrams-cairo-0.7/src/Diagrams/Backend/0000755000000000000000000000000012201204405016263 5ustar0000000000000000diagrams-cairo-0.7/src/Diagrams/Backend/Cairo.hs0000644000000000000000000001262612201204405017663 0ustar0000000000000000{-# LANGUAGE TypeFamilies, CPP #-} ----------------------------------------------------------------------------- -- | -- 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 -> QDiagram b v m -> Result b v -- -- (omitting a few type class constraints). @b@ represents the -- backend type, @v@ the vector space, and @m@ the type of monoidal -- query annotations on the diagram. 'Options' and 'Result' are -- associated data and type families, respectively, which yield the -- type of option records and rendering results specific to any -- particular backend. For @b ~ Cairo@ and @v ~ R2@, we have -- -- > data family Options Cairo R2 = CairoOptions -- > { cairoFileName :: String -- ^ The name of the file you want generated -- > , cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output -- > , cairoOutputType :: OutputType -- ^ the output format and associated options -- > , cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? -- > } -- -- @ -- type family Result Cairo R2 = (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- -- So the type of 'renderDia' resolves to -- -- @ -- renderDia :: Cairo -> Options Cairo R2 -> QDiagram Cairo R2 m -> (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- -- which you could call like so: -- -- @ -- renderDia Cairo (CairoOptions \"foo.png\" (Width 250) PNG False) (myDiagram :: Diagram Cairo R2) -- @ -- -- 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 v = QDiagram b v Any@ to fix @m = Any@. -- ----------------------------------------------------------------------------- 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(..) ) 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 R2 = CairoOptions -- > { cairoFileName :: String -- ^ The name of the file you want generated -- > , cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output -- > , cairoOutputType :: OutputType -- ^ the output format and associated options -- > } -- -- See the documentation at the top of "Diagrams.Backend.Cairo" for -- information on how to make use of this. -- -- /Important note/: a bug in GHC 7.0.x and 7.4.1 prevents -- re-exporting this data family. (Strangely, this bug seems to be -- present in 7.0 and 7.4 but not 7.2.) To bring CairoOptions into -- scope when using GHC 7.0.x or 7.4 you must import -- "Diagrams.Backend.Cairo.Internal". -- | Render a diagram using the cairo backend, writing to the given -- output file and using the requested size. The output type (PNG, -- PS, PDF, or SVG) is determined automatically from the output file -- 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 -> SizeSpec2D -> Diagram Cairo R2 -> 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 _ -> PNGdiagrams-cairo-0.7/src/Diagrams/Backend/Cairo/0000755000000000000000000000000012201204405017320 5ustar0000000000000000diagrams-cairo-0.7/src/Diagrams/Backend/Cairo/CmdLine.hs0000644000000000000000000003012412201204405021167 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.CmdLine -- Copyright : (c) 2011 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. -- -- If you want to generate diagrams programmatically---/i.e./ if you -- want to do anything more complex than what the below functions -- provide---you have several options. -- -- * A simple but somewhat inflexible approach is to wrap up -- 'defaultMain' (or 'multiMain', or 'animMain') in a call to -- 'System.Environment.withArgs'. -- -- * 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. -- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.CmdLine ( defaultMain , multiMain , animMain , Cairo ) where import Data.List (intercalate) import Diagrams.Prelude hiding (width, height, interval) import Diagrams.Backend.Cairo -- 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 import System.Console.CmdArgs.Implicit hiding (args) import Prelude hiding (catch) import Data.Maybe (fromMaybe) import Control.Monad (when, forM_, mplus) import Data.List.Split import Text.Printf import System.Environment (getArgs, getProgName) import System.Directory (getModificationTime) import System.FilePath (addExtension, splitExtension) import System.Process (runProcess, waitForProcess) import System.IO (openFile, hClose, IOMode(..), hSetBuffering, BufferMode(..), stdout) import System.Exit (ExitCode(..)) import Control.Concurrent (threadDelay) import Control.Exception (catch, SomeException(..), bracket) #ifdef CMDLINELOOP import System.Posix.Process (executeFile) #if MIN_VERSION_directory(1,2,0) import Data.Time.Clock (UTCTime,getCurrentTime) type ModuleTime = UTCTime getModuleTime :: IO ModuleTime getModuleTime = getCurrentTime #else import System.Time (ClockTime, getClockTime) type ModuleTime = ClockTime getModuleTime :: IO ModuleTime getModuleTime = getClockTime #endif #endif data DiagramOpts = DiagramOpts { width :: Maybe Int , height :: Maybe Int , output :: FilePath , list :: Bool , selection :: Maybe String , fpu :: Double #ifdef CMDLINELOOP , loop :: Bool , src :: Maybe String , interval :: Int #endif } deriving (Show, Data, Typeable) diagramOpts :: String -> Bool -> DiagramOpts diagramOpts prog sel = DiagramOpts { width = def &= typ "INT" &= help "Desired width of the output image" , height = def &= typ "INT" &= help "Desired height of the output image" , output = def &= typFile &= help "Output file" , selection = def &= help "Name of the diagram to render" &= (if sel then typ "NAME" else ignore) , list = def &= (if sel then help "List all available diagrams" else ignore) , fpu = 30 &= typ "FLOAT" &= help "Frames per unit time (for animations)" #ifdef CMDLINELOOP , loop = False &= help "Run in a self-recompiling loop" , src = def &= typFile &= help "Source file to watch" , interval = 1 &= typ "SECONDS" &= help "When running in a loop, check for changes every n seconds." #endif } &= summary "Command-line diagram generation." &= program prog -- | This is the simplest way to render diagrams, and is intended to -- be used like so: -- -- > ... 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 -- -- @ -- Command-line diagram generation. -- -- Foo [OPTIONS] -- -- Common flags: -- -w --width=INT Desired width of the output image -- -h --height=INT Desired height of the output image -- -o --output=FILE Output file -- -f --fpu=FLOAT Frames per unit time (for animations) -- -l --loop Run in a self-recompiling loop -- -s --src=FILE Source file to watch -- -i --interval=SECONDS When running in a loop, check for changes every n -- seconds. -- -? --help Display help message -- -V --version Print version information -- @ -- -- 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 :: Diagram Cairo R2 -> IO () defaultMain d = do prog <- getProgName args <- getArgs opts <- cmdArgs (diagramOpts prog False) chooseRender opts d #ifdef CMDLINELOOP when (loop opts) (waitForChange Nothing opts prog args) #endif chooseRender :: DiagramOpts -> Diagram Cairo R2 -> IO () chooseRender opts d = case splitOn "." (output opts) 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 (output opts) (mkSizeSpec (fromIntegral <$> width opts) (fromIntegral <$> height opts) ) 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, Diagram Cairo R2)] -> IO () multiMain ds = do prog <- getProgName opts <- cmdArgs (diagramOpts prog True) if list opts then showDiaList (map fst ds) else case selection opts of Nothing -> putStrLn "No diagram selected." >> showDiaList (map fst ds) Just sel -> case lookup sel ds of Nothing -> putStrLn $ "Unknown diagram: " ++ sel Just d -> chooseRender opts d -- | Display the list of diagrams available for rendering. showDiaList :: [String] -> IO () showDiaList ds = do putStrLn "Available diagrams:" putStrLn $ " " ++ intercalate " " ds -- | @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 R2 -> IO () animMain anim = do prog <- getProgName opts <- cmdArgs (diagramOpts prog False) let frames = simulate (toRational $ fpu opts) anim nDigits = length . show . length $ frames forM_ (zip [1..] frames) $ \(i,d) -> chooseRender (indexize nDigits i opts) d -- | @indexize d n@ adds the integer index @n@ to the end of the -- output file name, padding with zeros if necessary so that it uses -- at least @d@ digits. indexize :: Int -> Integer -> DiagramOpts -> DiagramOpts indexize nDigits i opts = opts { output = output' } where fmt = "%0" ++ show nDigits ++ "d" output' = addExtension (base ++ printf fmt (i::Integer)) ext (base, ext) = splitExtension (output opts) #ifdef CMDLINELOOP waitForChange :: Maybe ModuleTime -> DiagramOpts -> String -> [String] -> IO () waitForChange lastAttempt opts prog args = do hSetBuffering stdout NoBuffering go lastAttempt where go lastAtt = do threadDelay (1000000 * interval opts) -- putStrLn $ "Checking... (last attempt = " ++ show lastAttempt ++ ")" (newBin, newAttempt) <- recompile lastAtt prog (src opts) if newBin then executeFile prog False args Nothing else go $ newAttempt `mplus` lastAtt -- | @recompile t prog@ attempts to recompile @prog@, assuming the -- last attempt was made at time @t@. If @t@ is @Nothing@ assume -- the last attempt time is the same as the modification time of the -- binary. If the source file modification time is later than the -- last attempt time, then attempt to recompile, and return the time -- of this attempt. Otherwise (if nothing has changed since the -- last attempt), return @Nothing@. Also return a Bool saying -- whether a successful recompilation happened. recompile :: Maybe ModuleTime -> String -> Maybe String -> IO (Bool, Maybe ModuleTime) recompile lastAttempt prog mSrc = do let errFile = prog ++ ".errors" srcFile = fromMaybe (prog ++ ".hs") mSrc binT <- maybe (getModTime prog) (return . Just) lastAttempt srcT <- getModTime srcFile if (srcT > binT) then do putStr "Recompiling..." status <- bracket (openFile errFile WriteMode) hClose $ \h -> waitForProcess =<< runProcess "ghc" ["--make", srcFile] Nothing Nothing Nothing Nothing (Just h) if (status /= ExitSuccess) then putStrLn "" >> putStrLn (replicate 75 '-') >> readFile errFile >>= putStr else putStrLn "done." curTime <- getModuleTime return (status == ExitSuccess, Just curTime) else return (False, Nothing) where getModTime f = catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) #endif diagrams-cairo-0.7/src/Diagrams/Backend/Cairo/Internal.hs0000644000000000000000000003251612201204405021437 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- 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.Transform import Diagrams.Located (viewLoc) import Diagrams.Prelude import Diagrams.Trail import Diagrams.TwoD.Adjust (adjustDia2D, setDefault2DAttributes) import Diagrams.TwoD.Image import Diagrams.TwoD.Path (Clip (..), getFillRule) import Diagrams.TwoD.Size (requiredScaleT) import Diagrams.TwoD.Text import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM import Control.Monad.State import Data.List (isSuffixOf) import Data.Maybe (catMaybes, fromMaybe) import Control.Exception (try) import qualified Data.Foldable as F import Data.Typeable -- | 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) -- | 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) instance Monoid (Render Cairo R2) where mempty = C $ return () (C rd1) `mappend` (C rd2) = C (rd1 >> rd2) -- | The custom monad in which intermediate drawing options take -- place; 'Graphics.Rendering.Cairo.Render' is cairo's own rendering -- monad. Right now we simply maintain a Bool state to track -- 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. type RenderM a = StateT Bool C.Render a -- no state for now -- Simple, stupid implementations of save and restore for now. If -- need be we could switch to a more sophisticated implementation -- using an "undoable state" monad which lets you save (push state -- onto a stack) and restore (pop from the stack). -- | Push the current context onto a stack. save :: RenderM () save = lift C.save -- | Restore the context from a stack. restore :: RenderM () restore = lift C.restore instance Backend Cairo R2 where data Render Cairo R2 = C (RenderM ()) type Result Cairo R2 = (IO (), C.Render ()) data Options Cairo R2 = CairoOptions { cairoFileName :: String -- ^ The name of the file you want generated , cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output , cairoOutputType :: OutputType -- ^ the output format and associated options , cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? } deriving Show withStyle _ s t (C r) = C $ do save cairoMiscStyle s put False r ignoreFill <- get lift $ do cairoTransf t cairoStrokeStyle ignoreFill s C.stroke restore doRender _ (CairoOptions file size out _) (C r) = (renderIO, r') where r' = evalStateT r False renderIO = do let surfaceF s = C.renderWith s r' -- Everything except Dims is arbitrary. The backend -- should have first run 'adjustDia' to update the -- final size of the diagram with explicit dimensions, -- so normally we would only expect to get Dims anyway. (w,h) = case size of Width w' -> (w',w') Height h' -> (h',h') Dims w' h' -> (w',h') Absolute -> (100,100) case out of PNG -> C.withImageSurface C.FormatARGB32 (round w) (round h) $ \surface -> do surfaceF surface C.surfaceWriteToPNG surface file PS -> C.withPSSurface file w h surfaceF PDF -> C.withPDFSurface file w h surfaceF SVG -> C.withSVGSurface file w h surfaceF RenderOnly -> return () adjustDia c opts d = if cairoBypassAdjust opts then (opts, d # setDefault2DAttributes) else adjustDia2D cairoSizeSpec setCairoSizeSpec c opts (d # reflectY) where setCairoSizeSpec sz o = o { cairoSizeSpec = sz } -- | Render an object that the cairo backend knows how to render. renderC :: (Renderable a Cairo, V a ~ R2) => a -> RenderM () renderC a = case (render Cairo a) of C r -> r -- | Handle \"miscellaneous\" style attributes (clip, font stuff, fill -- color and fill rule). cairoMiscStyle :: Style v -> RenderM () cairoMiscStyle s = sequence_ . catMaybes $ [ handle clip , handle fSize , handleFontFace , handle fColor , handle lFillRule ] where handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ()) handle f = f `fmap` getAttr s clip = mapM_ (\p -> renderC p >> lift C.clip) . getClip fSize = lift . C.setFontSize . getFontSize fFace = fromMaybe "" $ getFont <$> getAttr s fSlant = fromFontSlant . fromMaybe FontSlantNormal $ getFontSlant <$> getAttr s fWeight = fromFontWeight . fromMaybe FontWeightNormal $ getFontWeight <$> getAttr s handleFontFace = Just . lift $ C.selectFontFace fFace fSlant fWeight fColor c = lift $ setSource (getFillColor c) s lFillRule = lift . C.setFillRule . fromFillRule . getFillRule fromFontSlant :: FontSlant -> C.FontSlant fromFontSlant FontSlantNormal = C.FontSlantNormal fromFontSlant FontSlantItalic = C.FontSlantItalic fromFontSlant FontSlantOblique = C.FontSlantOblique fromFontWeight :: FontWeight -> C.FontWeight fromFontWeight FontWeightNormal = C.FontWeightNormal fromFontWeight FontWeightBold = C.FontWeightBold -- | Handle style attributes having to do with stroke. cairoStrokeStyle :: Bool -> Style v -> C.Render () cairoStrokeStyle ignoreFill s = sequence_ . catMaybes $ [ if ignoreFill then Nothing else handle fColor , handle lColor -- see Note [color order] , handle lWidth , handle lCap , handle lJoin , handle lDashing ] where handle :: (AttributeClass a) => (a -> C.Render ()) -> Maybe (C.Render ()) handle f = f `fmap` getAttr s fColor c = setSource (getFillColor c) s >> C.fillPreserve lColor c = setSource (getLineColor c) s lWidth = C.setLineWidth . getLineWidth lCap = C.setLineCap . fromLineCap . getLineCap lJoin = C.setLineJoin . fromLineJoin . getLineJoin lDashing (getDashing -> Dashing ds offs) = C.setDash ds offs -- | Set the source color. setSource :: Color c => c -> Style v -> C.Render () setSource c s = C.setSourceRGBA r g b a' where (r,g,b,a) = colorToSRGBA c a' = case getOpacity <$> getAttr s of Nothing -> a Just d -> a * d -- | Multiply the current transformation matrix by the given 2D -- transformation. cairoTransf :: T2 -> C.Render () cairoTransf t = C.transform m where m = CM.Matrix a1 a2 b1 b2 c1 c2 (unr2 -> (a1,a2)) = apply t unitX (unr2 -> (b1,b2)) = apply t unitY (unr2 -> (c1,c2)) = transl t {- ~~~~ Note [color order] It's important for the line and fill colors to be handled in the given order (fill color first, then line color) because of the way Cairo handles them (both are taken from the sourceRGBA). -} fromLineCap :: LineCap -> C.LineCap fromLineCap LineCapButt = C.LineCapButt fromLineCap LineCapRound = C.LineCapRound 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 R2) Cairo where render _ (Linear (OffsetClosed v)) = C . lift $ uncurry C.relLineTo (unr2 v) render _ (Cubic (unr2 -> (x1,y1)) (unr2 -> (x2,y2)) (OffsetClosed (unr2 -> (x3,y3)))) = C . lift $ C.relCurveTo x1 y1 x2 y2 x3 y3 instance Renderable (Trail R2) Cairo where render _ t = flip withLine t $ renderT . lineSegments where renderT segs = C $ do mapM_ renderC segs lift $ when (isLoop t) C.closePath when (isLine t) (put True) -- remember that we saw a Line, so we will ignore fill attribute instance Renderable (Path R2) Cairo where render _ (Path trs) = C $ lift C.newPath >> F.mapM_ renderTrail trs where renderTrail (viewLoc -> (unp2 -> p, tr)) = do lift $ uncurry C.moveTo p renderC tr -- Can only do PNG files at the moment... instance Renderable Image Cairo where render _ (Image file sz tr) = C . lift $ do 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 cairoTransf $ requiredScaleT sz (fromIntegral w, fromIntegral 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 ++ ">." ] -- see http://www.cairographics.org/tutorial/#L1understandingtext instance Renderable Text Cairo where render _ (Text tr al str) = C $ do lift $ do C.save -- XXX should use reflection font matrix here instead? cairoTransf (tr <> reflectionY) (refX, refY) <- case al of BoxAlignedText xt yt -> do tExt <- C.textExtents str fExt <- C.fontExtents let l = C.textExtentsXbearing tExt r = C.textExtentsXadvance tExt b = C.fontExtentsDescent fExt t = C.fontExtentsAscent fExt return (lerp l r xt, lerp (-b) t yt) BaselineText -> return (0, 0) cairoTransf (moveOriginBy (r2 (refX, -refY)) mempty) C.showText str C.restore diagrams-cairo-0.7/src/Diagrams/Backend/Cairo/List.hs0000644000000000000000000000270612201204405020574 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- 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 import Control.Applicative ((<$>)) import Control.Exception (bracket) import Data.Colour import Data.Colour.SRGB (sRGB) import Data.Word (Word8) import Diagrams.Prelude (Diagram, R2) import Diagrams.Backend.Cairo (Cairo) import Diagrams.Backend.Cairo.Ptr (renderPtr) import Foreign.Marshal.Alloc (free) import Foreign.Marshal.Array (peekArray) -- | Render to a regular list of Colour values. renderToList :: (Ord a, Floating a) => Int -> Int -> Diagram Cairo R2 -> IO [[AlphaColour a]] renderToList w h d = f 0 <$> bracket (renderPtr w h d) free (peekArray $ w*h*4) where f :: (Ord a, Floating a) => Int -> [Word8] -> [[AlphaColour a]] f _ [] = [] f n xs | n >= w = [] : f 0 xs f n (g:b:r:a:xs) = let l n = fromIntegral n / fromIntegral a 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-0.7/src/Diagrams/Backend/Cairo/Ptr.hs0000644000000000000000000000357712201204405020435 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- 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.Prelude (Diagram, R2, SizeSpec2D (..), renderDia) import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo.Internal import Foreign.ForeignPtr.Safe (ForeignPtr, newForeignPtr) import Foreign.Marshal.Alloc (finalizerFree) import Foreign.Marshal.Array (mallocArray, pokeArray) import Foreign.Ptr (Ptr, castPtr) import Graphics.Rendering.Cairo ( Format (..) , formatStrideForWidth , renderWith , withImageSurfaceForData ) -- | Render a diagram to a new buffer in memory, with the format ARGB32. renderPtr :: Int -> Int -> Diagram Cairo R2 -> IO (Ptr Word8) renderPtr w h d = do let stride = formatStrideForWidth FormatARGB32 w size = stride * h opt = CairoOptions { cairoSizeSpec = Dims (fromIntegral w) (fromIntegral h) , cairoOutputType = RenderOnly , cairoBypassAdjust = False , cairoFileName = "" } (_, r) = renderDia Cairo opt d b <- mallocArray size pokeArray b (replicate size 0) withImageSurfaceForData b FormatARGB32 w h stride (`renderWith` r) return (castPtr b) -- | Like 'renderPtr' but automatically garbage collected by Haskell. renderForeignPtr :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8) renderForeignPtr w h d = renderPtr w h d >>= newForeignPtr finalizerFree diagrams-cairo-0.7/src/Diagrams/Backend/Cairo/Text.hs0000644000000000000000000001610612201204405020604 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.Cairo.Text -- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- This module provides convenience functions for querying information -- from cairo. In particular, this provides utilities for information -- about fonts, and creating text primitives with bounds based on the -- font being used. To render text with automatically determined -- envelopes, use 'textLineBounded', 'textLineBoundedIO', -- 'textVisualBounded', or 'textVisualBoundedIO'. -- -- Many of these functions take a 'Style' 'R2' parameter, determining the -- style to apply to the text before rendering / querying information about -- the text. These 'Style' 'R2' parameters can be created a variety of ways, -- but the most direct will likely be by applying style-transforming functions -- such as 'font', 'fontSize', 'fontSlant', and 'fontWeight' to 'mempty'. -- This works because there are instances of 'HasStyle' and 'Monoid' for -- @'Style' v@. -- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Text ( -- * Primitives -- | These create diagrams instantiated with extent-based envelopes. textLineBoundedIO, textVisualBoundedIO -- ** Unsafe -- | These are convenient unsafe variants of the above operations -- using 'unsafePerformIO'. In practice, they should be fairly -- safe as the results depend only on the parameters and the -- font information (which ought to stay the same during a given -- execution). , kerningCorrection, textLineBounded, textVisualBounded -- * Extents -- ** Data Structures , TextExtents(..), FontExtents(..) -- ** Queries , getTextExtents, getFontExtents, getExtents , kerningCorrectionIO -- * Utilities , queryCairo, unsafeCairo , cairoWithStyle ) where import Diagrams.Backend.Cairo.Internal import Diagrams.Prelude import Control.Monad.State import System.IO.Unsafe import qualified Graphics.Rendering.Cairo as C -- | Executes a cairo action on a dummy, zero-size image surface, in order to -- query things like font information. queryCairo :: C.Render a -> IO a queryCairo c = C.withImageSurface C.FormatA1 0 0 (`C.renderWith` c) -- | Unsafely invokes 'queryCairo' using 'unsafePerformIO'. unsafeCairo :: C.Render a -> a unsafeCairo = unsafePerformIO . queryCairo -- | Executes the given cairo action, with styling applied. This does -- not do all styling, only attributes that are processed by -- 'cairoMiscStyle', which does clip, fill color, fill rule, and, -- importantly for this module, font face, style, and weight. cairoWithStyle :: C.Render a -> Style R2 -> C.Render a cairoWithStyle f style = do C.save evalStateT (cairoMiscStyle style) False result <- f C.restore return result -- | A more convenient data structure for the results of a text-extents query. data TextExtents = TextExtents { bearing, textSize, advance :: R2 } processTextExtents :: C.TextExtents -> TextExtents processTextExtents (C.TextExtents xb yb w h xa ya) = TextExtents (r2 (xb,yb)) (r2 (w,h)) (r2 (xa,ya)) -- | Get the extents of a string of text, given a style to render it with. getTextExtents :: Style R2 -> String -> C.Render TextExtents getTextExtents style txt = cairoWithStyle (processTextExtents <$> C.textExtents txt) style -- | A more convenient data structure for the results of a font-extents query. data FontExtents = FontExtents { ascent, descent, height :: Double , maxAdvance :: R2 } processFontExtents :: C.FontExtents -> FontExtents processFontExtents (C.FontExtents a d h mx my) = FontExtents a d h (r2 (mx,my)) -- | Gets the intrinsic extents of a font. getFontExtents :: Style R2 -> C.Render FontExtents getFontExtents style = cairoWithStyle (processFontExtents <$> C.fontExtents) style -- | Gets both the 'FontExtents' and 'TextExtents' of the string with the a -- particular style applied. This is more efficient than calling both -- 'getFontExtents' and 'getTextExtents'. getExtents :: Style R2 -> String -> C.Render (FontExtents, TextExtents) getExtents style str = cairoWithStyle (do fe <- processFontExtents <$> C.fontExtents te <- processTextExtents <$> C.textExtents str return (fe, te) ) style -- | Queries the amount of horizontal offset that needs to be applied in order to -- position the second character properly, in the event that it is 'hcat'-ed -- 'baselineText'. kerningCorrectionIO :: Style R2 -> Char -> Char -> IO Double kerningCorrectionIO style a b = do let ax t = fst . unr2 . advance <$> queryCairo (getTextExtents style t) l <- ax [a, b] la <- ax [a] lb <- ax [b] return $ l - la - lb -- | Creates text diagrams with their envelopes set such that using -- @'vcat' . map ('textLineBounded' style)@ stacks them in the way that -- the font designer intended. textLineBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2) textLineBoundedIO style str = do (fe, te) <- queryCairo $ getExtents style str let box = fromCorners (p2 (0, negate $ descent fe)) (p2 (fst . unr2 $ advance te, ascent fe)) return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str -- | Creates a text diagram with its envelope set to enclose the glyphs of the text, -- including leading (though not trailing) whitespace. textVisualBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2) textVisualBoundedIO style str = do te <- queryCairo $ getTextExtents style str let box = fromCorners (origin .+^ bearing te) ((origin .+^ bearing te) .+^ textSize te) return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str -- | Queries the amount of horizontal offset that needs to be applied -- in order to position the second character properly, in the event -- that it is 'hcat'-ed 'baselineText'. See 'kerningCorrectionIO'; -- this variant uses 'unsafePerformIO' but should be fairly safe in -- practice. kerningCorrection :: Style R2 -> Char -> Char -> Double kerningCorrection style a = unsafePerformIO . kerningCorrectionIO style a -- | Creates text diagrams with their envelopes set such that using -- @'vcat' . map ('textLineBounded' style)@ stacks them in the way -- that the font designer intended. See 'textLineBoundedIO'; this -- variant uses 'unsafePerformIO' but should be fairly safe in -- practice. textLineBounded :: Style R2 -> String -> Diagram Cairo R2 textLineBounded style = unsafePerformIO . textLineBoundedIO style -- | Creates a text diagram with its envelope set to enclose the -- glyphs of the text, including leading (though not trailing) -- whitespace. See 'textVisualBoundedIO'; this variant uses -- 'unsafePerformIO' but should be fairly safe in practice. textVisualBounded :: Style R2 -> String -> Diagram Cairo R2 textVisualBounded style = unsafePerformIO . textVisualBoundedIO style