diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,16 @@ +0.7: 9 August 2013 +------------------ + +* **New features** + + - New `renderCairo` function for more convenient use of the cairo + backend. + - Lots of Haddock documentation improvements. + +* **New instances** + + - `Show` instance for `Options Cairo R2`. + 0.6: 11 December 2012 --------------------- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2011-2012 diagrams-cairo team: +Copyright 2011-2013 diagrams-cairo team: Sam Griffin Niklas Haas diff --git a/diagrams-cairo.cabal b/diagrams-cairo.cabal --- a/diagrams-cairo.cabal +++ b/diagrams-cairo.cabal @@ -1,5 +1,5 @@ Name: diagrams-cairo -Version: 0.6 +Version: 0.7 Synopsis: Cairo backend for diagrams drawing EDSL Description: A full-featured backend for rendering diagrams using the cairo rendering engine. @@ -35,7 +35,7 @@ Build-type: Simple Cabal-version: >=1.10 Extra-source-files: CHANGES.markdown, README.markdown -Tested-with: GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1 +Tested-with: GHC == 7.4.2, GHC == 7.6.1 Source-repository head type: git location: http://github.com/diagrams/diagrams-cairo.git @@ -55,8 +55,8 @@ filepath, old-time, time, - diagrams-core >= 0.6 && < 0.7, - diagrams-lib >= 0.6 && < 0.7, + diagrams-core >= 0.7 && < 0.8, + diagrams-lib >= 0.7 && < 0.8, cairo >= 0.12.4 && < 0.13, cmdargs >= 0.6 && < 0.11, colour, diff --git a/src/Diagrams/Backend/Cairo.hs b/src/Diagrams/Backend/Cairo.hs --- a/src/Diagrams/Backend/Cairo.hs +++ b/src/Diagrams/Backend/Cairo.hs @@ -10,10 +10,22 @@ -- A full-featured rendering backend for diagrams using the -- cairo rendering engine. -- --- To invoke the cairo backend, use methods from the --- 'Diagrams.Core.Types.Backend' instance for @Cairo@. In particular, --- 'Diagrams.Core.Types.renderDia' has the generic type +-- To invoke the cairo backend, you have three options. -- +-- * 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 @@ -31,10 +43,6 @@ -- > } -- -- @ --- data family Render Cairo R2 = C ('RenderM' ()) --- @ --- --- @ -- type family Result Cairo R2 = (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- @@ -44,18 +52,28 @@ -- renderDia :: Cairo -> Options Cairo R2 -> QDiagram Cairo R2 m -> (IO (), 'Graphics.Rendering.Cairo.Render' ()) -- @ -- --- which you could call like @renderDia Cairo (CairoOptions "foo.png" --- (Width 250) PNG) myDiagram@. This would return a pair; the first --- element is an @IO ()@ action which will write out @foo.png@ to --- disk, and the second is a cairo rendering action which can be used, --- for example, to directly draw to a Gtk window. +-- 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 - ( -- * Cairo-supported output formats - OutputType(..) + ( -- * Rendering + renderCairo + -- * Cairo-supported output formats + , OutputType(..) + -- * Cairo-specific options -- $CairoOptions @@ -76,7 +94,10 @@ , Cairo(..) ) where +import System.FilePath (takeExtension) + import Diagrams.Backend.Cairo.Internal +import Diagrams.Prelude -- $CairoOptions -- @@ -90,13 +111,31 @@ -- > , cairoOutputType :: OutputType -- ^ the output format and associated options -- > } -- --- So, for example, you could call the 'renderDia' function (from --- "Graphics.Rendering.Diagrams.Core") like this: --- --- > renderDia Cairo (CairoOptions "foo.png" (Width 250) PNG) myDiagram +-- See the documentation at the top of "Diagrams.Backend.Cairo" for +-- information on how to make use of this. -- -- /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 + _ -> PNG diff --git a/src/Diagrams/Backend/Cairo/CmdLine.hs b/src/Diagrams/Backend/Cairo/CmdLine.hs --- a/src/Diagrams/Backend/Cairo/CmdLine.hs +++ b/src/Diagrams/Backend/Cairo/CmdLine.hs @@ -26,8 +26,12 @@ -- 'defaultMain' (or 'multiMain', or 'animMain') in a call to -- 'System.Environment.withArgs'. -- --- * A more flexible approach is to directly call 'renderDia'; see --- "Diagrams.Backend.Cairo" for more information. +-- * 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. -- ----------------------------------------------------------------------------- diff --git a/src/Diagrams/Backend/Cairo/Internal.hs b/src/Diagrams/Backend/Cairo/Internal.hs --- a/src/Diagrams/Backend/Cairo/Internal.hs +++ b/src/Diagrams/Backend/Cairo/Internal.hs @@ -1,12 +1,12 @@ -{-# LANGUAGE TypeFamilies - , MultiParamTypeClasses - , FlexibleInstances - , FlexibleContexts - , ExistentialQuantification - , TypeSynonymInstances - , DeriveDataTypeable - , ViewPatterns - #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -29,34 +29,41 @@ -- sometimes to work around an apparent bug in certain versions of -- GHC, which results in a \"not in scope\" error for 'CairoOptions'. -- +-- The types of all the @fromX@ functions look funny in the Haddock +-- output, which displays them like @Type -> Type@. In fact they are +-- all of the form @Type -> Graphics.Rendering.Cairo.Type@, /i.e./ +-- they convert from a diagrams type to a cairo type of the same name. ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Internal where -import Diagrams.Core.Transform +import Diagrams.Core.Transform -import Diagrams.Prelude -import Diagrams.TwoD.Path (Clip(..), getFillRule) -import Diagrams.TwoD.Text -import Diagrams.TwoD.Image -import Diagrams.TwoD.Adjust (adjustDia2D, setDefault2DAttributes) -import Diagrams.TwoD.Size (requiredScaleT) +import Diagrams.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 as C import qualified Graphics.Rendering.Cairo.Matrix as CM -import Control.Monad.State -import Data.Maybe (catMaybes, fromMaybe) -import Data.List (isSuffixOf) +import Control.Monad.State +import Data.List (isSuffixOf) +import Data.Maybe (catMaybes, fromMaybe) -import Control.Exception (try) +import Control.Exception (try) -import qualified Data.Foldable as F +import qualified Data.Foldable as F -import Data.Typeable +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 know way to know which +-- inference engine would otherwise have no way to know which -- backend you wanted to use, and (2) as an argument to the -- 'Backend' and 'Renderable' type classes. data Cairo = Cairo @@ -64,15 +71,17 @@ -- | Output types supported by cairo, including four different file -- types (PNG, PS, PDF, SVG). If you want to output directly to GTK --- windows, see the diagrams-gtk package. +-- windows, see the @diagrams-gtk@ package. data OutputType = - PNG -- ^ Portable Network Graphics output. - | PS -- ^ PostScript output - | PDF -- ^ Portable Document Format output. - | SVG -- ^ Scalable Vector Graphics output. + PNG -- ^ Portable Network Graphics output. + | PS -- ^ PostScript output + | PDF -- ^ Portable Document Format output. + | SVG -- ^ Scalable Vector Graphics output. | RenderOnly -- ^ Don't output any file; the returned @IO ()@ - -- action will do nothing, but the @Render ()@ action - -- can be used (e.g. to draw to a Gtk window) + -- action will do nothing, but the @Render ()@ + -- action can be used (/e.g./ to draw to a Gtk + -- window; see the @diagrams-gtk@ package). + deriving (Eq, Ord, Read, Show, Bounded, Enum, Typeable) instance Monoid (Render Cairo R2) where mempty = C $ return () @@ -80,17 +89,18 @@ -- | The custom monad in which intermediate drawing options take -- place; 'Graphics.Rendering.Cairo.Render' is cairo's own rendering --- monad. At one point @RenderM@ really did use @StateT@, but then --- the state got taken out... but the @StateT@ remains, now with a --- zen-like state of type unit, \"just in case\". Think of it as a --- good luck charm. -type RenderM a = StateT () C.Render a -- no state for now +-- monad. 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, since --- it suffices to just reset the text alignment to "centered" on --- restore. But if need be we can switch to a more sophisticated --- implementation using an "undoable state" monad which lets you save --- (push state onto a stack) and restore (pop from the stack). +-- 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 () @@ -109,19 +119,22 @@ , 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 s + cairoStrokeStyle ignoreFill s C.stroke restore doRender _ (CairoOptions file size out _) (C r) = (renderIO, r') - where r' = evalStateT r () + where r' = evalStateT r False renderIO = do let surfaceF s = C.renderWith s r' @@ -152,6 +165,7 @@ 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 @@ -189,10 +203,10 @@ fromFontWeight FontWeightBold = C.FontWeightBold -- | Handle style attributes having to do with stroke. -cairoStrokeStyle :: Style v -> C.Render () -cairoStrokeStyle s = +cairoStrokeStyle :: Bool -> Style v -> C.Render () +cairoStrokeStyle ignoreFill s = sequence_ - . catMaybes $ [ handle fColor + . catMaybes $ [ if ignoreFill then Nothing else handle fColor , handle lColor -- see Note [color order] , handle lWidth , handle lCap @@ -209,9 +223,10 @@ 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) = colorToRGBA c + where (r,g,b,a) = colorToSRGBA c a' = case getOpacity <$> getAttr s of Nothing -> a Just d -> a * d @@ -247,21 +262,27 @@ fromFillRule Winding = C.FillRuleWinding fromFillRule EvenOdd = C.FillRuleEvenOdd -instance Renderable (Segment R2) Cairo where - render _ (Linear v) = C . lift $ uncurry C.relLineTo (unr2 v) +instance Renderable (Segment Closed R2) Cairo where + render _ (Linear (OffsetClosed v)) = C . lift $ uncurry C.relLineTo (unr2 v) render _ (Cubic (unr2 -> (x1,y1)) (unr2 -> (x2,y2)) - (unr2 -> (x3,y3))) + (OffsetClosed (unr2 -> (x3,y3)))) = C . lift $ C.relCurveTo x1 y1 x2 y2 x3 y3 instance Renderable (Trail R2) Cairo where - render _ (Trail segs c) = C $ do - mapM_ renderC segs - lift $ when c C.closePath + 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 (unp2 -> p, tr) = do + where renderTrail (viewLoc -> (unp2 -> p, tr)) = do lift $ uncurry C.moveTo p renderC tr diff --git a/src/Diagrams/Backend/Cairo/Text.hs b/src/Diagrams/Backend/Cairo/Text.hs --- a/src/Diagrams/Backend/Cairo/Text.hs +++ b/src/Diagrams/Backend/Cairo/Text.hs @@ -26,15 +26,16 @@ ( -- * Primitives - -- | These create diagrams instantiated with extents-based envelopes + -- | These create diagrams instantiated with extent-based envelopes. textLineBoundedIO, textVisualBoundedIO -- ** Unsafe -- | These are convenient unsafe variants of the above operations - -- postfixed with \"IO\". They should be pretty well-behaved as the - -- results just depend on the parameters and the font information - -- (which ought to stay the same during a given execution). + -- 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 @@ -53,31 +54,31 @@ , cairoWithStyle ) where -import Diagrams.Backend.Cairo.Internal -import Diagrams.Prelude +import Diagrams.Backend.Cairo.Internal +import Diagrams.Prelude -import Control.Monad.State -import System.IO.Unsafe +import Control.Monad.State +import System.IO.Unsafe -import qualified Graphics.Rendering.Cairo as C +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@. +-- | Unsafely invokes 'queryCairo' using 'unsafePerformIO'. unsafeCairo :: C.Render a -> a unsafeCairo = unsafePerformIO . queryCairo --- | Executes the given cairo action, with styling applied. --- This does not do all styling - just attributes that are processed by --- \"cairoMiscStyle\", which does clip, fill color, fill rule, and, +-- | 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) () + evalStateT (cairoMiscStyle style) False result <- f C.restore return result @@ -98,7 +99,7 @@ -- | A more convenient data structure for the results of a font-extents query. data FontExtents = FontExtents { ascent, descent, height :: Double - , maxAdvance :: R2 + , maxAdvance :: R2 } processFontExtents :: C.FontExtents -> FontExtents @@ -110,9 +111,9 @@ getFontExtents style = cairoWithStyle (processFontExtents <$> C.fontExtents) style --- | Gets both the "FontExtents" and "TextExtents" of the string with the a +-- | 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@. +-- 'getFontExtents' and 'getTextExtents'. getExtents :: Style R2 -> String -> C.Render (FontExtents, TextExtents) getExtents style str = cairoWithStyle (do fe <- processFontExtents <$> C.fontExtents @@ -121,8 +122,8 @@ ) 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@. +-- 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) @@ -132,7 +133,7 @@ return $ l - la - lb -- | Creates text diagrams with their envelopes set such that using --- @vcat . map (textLineBounded style)@ stacks them in the way that +-- @'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 @@ -150,9 +151,25 @@ ((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 -textLineBounded, textVisualBounded :: Style R2 -> String -> Diagram Cairo R2 +-- | 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