    {-# LANGUAGE CPP                       #-}
    {-# LANGUAGE DeriveDataTypeable        #-}
    {-# LANGUAGE DeriveGeneric             #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE FlexibleContexts          #-}
    {-# LANGUAGE FlexibleInstances         #-}
    {-# LANGUAGE GADTs                     #-}
    {-# LANGUAGE MultiParamTypeClasses     #-}
    {-# LANGUAGE ScopedTypeVariables       #-}
    {-# LANGUAGE TemplateHaskell           #-}
    {-# LANGUAGE TypeFamilies              #-}
    {-# LANGUAGE TypeOperators             #-}
    {-# LANGUAGE TypeSynonymInstances      #-}
    {-# LANGUAGE ViewPatterns              #-}

    -----------------------------------------------------------------------------
    -- |
    -- 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, packPixel,
                                                      promoteImage)

    import           Control.Exception               (try)
    import           Control.Monad                   (when)
    import           Control.Monad.IO.Class
    import qualified Control.Monad.StateStack        as SS
    import           Control.Monad.Trans             (lift)
    import qualified Data.Array.MArray               as MA
    import           Data.Bits                       (rotateL, (.&.))
    import qualified Data.Foldable                   as F
    import           Data.Hashable                   (Hashable (..))
    import           Data.List                       (isSuffixOf)
    import           Data.Maybe                      (catMaybes, fromMaybe, isJust)
    import           Data.Tree
    import           Data.Typeable
    import           Data.Word                       (Word32)
    import           GHC.Generics                    (Generic)

    -- | 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 (Cairo -> Cairo -> Bool
    (Cairo -> Cairo -> Bool) -> (Cairo -> Cairo -> Bool) -> Eq Cairo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Cairo -> Cairo -> Bool
    == :: Cairo -> Cairo -> Bool
    $c/= :: Cairo -> Cairo -> Bool
    /= :: Cairo -> Cairo -> Bool
    Eq,Eq Cairo
    Eq Cairo =>
    (Cairo -> Cairo -> Ordering)
    -> (Cairo -> Cairo -> Bool)
    -> (Cairo -> Cairo -> Bool)
    -> (Cairo -> Cairo -> Bool)
    -> (Cairo -> Cairo -> Bool)
    -> (Cairo -> Cairo -> Cairo)
    -> (Cairo -> Cairo -> Cairo)
    -> Ord Cairo
    Cairo -> Cairo -> Bool
    Cairo -> Cairo -> Ordering
    Cairo -> Cairo -> Cairo
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Cairo -> Cairo -> Ordering
    compare :: Cairo -> Cairo -> Ordering
    $c< :: Cairo -> Cairo -> Bool
    < :: Cairo -> Cairo -> Bool
    $c<= :: Cairo -> Cairo -> Bool
    <= :: Cairo -> Cairo -> Bool
    $c> :: Cairo -> Cairo -> Bool
    > :: Cairo -> Cairo -> Bool
    $c>= :: Cairo -> Cairo -> Bool
    >= :: Cairo -> Cairo -> Bool
    $cmax :: Cairo -> Cairo -> Cairo
    max :: Cairo -> Cairo -> Cairo
    $cmin :: Cairo -> Cairo -> Cairo
    min :: Cairo -> Cairo -> Cairo
    Ord,ReadPrec [Cairo]
    ReadPrec Cairo
    Int -> ReadS Cairo
    ReadS [Cairo]
    (Int -> ReadS Cairo)
    -> ReadS [Cairo]
    -> ReadPrec Cairo
    -> ReadPrec [Cairo]
    -> Read Cairo
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Cairo
    readsPrec :: Int -> ReadS Cairo
    $creadList :: ReadS [Cairo]
    readList :: ReadS [Cairo]
    $creadPrec :: ReadPrec Cairo
    readPrec :: ReadPrec Cairo
    $creadListPrec :: ReadPrec [Cairo]
    readListPrec :: ReadPrec [Cairo]
    Read,Int -> Cairo -> ShowS
    [Cairo] -> ShowS
    Cairo -> String
    (Int -> Cairo -> ShowS)
    -> (Cairo -> String) -> ([Cairo] -> ShowS) -> Show Cairo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Cairo -> ShowS
    showsPrec :: Int -> Cairo -> ShowS
    $cshow :: Cairo -> String
    show :: Cairo -> String
    $cshowList :: [Cairo] -> ShowS
    showList :: [Cairo] -> ShowS
    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 (OutputType -> OutputType -> Bool
    (OutputType -> OutputType -> Bool)
    -> (OutputType -> OutputType -> Bool) -> Eq OutputType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: OutputType -> OutputType -> Bool
    == :: OutputType -> OutputType -> Bool
    $c/= :: OutputType -> OutputType -> Bool
    /= :: OutputType -> OutputType -> Bool
    Eq, Eq OutputType
    Eq OutputType =>
    (OutputType -> OutputType -> Ordering)
    -> (OutputType -> OutputType -> Bool)
    -> (OutputType -> OutputType -> Bool)
    -> (OutputType -> OutputType -> Bool)
    -> (OutputType -> OutputType -> Bool)
    -> (OutputType -> OutputType -> OutputType)
    -> (OutputType -> OutputType -> OutputType)
    -> Ord OutputType
    OutputType -> OutputType -> Bool
    OutputType -> OutputType -> Ordering
    OutputType -> OutputType -> OutputType
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: OutputType -> OutputType -> Ordering
    compare :: OutputType -> OutputType -> Ordering
    $c< :: OutputType -> OutputType -> Bool
    < :: OutputType -> OutputType -> Bool
    $c<= :: OutputType -> OutputType -> Bool
    <= :: OutputType -> OutputType -> Bool
    $c> :: OutputType -> OutputType -> Bool
    > :: OutputType -> OutputType -> Bool
    $c>= :: OutputType -> OutputType -> Bool
    >= :: OutputType -> OutputType -> Bool
    $cmax :: OutputType -> OutputType -> OutputType
    max :: OutputType -> OutputType -> OutputType
    $cmin :: OutputType -> OutputType -> OutputType
    min :: OutputType -> OutputType -> OutputType
    Ord, ReadPrec [OutputType]
    ReadPrec OutputType
    Int -> ReadS OutputType
    ReadS [OutputType]
    (Int -> ReadS OutputType)
    -> ReadS [OutputType]
    -> ReadPrec OutputType
    -> ReadPrec [OutputType]
    -> Read OutputType
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS OutputType
    readsPrec :: Int -> ReadS OutputType
    $creadList :: ReadS [OutputType]
    readList :: ReadS [OutputType]
    $creadPrec :: ReadPrec OutputType
    readPrec :: ReadPrec OutputType
    $creadListPrec :: ReadPrec [OutputType]
    readListPrec :: ReadPrec [OutputType]
    Read, Int -> OutputType -> ShowS
    [OutputType] -> ShowS
    OutputType -> String
    (Int -> OutputType -> ShowS)
    -> (OutputType -> String)
    -> ([OutputType] -> ShowS)
    -> Show OutputType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> OutputType -> ShowS
    showsPrec :: Int -> OutputType -> ShowS
    $cshow :: OutputType -> String
    show :: OutputType -> String
    $cshowList :: [OutputType] -> ShowS
    showList :: [OutputType] -> ShowS
    Show, OutputType
    OutputType -> OutputType -> Bounded OutputType
    forall a. a -> a -> Bounded a
    $cminBound :: OutputType
    minBound :: OutputType
    $cmaxBound :: OutputType
    maxBound :: OutputType
    Bounded, Int -> OutputType
    OutputType -> Int
    OutputType -> [OutputType]
    OutputType -> OutputType
    OutputType -> OutputType -> [OutputType]
    OutputType -> OutputType -> OutputType -> [OutputType]
    (OutputType -> OutputType)
    -> (OutputType -> OutputType)
    -> (Int -> OutputType)
    -> (OutputType -> Int)
    -> (OutputType -> [OutputType])
    -> (OutputType -> OutputType -> [OutputType])
    -> (OutputType -> OutputType -> [OutputType])
    -> (OutputType -> OutputType -> OutputType -> [OutputType])
    -> Enum OutputType
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: OutputType -> OutputType
    succ :: OutputType -> OutputType
    $cpred :: OutputType -> OutputType
    pred :: OutputType -> OutputType
    $ctoEnum :: Int -> OutputType
    toEnum :: Int -> OutputType
    $cfromEnum :: OutputType -> Int
    fromEnum :: OutputType -> Int
    $cenumFrom :: OutputType -> [OutputType]
    enumFrom :: OutputType -> [OutputType]
    $cenumFromThen :: OutputType -> OutputType -> [OutputType]
    enumFromThen :: OutputType -> OutputType -> [OutputType]
    $cenumFromTo :: OutputType -> OutputType -> [OutputType]
    enumFromTo :: OutputType -> OutputType -> [OutputType]
    $cenumFromThenTo :: OutputType -> OutputType -> OutputType -> [OutputType]
    enumFromThenTo :: OutputType -> OutputType -> OutputType -> [OutputType]
    Enum, Typeable, (forall x. OutputType -> Rep OutputType x)
    -> (forall x. Rep OutputType x -> OutputType) -> Generic OutputType
    forall x. Rep OutputType x -> OutputType
    forall x. OutputType -> Rep OutputType x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. OutputType -> Rep OutputType x
    from :: forall x. OutputType -> Rep OutputType x
    $cto :: forall x. Rep OutputType x -> OutputType
    to :: forall x. Rep OutputType x -> OutputType
    Generic)

    instance Hashable OutputType

    -- | Custom state tracked in the 'RenderM' monad.
    data CairoState
      = CairoState { CairoState -> Style V2 Double
    _accumStyle :: Style V2 Double
                     -- ^ The current accumulated style.
                   , CairoState -> Bool
    _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
    def = CairoState
            { _accumStyle :: Style V2 Double
    _accumStyle       = Style V2 Double
    forall a. Monoid a => a
    mempty
            , _ignoreFill :: Bool
    _ignoreFill       = Bool
    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 :: forall a. Render a -> RenderM a
    liftC = Render a -> StateStackT CairoState Render a
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateStackT CairoState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    runRenderM :: RenderM a -> C.Render a
    runRenderM :: forall a. RenderM a -> Render a
    runRenderM = (RenderM a -> CairoState -> Render a)
    -> CairoState -> RenderM a -> Render a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip RenderM a -> CairoState -> Render a
    forall (m :: * -> *) s a. Monad m => StateStackT s m a -> s -> m a
    SS.evalStateStackT CairoState
    forall a. Default a => a
    def

    -- | Push the current context onto a stack.
    save :: RenderM ()
    save :: RenderM ()
    save =  RenderM ()
    forall s (m :: * -> *). MonadStateStack s m => m ()
    SS.save RenderM () -> RenderM () -> RenderM ()
    forall a b.
    StateStackT CairoState Render a
    -> StateStackT CairoState Render b
    -> StateStackT CairoState Render b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC Render ()
    C.save

    -- | Restore the context from a stack.
    restore :: RenderM ()
    restore :: RenderM ()
    restore = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC Render ()
    C.restore RenderM () -> RenderM () -> RenderM ()
    forall a b.
    StateStackT CairoState Render a
    -> StateStackT CairoState Render b
    -> StateStackT CairoState Render b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> RenderM ()
    forall s (m :: * -> *). MonadStateStack s m => m ()
    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
              { Options Cairo V2 Double -> String
    _cairoFileName   :: String     -- ^ The name of the file you want generated
              , Options Cairo V2 Double -> SizeSpec V2 Double
    _cairoSizeSpec   :: SizeSpec V2 Double -- ^ The requested size of the output
              , Options Cairo V2 Double -> OutputType
    _cairoOutputType :: OutputType -- ^ the output format and associated options
              , Options Cairo V2 Double -> Bool
    _cairoBypassAdjust  :: Bool    -- ^ Should the 'adjustDia' step be bypassed during rendering?
              }
        deriving (Int -> Options Cairo V2 Double -> ShowS
    [Options Cairo V2 Double] -> ShowS
    Options Cairo V2 Double -> String
    (Int -> Options Cairo V2 Double -> ShowS)
    -> (Options Cairo V2 Double -> String)
    -> ([Options Cairo V2 Double] -> ShowS)
    -> Show (Options Cairo V2 Double)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Options Cairo V2 Double -> ShowS
    showsPrec :: Int -> Options Cairo V2 Double -> ShowS
    $cshow :: Options Cairo V2 Double -> String
    show :: Options Cairo V2 Double -> String
    $cshowList :: [Options Cairo V2 Double] -> ShowS
    showList :: [Options Cairo V2 Double] -> ShowS
    Show, Options Cairo V2 Double -> Options Cairo V2 Double -> Bool
    (Options Cairo V2 Double -> Options Cairo V2 Double -> Bool)
    -> (Options Cairo V2 Double -> Options Cairo V2 Double -> Bool)
    -> Eq (Options Cairo V2 Double)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Options Cairo V2 Double -> Options Cairo V2 Double -> Bool
    == :: Options Cairo V2 Double -> Options Cairo V2 Double -> Bool
    $c/= :: Options Cairo V2 Double -> Options Cairo V2 Double -> Bool
    /= :: Options Cairo V2 Double -> Options Cairo V2 Double -> Bool
    Eq)

      renderRTree :: Cairo
    -> Options Cairo V2 Double
    -> RTree Cairo V2 Double Annotation
    -> Result Cairo V2 Double
    renderRTree Cairo
    _ Options Cairo V2 Double
    opts RTree Cairo V2 Double Annotation
    t = (IO ()
    renderIO, Render ()
    r)
        where
          r :: Render ()
    r = RenderM () -> Render ()
    forall a. RenderM a -> Render a
    runRenderM (RenderM () -> Render ())
    -> (RTree Cairo V2 Double Annotation -> RenderM ())
    -> RTree Cairo V2 Double Annotation
    -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Render Cairo V2 Double -> RenderM ()
    runC (Render Cairo V2 Double -> RenderM ())
    -> (RTree Cairo V2 Double Annotation -> Render Cairo V2 Double)
    -> RTree Cairo V2 Double Annotation
    -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RTree Cairo V2 Double Annotation -> Render Cairo V2 Double
    forall a. RTree Cairo V2 Double a -> Render Cairo V2 Double
    toRender (RTree Cairo V2 Double Annotation -> Render ())
    -> RTree Cairo V2 Double Annotation -> Render ()
    forall a b. (a -> b) -> a -> b
    $ RTree Cairo V2 Double Annotation
    t
          renderIO :: IO ()
    renderIO = do
            let surfaceF :: Surface -> IO ()
    surfaceF Surface
    s = Surface -> Render () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
    C.renderWith Surface
    s Render ()
    r
                V2 Double
    w Double
    h = Double -> SizeSpec V2 Double -> V2 Double
    forall (v :: * -> *) n.
    (Foldable v, Functor v, Num n, Ord n) =>
    n -> SizeSpec v n -> v n
    specToSize Double
    1 (Options Cairo V2 Double
    optsOptions Cairo V2 Double
    -> Getting
         (SizeSpec V2 Double) (Options Cairo V2 Double) (SizeSpec V2 Double)
    -> SizeSpec V2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting
      (SizeSpec V2 Double) (Options Cairo V2 Double) (SizeSpec V2 Double)
    Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)
    cairoSizeSpec)
            case Options Cairo V2 Double
    optsOptions Cairo V2 Double
    -> Getting OutputType (Options Cairo V2 Double) OutputType
    -> OutputType
    forall s a. s -> Getting a s a -> a
    ^.Getting OutputType (Options Cairo V2 Double) OutputType
    Lens' (Options Cairo V2 Double) OutputType
    cairoOutputType of
              OutputType
    PNG ->
                Format -> Int -> Int -> (Surface -> IO ()) -> IO ()
    forall a. Format -> Int -> Int -> (Surface -> IO a) -> IO a
    C.withImageSurface Format
    C.FormatARGB32 (Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    w) (Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    h) ((Surface -> IO ()) -> IO ()) -> (Surface -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Surface
    surface -> do
                  Surface -> IO ()
    surfaceF Surface
    surface
                  Surface -> String -> IO ()
    C.surfaceWriteToPNG Surface
    surface (Options Cairo V2 Double
    optsOptions Cairo V2 Double
    -> Getting String (Options Cairo V2 Double) String -> String
    forall s a. s -> Getting a s a -> a
    ^.Getting String (Options Cairo V2 Double) String
    Lens' (Options Cairo V2 Double) String
    cairoFileName)
              OutputType
    PS  -> String -> Double -> Double -> (Surface -> IO ()) -> IO ()
    forall a. String -> Double -> Double -> (Surface -> IO a) -> IO a
    C.withPSSurface  (Options Cairo V2 Double
    optsOptions Cairo V2 Double
    -> Getting String (Options Cairo V2 Double) String -> String
    forall s a. s -> Getting a s a -> a
    ^.Getting String (Options Cairo V2 Double) String
    Lens' (Options Cairo V2 Double) String
    cairoFileName) Double
    w Double
    h Surface -> IO ()
    surfaceF
              OutputType
    PDF -> String -> Double -> Double -> (Surface -> IO ()) -> IO ()
    forall a. String -> Double -> Double -> (Surface -> IO a) -> IO a
    C.withPDFSurface (Options Cairo V2 Double
    optsOptions Cairo V2 Double
    -> Getting String (Options Cairo V2 Double) String -> String
    forall s a. s -> Getting a s a -> a
    ^.Getting String (Options Cairo V2 Double) String
    Lens' (Options Cairo V2 Double) String
    cairoFileName) Double
    w Double
    h Surface -> IO ()
    surfaceF
              OutputType
    SVG -> String -> Double -> Double -> (Surface -> IO ()) -> IO ()
    forall a. String -> Double -> Double -> (Surface -> IO a) -> IO a
    C.withSVGSurface (Options Cairo V2 Double
    optsOptions Cairo V2 Double
    -> Getting String (Options Cairo V2 Double) String -> String
    forall s a. s -> Getting a s a -> a
    ^.Getting String (Options Cairo V2 Double) String
    Lens' (Options Cairo V2 Double) String
    cairoFileName) Double
    w Double
    h Surface -> IO ()
    surfaceF
              OutputType
    RenderOnly -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      adjustDia :: forall m.
    (Additive V2, Monoid' m, Num Double) =>
    Cairo
    -> Options Cairo V2 Double
    -> QDiagram Cairo V2 Double m
    -> (Options Cairo V2 Double, T2 Double, QDiagram Cairo V2 Double m)
    adjustDia Cairo
    c Options Cairo V2 Double
    opts QDiagram Cairo V2 Double m
    d = if Options Cairo V2 Double -> Bool
    _cairoBypassAdjust Options Cairo V2 Double
    opts
                             then (Options Cairo V2 Double
    opts, T2 Double
    forall a. Monoid a => a
    mempty, QDiagram Cairo V2 Double m
    d QDiagram Cairo V2 Double m
    -> (QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m)
    -> QDiagram Cairo V2 Double m
    forall a b. a -> (a -> b) -> b
    # QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m
    forall n m b.
    (TypeableFloat n, Semigroup m) =>
    QDiagram b V2 n m -> QDiagram b V2 n m
    setDefault2DAttributes)
                             else let (Options Cairo V2 Double
    opts', T2 Double
    transformation, QDiagram Cairo V2 Double m
    d') = Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)
    -> Cairo
    -> Options Cairo V2 Double
    -> QDiagram Cairo V2 Double m
    -> (Options Cairo V2 Double, T2 Double, QDiagram Cairo V2 Double m)
    forall n m b.
    (TypeableFloat n, Monoid' m) =>
    Lens' (Options b V2 n) (SizeSpec V2 n)
    -> b
    -> Options b V2 n
    -> QDiagram b V2 n m
    -> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)
    adjustDia2D (SizeSpec V2 Double -> f (SizeSpec V2 Double))
    -> Options Cairo V2 Double -> f (Options Cairo V2 Double)
    Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)
    cairoSizeSpec Cairo
    c Options Cairo V2 Double
    opts (QDiagram Cairo V2 Double m
    d QDiagram Cairo V2 Double m
    -> (QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m)
    -> QDiagram Cairo V2 Double m
    forall a b. a -> (a -> b) -> b
    # QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m
    forall (v :: * -> *) n t.
    (InSpace v n t, R2 v, Transformable t) =>
    t -> t
    reflectY)
                                  in (Options Cairo V2 Double
    opts', T2 Double
    transformation T2 Double -> T2 Double -> T2 Double
    forall a. Semigroup a => a -> a -> a
    <> T2 Double
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    Transformation v n
    reflectionY, QDiagram Cairo V2 Double m
    d')

    runC :: Render Cairo V2 Double -> RenderM ()
    runC :: Render Cairo V2 Double -> RenderM ()
    runC (C RenderM ()
    r) = RenderM ()
    r

    instance Semigroup (Render Cairo V2 Double) where
      C RenderM ()
    rd1 <> :: Render Cairo V2 Double
    -> Render Cairo V2 Double -> Render Cairo V2 Double
    <> C RenderM ()
    rd2 = RenderM () -> Render Cairo V2 Double
    C (RenderM ()
    rd1 RenderM () -> RenderM () -> RenderM ()
    forall a b.
    StateStackT CairoState Render a
    -> StateStackT CairoState Render b
    -> StateStackT CairoState Render b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> RenderM ()
    rd2)

    instance Monoid (Render Cairo V2 Double) where
      mempty :: Render Cairo V2 Double
    mempty  = RenderM () -> Render Cairo V2 Double
    C (RenderM () -> Render Cairo V2 Double)
    -> RenderM () -> Render Cairo V2 Double
    forall a b. (a -> b) -> a -> b
    $ () -> RenderM ()
    forall a. a -> StateStackT CairoState Render a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #if !(MIN_VERSION_base(4,11,0))
      mappend = (<>)
    #endif

    instance Hashable (Options Cairo V2 Double) where
      hashWithSalt :: Int -> Options Cairo V2 Double -> Int
    hashWithSalt Int
    s (CairoOptions String
    fn SizeSpec V2 Double
    sz OutputType
    out Bool
    adj)
        = Int
    s   Int -> String -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt`
          String
    fn  Int -> SizeSpec V2 Double -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt`
          SizeSpec V2 Double
    sz  Int -> OutputType -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt`
          OutputType
    out Int -> Bool -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt`
          Bool
    adj

    toRender :: RTree Cairo V2 Double a -> Render Cairo V2 Double
    toRender :: forall a. RTree Cairo V2 Double a -> Render Cairo V2 Double
    toRender (Node (RPrim Prim Cairo V2 Double
    p) [Tree (RNode Cairo V2 Double a)]
    _) = Cairo
    -> Prim Cairo V2 Double
    -> Render
         Cairo (V (Prim Cairo V2 Double)) (N (Prim Cairo V2 Double))
    forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
    render Cairo
    Cairo Prim Cairo V2 Double
    p
    toRender (Node (RStyle Style V2 Double
    sty) [Tree (RNode Cairo V2 Double a)]
    rs) = RenderM () -> Render Cairo V2 Double
    C (RenderM () -> Render Cairo V2 Double)
    -> RenderM () -> Render Cairo V2 Double
    forall a b. (a -> b) -> a -> b
    $ do
      RenderM ()
    save
      Style V2 Double -> RenderM ()
    forall (v :: * -> *). Style v Double -> RenderM ()
    cairoStyle Style V2 Double
    sty
      (Style V2 Double -> Identity (Style V2 Double))
    -> CairoState -> Identity CairoState
    Lens' CairoState (Style V2 Double)
    accumStyle ((Style V2 Double -> Identity (Style V2 Double))
     -> CairoState -> Identity CairoState)
    -> (Style V2 Double -> Style V2 Double) -> RenderM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= (Style V2 Double -> Style V2 Double -> Style V2 Double
    forall a. Semigroup a => a -> a -> a
    <> Style V2 Double
    sty)
      Render Cairo V2 Double -> RenderM ()
    runC (Render Cairo V2 Double -> RenderM ())
    -> Render Cairo V2 Double -> RenderM ()
    forall a b. (a -> b) -> a -> b
    $ (Tree (RNode Cairo V2 Double a) -> Render Cairo V2 Double)
    -> [Tree (RNode Cairo V2 Double a)] -> Render Cairo V2 Double
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Tree (RNode Cairo V2 Double a) -> Render Cairo V2 Double
    forall a. RTree Cairo V2 Double a -> Render Cairo V2 Double
    toRender [Tree (RNode Cairo V2 Double a)]
    rs
      RenderM ()
    restore
    toRender (Node RNode Cairo V2 Double a
    _ [Tree (RNode Cairo V2 Double a)]
    rs) = (Tree (RNode Cairo V2 Double a) -> Render Cairo V2 Double)
    -> [Tree (RNode Cairo V2 Double a)] -> Render Cairo V2 Double
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Tree (RNode Cairo V2 Double a) -> Render Cairo V2 Double
    forall a. RTree Cairo V2 Double a -> Render Cairo V2 Double
    toRender [Tree (RNode Cairo V2 Double a)]
    rs

    cairoFileName :: Lens' (Options Cairo V2 Double) String
    cairoFileName :: Lens' (Options Cairo V2 Double) String
    cairoFileName = (Options Cairo V2 Double -> String)
    -> (Options Cairo V2 Double -> String -> Options Cairo V2 Double)
    -> Lens' (Options Cairo V2 Double) String
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens (\(CairoOptions {_cairoFileName :: Options Cairo V2 Double -> String
    _cairoFileName = String
    f}) -> String
    f)
                         (\Options Cairo V2 Double
    o String
    f -> Options Cairo V2 Double
    o {_cairoFileName = f})

    cairoSizeSpec :: Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)
    cairoSizeSpec :: Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)
    cairoSizeSpec = (Options Cairo V2 Double -> SizeSpec V2 Double)
    -> (Options Cairo V2 Double
        -> SizeSpec V2 Double -> Options Cairo V2 Double)
    -> Lens' (Options Cairo V2 Double) (SizeSpec V2 Double)
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens (\(CairoOptions {_cairoSizeSpec :: Options Cairo V2 Double -> SizeSpec V2 Double
    _cairoSizeSpec = SizeSpec V2 Double
    s}) -> SizeSpec V2 Double
    s)
                         (\Options Cairo V2 Double
    o SizeSpec V2 Double
    s -> Options Cairo V2 Double
    o {_cairoSizeSpec = s})

    cairoOutputType :: Lens' (Options Cairo V2 Double) OutputType
    cairoOutputType :: Lens' (Options Cairo V2 Double) OutputType
    cairoOutputType = (Options Cairo V2 Double -> OutputType)
    -> (Options Cairo V2 Double
        -> OutputType -> Options Cairo V2 Double)
    -> Lens' (Options Cairo V2 Double) OutputType
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens (\(CairoOptions {_cairoOutputType :: Options Cairo V2 Double -> OutputType
    _cairoOutputType = OutputType
    t}) -> OutputType
    t)
                         (\Options Cairo V2 Double
    o OutputType
    t -> Options Cairo V2 Double
    o {_cairoOutputType = t})

    cairoBypassAdjust :: Lens' (Options Cairo V2 Double) Bool
    cairoBypassAdjust :: Lens' (Options Cairo V2 Double) Bool
    cairoBypassAdjust = (Options Cairo V2 Double -> Bool)
    -> (Options Cairo V2 Double -> Bool -> Options Cairo V2 Double)
    -> Lens' (Options Cairo V2 Double) Bool
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens (\(CairoOptions {_cairoBypassAdjust :: Options Cairo V2 Double -> Bool
    _cairoBypassAdjust = Bool
    b}) -> Bool
    b)
                         (\Options Cairo V2 Double
    o Bool
    b -> Options Cairo V2 Double
    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 :: forall a.
    (Renderable a Cairo, V a ~ V2, N a ~ Double) =>
    a -> RenderM ()
    renderC = Render Cairo V2 Double -> RenderM ()
    runC (Render Cairo V2 Double -> RenderM ())
    -> (a -> Render Cairo V2 Double) -> a -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cairo -> a -> Render Cairo (V a) (N a)
    forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
    render Cairo
    Cairo

    -- | Get an accumulated style attribute from the render monad state.
    getStyleAttrib :: AttributeClass a => (a -> b) -> RenderM (Maybe b)
    getStyleAttrib :: forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
    getStyleAttrib a -> b
    f = ((a -> b) -> Maybe a -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Maybe a -> Maybe b)
    -> (Style V2 Double -> Maybe a) -> Style V2 Double -> Maybe b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style V2 Double -> Maybe a
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr) (Style V2 Double -> Maybe b)
    -> StateStackT CairoState Render (Style V2 Double)
    -> StateStackT CairoState Render (Maybe b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Getting (Style V2 Double) CairoState (Style V2 Double)
    -> StateStackT CairoState Render (Style V2 Double)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting (Style V2 Double) CairoState (Style V2 Double)
    Lens' CairoState (Style V2 Double)
    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 :: forall (v :: * -> *). Style v Double -> RenderM ()
    cairoStyle Style v Double
    s =
      [RenderM ()] -> RenderM ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_
      ([RenderM ()] -> RenderM ())
    -> ([Maybe (RenderM ())] -> [RenderM ()])
    -> [Maybe (RenderM ())]
    -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (RenderM ())] -> [RenderM ()]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (RenderM ())] -> RenderM ())
    -> [Maybe (RenderM ())] -> RenderM ()
    forall a b. (a -> b) -> a -> b
    $ [ (Clip Double -> RenderM ()) -> Maybe (RenderM ())
    forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle Clip Double -> RenderM ()
    clip
                    , (FillRule -> RenderM ()) -> Maybe (RenderM ())
    forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle FillRule -> RenderM ()
    lFillRule
                    , (LineWidth Double -> RenderM ()) -> Maybe (RenderM ())
    forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle LineWidth Double -> RenderM ()
    lWidth
                    , (LineCap -> RenderM ()) -> Maybe (RenderM ())
    forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle LineCap -> RenderM ()
    lCap
                    , (LineJoin -> RenderM ()) -> Maybe (RenderM ())
    forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle LineJoin -> RenderM ()
    lJoin
                    , (Dashing Double -> RenderM ()) -> Maybe (RenderM ())
    forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle Dashing Double -> RenderM ()
    lDashing
                    ]
      where handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ())
            handle :: forall a.
    AttributeClass a =>
    (a -> RenderM ()) -> Maybe (RenderM ())
    handle a -> RenderM ()
    f = a -> RenderM ()
    f (a -> RenderM ()) -> Maybe a -> Maybe (RenderM ())
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Style v Double -> Maybe a
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style v Double
    s
            clip :: Clip Double -> RenderM ()
    clip       = (Path V2 Double -> RenderM ()) -> [Path V2 Double] -> RenderM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\Path V2 Double
    p -> Path V2 Double -> RenderM ()
    cairoPath Path V2 Double
    p RenderM () -> RenderM () -> RenderM ()
    forall a b.
    StateStackT CairoState Render a
    -> StateStackT CairoState Render b
    -> StateStackT CairoState Render b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC Render ()
    C.clip) ([Path V2 Double] -> RenderM ())
    -> (Clip Double -> [Path V2 Double]) -> Clip Double -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unwrapped (Clip Double) -> Clip Double)
    -> Clip Double -> Unwrapped (Clip Double)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op [Path V2 Double] -> Clip Double
    Unwrapped (Clip Double) -> Clip Double
    forall n. [Path V2 n] -> Clip n
    Clip
            lFillRule :: FillRule -> RenderM ()
    lFillRule  = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ())
    -> (FillRule -> Render ()) -> FillRule -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FillRule -> Render ()
    C.setFillRule (FillRule -> Render ())
    -> (FillRule -> FillRule) -> FillRule -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FillRule -> FillRule
    fromFillRule (FillRule -> FillRule)
    -> (FillRule -> FillRule) -> FillRule -> FillRule
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FillRule -> FillRule
    getFillRule
            lWidth :: LineWidth Double -> RenderM ()
    lWidth     = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ())
    -> (LineWidth Double -> Render ())
    -> LineWidth Double
    -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Double -> Render ()
    C.setLineWidth (Double -> Render ())
    -> (LineWidth Double -> Double) -> LineWidth Double -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineWidth Double -> Double
    forall n. LineWidth n -> n
    getLineWidth
            lCap :: LineCap -> RenderM ()
    lCap       = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ())
    -> (LineCap -> Render ()) -> LineCap -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineCap -> Render ()
    C.setLineCap (LineCap -> Render ())
    -> (LineCap -> LineCap) -> LineCap -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineCap -> LineCap
    fromLineCap (LineCap -> LineCap) -> (LineCap -> LineCap) -> LineCap -> LineCap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineCap -> LineCap
    getLineCap
            lJoin :: LineJoin -> RenderM ()
    lJoin      = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ())
    -> (LineJoin -> Render ()) -> LineJoin -> RenderM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineJoin -> Render ()
    C.setLineJoin (LineJoin -> Render ())
    -> (LineJoin -> LineJoin) -> LineJoin -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineJoin -> LineJoin
    fromLineJoin (LineJoin -> LineJoin)
    -> (LineJoin -> LineJoin) -> LineJoin -> LineJoin
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineJoin -> LineJoin
    getLineJoin
            lDashing :: Dashing Double -> RenderM ()
    lDashing (Dashing Double -> Dashing Double
    forall n. Dashing n -> Dashing n
    getDashing -> Dashing [Double]
    ds Double
    offs) =
              Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
    forall a b. (a -> b) -> a -> b
    $ [Double] -> Double -> Render ()
    C.setDash [Double]
    ds Double
    offs

    fromFontSlant :: FontSlant -> P.FontStyle
    fromFontSlant :: FontSlant -> FontStyle
    fromFontSlant FontSlant
    FontSlantNormal   = FontStyle
    P.StyleNormal
    fromFontSlant FontSlant
    FontSlantItalic   = FontStyle
    P.StyleItalic
    fromFontSlant FontSlant
    FontSlantOblique  = FontStyle
    P.StyleOblique

    fromFontWeight :: FontWeight -> P.Weight
    fromFontWeight :: FontWeight -> Weight
    fromFontWeight FontWeight
    FontWeightBold   = Weight
    P.WeightBold
    fromFontWeight FontWeight
    _                = Weight
    P.WeightNormal

    -- | Multiply the current transformation matrix by the given 2D
    --   transformation.
    cairoTransf :: T2 Double -> C.Render ()
    cairoTransf :: T2 Double -> Render ()
    cairoTransf T2 Double
    t = Matrix -> Render ()
    C.transform Matrix
    m
      where m :: Matrix
    m = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
    CM.Matrix Double
    a1 Double
    a2 Double
    b1 Double
    b2 Double
    c1 Double
    c2
            (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 -> (Double
    a1,Double
    a2)) = T2 Double -> V2 Double -> V2 Double
    forall (v :: * -> *) n. Transformation v n -> v n -> v n
    apply T2 Double
    t V2 Double
    forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
    unitX
            (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 -> (Double
    b1,Double
    b2)) = T2 Double -> V2 Double -> V2 Double
    forall (v :: * -> *) n. Transformation v n -> v n -> v n
    apply T2 Double
    t V2 Double
    forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
    unitY
            (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 -> (Double
    c1,Double
    c2)) = T2 Double -> V2 Double
    forall (v :: * -> *) n. Transformation v n -> v n
    transl T2 Double
    t

    fromLineCap :: LineCap -> C.LineCap
    fromLineCap :: LineCap -> LineCap
    fromLineCap LineCap
    LineCapButt   = LineCap
    C.LineCapButt
    fromLineCap LineCap
    LineCapRound  = LineCap
    C.LineCapRound
    fromLineCap LineCap
    LineCapSquare = LineCap
    C.LineCapSquare

    fromLineJoin :: LineJoin -> C.LineJoin
    fromLineJoin :: LineJoin -> LineJoin
    fromLineJoin LineJoin
    LineJoinMiter = LineJoin
    C.LineJoinMiter
    fromLineJoin LineJoin
    LineJoinRound = LineJoin
    C.LineJoinRound
    fromLineJoin LineJoin
    LineJoinBevel = LineJoin
    C.LineJoinBevel

    fromFillRule :: FillRule -> C.FillRule
    fromFillRule :: FillRule -> FillRule
    fromFillRule FillRule
    Winding = FillRule
    C.FillRuleWinding
    fromFillRule FillRule
    EvenOdd = FillRule
    C.FillRuleEvenOdd

    instance Renderable (Segment Closed V2 Double) Cairo where
      render :: Cairo
    -> Segment Closed V2 Double
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    render Cairo
    _ (Linear (OffsetClosed V2 Double
    v)) = RenderM ()
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    RenderM () -> Render Cairo V2 Double
    C (RenderM ()
     -> Render
          Cairo
          (V (Segment Closed V2 Double))
          (N (Segment Closed V2 Double)))
    -> (Render () -> RenderM ())
    -> Render ()
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render ()
     -> Render
          Cairo
          (V (Segment Closed V2 Double))
          (N (Segment Closed V2 Double)))
    -> Render ()
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    forall a b. (a -> b) -> a -> b
    $ (Double -> Double -> Render ()) -> (Double, Double) -> Render ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Double -> Double -> Render ()
    C.relLineTo (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 V2 Double
    v)
      render Cairo
    _ (Cubic (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 -> (Double
    x1,Double
    y1))
                      (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 -> (Double
    x2,Double
    y2))
                      (OffsetClosed (V2 Double -> (Double, Double)
    forall n. V2 n -> (n, n)
    unr2 -> (Double
    x3,Double
    y3))))
        = RenderM ()
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    RenderM () -> Render Cairo V2 Double
    C (RenderM ()
     -> Render
          Cairo
          (V (Segment Closed V2 Double))
          (N (Segment Closed V2 Double)))
    -> (Render () -> RenderM ())
    -> Render ()
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render ()
     -> Render
          Cairo
          (V (Segment Closed V2 Double))
          (N (Segment Closed V2 Double)))
    -> Render ()
    -> Render
         Cairo (V (Segment Closed V2 Double)) (N (Segment Closed V2 Double))
    forall a b. (a -> b) -> a -> b
    $ Double
    -> Double -> Double -> Double -> Double -> Double -> Render ()
    C.relCurveTo Double
    x1 Double
    y1 Double
    x2 Double
    y2 Double
    x3 Double
    y3

    instance Renderable (Trail V2 Double) Cairo where
      render :: Cairo
    -> Trail V2 Double
    -> Render Cairo (V (Trail V2 Double)) (N (Trail V2 Double))
    render Cairo
    _ = (Trail' Line V2 Double -> Render Cairo V2 Double)
    -> (Trail' Loop V2 Double -> Render Cairo V2 Double)
    -> Trail V2 Double
    -> Render Cairo V2 Double
    forall (v :: * -> *) n r.
    (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
    withTrail Trail' Line V2 Double -> Render Cairo V2 Double
    renderLine Trail' Loop V2 Double -> Render Cairo V2 Double
    renderLoop
        where
          renderLine :: Trail' Line V2 Double -> Render Cairo V2 Double
    renderLine Trail' Line V2 Double
    ln = RenderM () -> Render Cairo V2 Double
    C (RenderM () -> Render Cairo V2 Double)
    -> RenderM () -> Render Cairo V2 Double
    forall a b. (a -> b) -> a -> b
    $ do
            (Segment Closed V2 Double -> RenderM ())
    -> [Segment Closed V2 Double] -> RenderM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Segment Closed V2 Double -> RenderM ()
    forall a.
    (Renderable a Cairo, V a ~ V2, N a ~ Double) =>
    a -> RenderM ()
    renderC (Trail' Line V2 Double -> [Segment Closed V2 Double]
    forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
    lineSegments Trail' Line V2 Double
    ln)

            -- remember that we saw a Line, so we will ignore fill attribute
            (Bool -> Identity Bool) -> CairoState -> Identity CairoState
    Lens' CairoState Bool
    ignoreFill ((Bool -> Identity Bool) -> CairoState -> Identity CairoState)
    -> Bool -> RenderM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Bool
    True

          renderLoop :: Trail' Loop V2 Double -> Render Cairo V2 Double
    renderLoop Trail' Loop V2 Double
    lp = RenderM () -> Render Cairo V2 Double
    C (RenderM () -> Render Cairo V2 Double)
    -> RenderM () -> Render Cairo V2 Double
    forall a b. (a -> b) -> a -> b
    $ do
            case Trail' Loop V2 Double
    -> ([Segment Closed V2 Double], Segment Open V2 Double)
    forall (v :: * -> *) n.
    Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
    loopSegments Trail' Loop V2 Double
    lp of
              -- let closePath handle the last segment if it is linear
              ([Segment Closed V2 Double]
    segs, Linear Offset Open V2 Double
    _) -> (Segment Closed V2 Double -> RenderM ())
    -> [Segment Closed V2 Double] -> RenderM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Segment Closed V2 Double -> RenderM ()
    forall a.
    (Renderable a Cairo, V a ~ V2, N a ~ Double) =>
    a -> RenderM ()
    renderC [Segment Closed V2 Double]
    segs

              -- otherwise we have to draw it explicitly
              ([Segment Closed V2 Double], Segment Open V2 Double)
    _ -> (Segment Closed V2 Double -> RenderM ())
    -> [Segment Closed V2 Double] -> RenderM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Segment Closed V2 Double -> RenderM ()
    forall a.
    (Renderable a Cairo, V a ~ V2, N a ~ Double) =>
    a -> RenderM ()
    renderC (Trail' Line V2 Double -> [Segment Closed V2 Double]
    forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
    lineSegments (Trail' Line V2 Double -> [Segment Closed V2 Double])
    -> (Trail' Loop V2 Double -> Trail' Line V2 Double)
    -> Trail' Loop V2 Double
    -> [Segment Closed V2 Double]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Trail' Loop V2 Double -> Trail' Line V2 Double
    forall (v :: * -> *) n.
    (Metric v, OrderedField n) =>
    Trail' Loop v n -> Trail' Line v n
    cutLoop (Trail' Loop V2 Double -> [Segment Closed V2 Double])
    -> Trail' Loop V2 Double -> [Segment Closed V2 Double]
    forall a b. (a -> b) -> a -> b
    $ Trail' Loop V2 Double
    lp)

            Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC Render ()
    C.closePath

    instance Renderable (Path V2 Double) Cairo where
      render :: Cairo
    -> Path V2 Double
    -> Render Cairo (V (Path V2 Double)) (N (Path V2 Double))
    render Cairo
    _ Path V2 Double
    p = RenderM () -> Render Cairo V2 Double
    C (RenderM () -> Render Cairo V2 Double)
    -> RenderM () -> Render Cairo V2 Double
    forall a b. (a -> b) -> a -> b
    $ do
        Path V2 Double -> RenderM ()
    cairoPath Path V2 Double
    p
        f <- (FillTexture Double -> Texture Double)
    -> RenderM (Maybe (Texture Double))
    forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
    getStyleAttrib FillTexture Double -> Texture Double
    forall n. FillTexture n -> Texture n
    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 V2 Double -> RenderM ()
    cairoPath (Path [Located (Trail V2 Double)]
    trs) = do
        Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC Render ()
    C.newPath
        (Bool -> Identity Bool) -> CairoState -> Identity CairoState
    Lens' CairoState Bool
    ignoreFill ((Bool -> Identity Bool) -> CairoState -> Identity CairoState)
    -> Bool -> RenderM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Bool
    False
        (Located (Trail V2 Double) -> RenderM ())
    -> [Located (Trail V2 Double)] -> RenderM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    F.mapM_ Located (Trail V2 Double) -> RenderM ()
    forall {a}.
    (V a ~ V2, N a ~ Double, Renderable a Cairo) =>
    Located a -> RenderM ()
    renderTrail [Located (Trail V2 Double)]
    trs
      where
        renderTrail :: Located a -> RenderM ()
    renderTrail (Located a -> (Point (V a) (N a), a)
    forall a. Located a -> (Point (V a) (N a), a)
    viewLoc -> (Point (V a) (N a) -> (Double, Double)
    P2 Double -> (Double, Double)
    forall n. P2 n -> (n, n)
    unp2 -> (Double, Double)
    p, a
    tr)) = do
          Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
    forall a b. (a -> b) -> a -> b
    $ (Double -> Double -> Render ()) -> (Double, Double) -> Render ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Double -> Double -> Render ()
    C.moveTo (Double, Double)
    p
          a -> RenderM ()
    forall a.
    (Renderable a Cairo, V a ~ V2, N a ~ Double) =>
    a -> RenderM ()
    renderC a
    tr

    addStop :: MonadIO m => C.Pattern -> GradientStop Double -> m ()
    addStop :: forall (m :: * -> *).
    MonadIO m =>
    Pattern -> GradientStop Double -> m ()
    addStop Pattern
    p GradientStop Double
    s = Pattern -> Double -> Double -> Double -> Double -> Double -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Pattern -> Double -> Double -> Double -> Double -> Double -> m ()
    C.patternAddColorStopRGBA Pattern
    p (GradientStop Double
    sGradientStop Double
    -> Getting Double (GradientStop Double) Double -> Double
    forall s a. s -> Getting a s a -> a
    ^.Getting Double (GradientStop Double) Double
    forall n (f :: * -> *).
    Functor f =>
    (n -> f n) -> GradientStop n -> f (GradientStop n)
    stopFraction) Double
    r Double
    g Double
    b Double
    a
      where
        (Double
    r,Double
    g,Double
    b,Double
    a) = SomeColor -> (Double, Double, Double, Double)
    forall c. Color c => c -> (Double, Double, Double, Double)
    colorToSRGBA (GradientStop Double
    sGradientStop Double
    -> Getting SomeColor (GradientStop Double) SomeColor -> SomeColor
    forall s a. s -> Getting a s a -> a
    ^.Getting SomeColor (GradientStop Double) SomeColor
    forall n (f :: * -> *).
    Functor f =>
    (SomeColor -> f SomeColor) -> GradientStop n -> f (GradientStop n)
    stopColor)

    cairoSpreadMethod :: SpreadMethod -> C.Extend
    cairoSpreadMethod :: SpreadMethod -> Extend
    cairoSpreadMethod SpreadMethod
    GradPad = Extend
    C.ExtendPad
    cairoSpreadMethod SpreadMethod
    GradReflect = Extend
    C.ExtendReflect
    cairoSpreadMethod SpreadMethod
    GradRepeat = Extend
    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 :: Maybe (Texture Double) -> RenderM ()
    setTexture Maybe (Texture Double)
    Nothing = () -> RenderM ()
    forall a. a -> StateStackT CairoState Render a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    setTexture (Just (SC (SomeColor c
    c))) = do
        o <- Double -> Maybe Double -> Double
    forall a. a -> Maybe a -> a
    fromMaybe Double
    1 (Maybe Double -> Double)
    -> StateStackT CairoState Render (Maybe Double)
    -> StateStackT CairoState Render Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Opacity -> Double) -> StateStackT CairoState Render (Maybe Double)
    forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
    getStyleAttrib Opacity -> Double
    getOpacity
        liftC (C.setSourceRGBA r g b (o*a))
      where (Double
    r,Double
    g,Double
    b,Double
    a) = c -> (Double, Double, Double, Double)
    forall c. Color c => c -> (Double, Double, Double, Double)
    colorToSRGBA c
    c
    setTexture (Just (LG LGradient Double
    g)) = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
    forall a b. (a -> b) -> a -> b
    $
        Double
    -> Double
    -> Double
    -> Double
    -> (Pattern -> Render ())
    -> Render ()
    forall a.
    Double
    -> Double -> Double -> Double -> (Pattern -> Render a) -> Render a
    C.withLinearPattern Double
    x0 Double
    y0 Double
    x1 Double
    y1 ((Pattern -> Render ()) -> Render ())
    -> (Pattern -> Render ()) -> Render ()
    forall a b. (a -> b) -> a -> b
    $ \Pattern
    pat -> do
          (GradientStop Double -> Render ())
    -> [GradientStop Double] -> Render ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern -> GradientStop Double -> Render ()
    forall (m :: * -> *).
    MonadIO m =>
    Pattern -> GradientStop Double -> m ()
    addStop Pattern
    pat) (LGradient Double
    gLGradient Double
    -> Getting
         [GradientStop Double] (LGradient Double) [GradientStop Double]
    -> [GradientStop Double]
    forall s a. s -> Getting a s a -> a
    ^.Getting
      [GradientStop Double] (LGradient Double) [GradientStop Double]
    forall n (f :: * -> *).
    Functor f =>
    ([GradientStop n] -> f [GradientStop n])
    -> LGradient n -> f (LGradient n)
    lGradStops)
          Pattern -> Matrix -> Render ()
    forall (m :: * -> *). MonadIO m => Pattern -> Matrix -> m ()
    C.patternSetMatrix Pattern
    pat Matrix
    m
          Pattern -> Extend -> Render ()
    forall (m :: * -> *). MonadIO m => Pattern -> Extend -> m ()
    C.patternSetExtend Pattern
    pat (SpreadMethod -> Extend
    cairoSpreadMethod (LGradient Double
    gLGradient Double
    -> Getting SpreadMethod (LGradient Double) SpreadMethod
    -> SpreadMethod
    forall s a. s -> Getting a s a -> a
    ^.Getting SpreadMethod (LGradient Double) SpreadMethod
    forall n (f :: * -> *).
    Functor f =>
    (SpreadMethod -> f SpreadMethod) -> LGradient n -> f (LGradient n)
    lGradSpreadMethod))
          Pattern -> Render ()
    C.setSource Pattern
    pat
      where
        m :: Matrix
    m = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
    CM.Matrix Double
    a1 Double
    a2 Double
    b1 Double
    b2 Double
    c1 Double
    c2
        [[Double
    a1, Double
    a2], [Double
    b1, Double
    b2], [Double
    c1, Double
    c2]] = T2 Double -> [[Double]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep (T2 Double -> T2 Double
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv (LGradient Double
    gLGradient Double
    -> Getting (T2 Double) (LGradient Double) (T2 Double) -> T2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting (T2 Double) (LGradient Double) (T2 Double)
    forall n (f :: * -> *).
    Functor f =>
    (Transformation V2 n -> f (Transformation V2 n))
    -> LGradient n -> f (LGradient n)
    lGradTrans))
        (Double
    x0, Double
    y0) = P2 Double -> (Double, Double)
    forall n. P2 n -> (n, n)
    unp2 (LGradient Double
    gLGradient Double
    -> Getting (P2 Double) (LGradient Double) (P2 Double) -> P2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting (P2 Double) (LGradient Double) (P2 Double)
    forall n (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> LGradient n -> f (LGradient n)
    lGradStart)
        (Double
    x1, Double
    y1) = P2 Double -> (Double, Double)
    forall n. P2 n -> (n, n)
    unp2 (LGradient Double
    gLGradient Double
    -> Getting (P2 Double) (LGradient Double) (P2 Double) -> P2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting (P2 Double) (LGradient Double) (P2 Double)
    forall n (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> LGradient n -> f (LGradient n)
    lGradEnd)
    setTexture (Just (RG RGradient Double
    g)) = Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
    forall a b. (a -> b) -> a -> b
    $
        Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> (Pattern -> Render ())
    -> Render ()
    forall a.
    Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> (Pattern -> Render a)
    -> Render a
    C.withRadialPattern Double
    x0 Double
    y0 Double
    r0 Double
    x1 Double
    y1 Double
    r1 ((Pattern -> Render ()) -> Render ())
    -> (Pattern -> Render ()) -> Render ()
    forall a b. (a -> b) -> a -> b
    $ \Pattern
    pat -> do
          (GradientStop Double -> Render ())
    -> [GradientStop Double] -> Render ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Pattern -> GradientStop Double -> Render ()
    forall (m :: * -> *).
    MonadIO m =>
    Pattern -> GradientStop Double -> m ()
    addStop Pattern
    pat) (RGradient Double
    gRGradient Double
    -> Getting
         [GradientStop Double] (RGradient Double) [GradientStop Double]
    -> [GradientStop Double]
    forall s a. s -> Getting a s a -> a
    ^.Getting
      [GradientStop Double] (RGradient Double) [GradientStop Double]
    forall n (f :: * -> *).
    Functor f =>
    ([GradientStop n] -> f [GradientStop n])
    -> RGradient n -> f (RGradient n)
    rGradStops)
          Pattern -> Matrix -> Render ()
    forall (m :: * -> *). MonadIO m => Pattern -> Matrix -> m ()
    C.patternSetMatrix Pattern
    pat Matrix
    m
          Pattern -> Extend -> Render ()
    forall (m :: * -> *). MonadIO m => Pattern -> Extend -> m ()
    C.patternSetExtend Pattern
    pat (SpreadMethod -> Extend
    cairoSpreadMethod (RGradient Double
    gRGradient Double
    -> Getting SpreadMethod (RGradient Double) SpreadMethod
    -> SpreadMethod
    forall s a. s -> Getting a s a -> a
    ^.Getting SpreadMethod (RGradient Double) SpreadMethod
    forall n (f :: * -> *).
    Functor f =>
    (SpreadMethod -> f SpreadMethod) -> RGradient n -> f (RGradient n)
    rGradSpreadMethod))
          Pattern -> Render ()
    C.setSource Pattern
    pat
      where
        m :: Matrix
    m = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
    CM.Matrix Double
    a1 Double
    a2 Double
    b1 Double
    b2 Double
    c1 Double
    c2
        [[Double
    a1, Double
    a2], [Double
    b1, Double
    b2], [Double
    c1, Double
    c2]] = T2 Double -> [[Double]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep (T2 Double -> T2 Double
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv (RGradient Double
    gRGradient Double
    -> Getting (T2 Double) (RGradient Double) (T2 Double) -> T2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting (T2 Double) (RGradient Double) (T2 Double)
    forall n (f :: * -> *).
    Functor f =>
    (Transformation V2 n -> f (Transformation V2 n))
    -> RGradient n -> f (RGradient n)
    rGradTrans))
        (Double
    r0, Double
    r1) = (RGradient Double
    gRGradient Double
    -> Getting Double (RGradient Double) Double -> Double
    forall s a. s -> Getting a s a -> a
    ^.Getting Double (RGradient Double) Double
    forall n (f :: * -> *).
    Functor f =>
    (n -> f n) -> RGradient n -> f (RGradient n)
    rGradRadius0, RGradient Double
    gRGradient Double
    -> Getting Double (RGradient Double) Double -> Double
    forall s a. s -> Getting a s a -> a
    ^.Getting Double (RGradient Double) Double
    forall n (f :: * -> *).
    Functor f =>
    (n -> f n) -> RGradient n -> f (RGradient n)
    rGradRadius1)
        (Double
    x0', Double
    y0') = P2 Double -> (Double, Double)
    forall n. P2 n -> (n, n)
    unp2 (RGradient Double
    gRGradient Double
    -> Getting (P2 Double) (RGradient Double) (P2 Double) -> P2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting (P2 Double) (RGradient Double) (P2 Double)
    forall n (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> RGradient n -> f (RGradient n)
    rGradCenter0)
        (Double
    x1', Double
    y1') = P2 Double -> (Double, Double)
    forall n. P2 n -> (n, n)
    unp2 (RGradient Double
    gRGradient Double
    -> Getting (P2 Double) (RGradient Double) (P2 Double) -> P2 Double
    forall s a. s -> Getting a s a -> a
    ^.Getting (P2 Double) (RGradient Double) (P2 Double)
    forall n (f :: * -> *).
    Functor f =>
    (Point V2 n -> f (Point V2 n)) -> RGradient n -> f (RGradient n)
    rGradCenter1)
        (Double
    x0, Double
    y0, Double
    x1, Double
    y1) = (Double
    x0' Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    r1 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    r0) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    r1, Double
    y0' Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    r1 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    r0) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    r1, Double
    x1' ,Double
    y1')

    -- Can only do PNG files at the moment...
    instance Renderable (DImage Double External) Cairo where
      render :: Cairo
    -> DImage Double External
    -> Render
         Cairo (V (DImage Double External)) (N (DImage Double External))
    render Cairo
    _ (DImage ImageData External
    path Int
    w Int
    h T2 Double
    tr) = RenderM ()
    -> Render
         Cairo (V (DImage Double External)) (N (DImage Double External))
    RenderM () -> Render Cairo V2 Double
    C (RenderM ()
     -> Render
          Cairo (V (DImage Double External)) (N (DImage Double External)))
    -> (Render () -> RenderM ())
    -> Render ()
    -> Render
         Cairo (V (DImage Double External)) (N (DImage Double External))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render ()
     -> Render
          Cairo (V (DImage Double External)) (N (DImage Double External)))
    -> Render ()
    -> Render
         Cairo (V (DImage Double External)) (N (DImage Double External))
    forall a b. (a -> b) -> a -> b
    $ do
        let ImageRef String
    file = ImageData External
    path
        if String
    ".png" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    file
          then do
            Render ()
    C.save
            T2 Double -> Render ()
    cairoTransf (T2 Double
    tr T2 Double -> T2 Double -> T2 Double
    forall a. Semigroup a => a -> a -> a
    <> T2 Double
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    Transformation v n
    reflectionY)
            pngSurfChk <- IO (Either IOError Surface) -> Render (Either IOError Surface)
    forall a. IO a -> Render a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Surface -> IO (Either IOError Surface)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO Surface -> IO (Either IOError Surface))
    -> IO Surface -> IO (Either IOError Surface)
    forall a b. (a -> b) -> a -> b
    $ String -> IO Surface
    C.imageSurfaceCreateFromPNG String
    file
                                  :: IO (Either IOError C.Surface))
            case pngSurfChk of
              Right Surface
    pngSurf -> do
                w' <- Surface -> Render Int
    forall (m :: * -> *). MonadIO m => Surface -> m Int
    C.imageSurfaceGetWidth Surface
    pngSurf
                h' <- C.imageSurfaceGetHeight pngSurf
                let sz = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double) -> SizeSpec V2 Int -> SizeSpec V2 Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Int -> SizeSpec V2 Int
    forall n. n -> n -> SizeSpec V2 n
    dims2D Int
    w Int
    h
                cairoTransf $ requiredScaling sz (fromIntegral <$> V2 w' h')
                C.setSourceSurface pngSurf (-fromIntegral w' / 2)
                                           (-fromIntegral h' / 2)
              Left IOError
    _ ->
                IO () -> Render ()
    forall a. IO a -> Render a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Render ()) -> (String -> IO ()) -> String -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    putStrLn (String -> Render ()) -> String -> Render ()
    forall a b. (a -> b) -> a -> b
    $
                  String
    "Warning: can't read image file <" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    file String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">"
            C.paint
            C.restore
          else
            IO () -> Render ()
    forall a. IO a -> Render a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Render ())
    -> ([String] -> IO ()) -> [String] -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    putStr (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines ([String] -> Render ()) -> [String] -> Render ()
    forall a b. (a -> b) -> a -> b
    $
              [ String
    "Warning: Cairo backend can currently only render embedded"
              , String
    "  images in .png format.  Ignoring <" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    file String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">."
              ]

    -- Copied from Rasterific backend. This function should probably be in JuicyPixels!
    toImageRGBA8 :: DynamicImage -> Image PixelRGBA8
    toImageRGBA8 :: DynamicImage -> Image PixelRGBA8
    toImageRGBA8 (ImageRGBA8 Image PixelRGBA8
    i)  = Image PixelRGBA8
    i
    toImageRGBA8 (ImageRGB8 Image PixelRGB8
    i)   = Image PixelRGB8 -> Image PixelRGBA8
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage Image PixelRGB8
    i
    toImageRGBA8 (ImageYCbCr8 Image PixelYCbCr8
    i) = Image PixelRGB8 -> Image PixelRGBA8
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
    forall a b. ColorSpaceConvertible a b => Image a -> Image b
    convertImage Image PixelYCbCr8
    i :: Image PixelRGB8)
    toImageRGBA8 (ImageY8 Image Pixel8
    i)     = Image Pixel8 -> Image PixelRGBA8
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage Image Pixel8
    i
    toImageRGBA8 (ImageYA8 Image PixelYA8
    i)    = Image PixelYA8 -> Image PixelRGBA8
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage Image PixelYA8
    i
    toImageRGBA8 (ImageCMYK8 Image PixelCMYK8
    i)  = Image PixelRGB8 -> Image PixelRGBA8
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage (Image PixelCMYK8 -> Image PixelRGB8
    forall a b. ColorSpaceConvertible a b => Image a -> Image b
    convertImage Image PixelCMYK8
    i :: Image PixelRGB8)
    toImageRGBA8 DynamicImage
    _               = String -> Image PixelRGBA8
    forall a. HasCallStack => String -> a
    error String
    "Unsupported Pixel type"

    instance Renderable (DImage Double Embedded) Cairo where
      -- render _ (DImage path w h tr) =
      render :: Cairo
    -> DImage Double Embedded
    -> Render
         Cairo (V (DImage Double Embedded)) (N (DImage Double Embedded))
    render Cairo
    _ (DImage ImageData Embedded
    iD Int
    _w Int
    _h T2 Double
    tr) = RenderM ()
    -> Render
         Cairo (V (DImage Double Embedded)) (N (DImage Double Embedded))
    RenderM () -> Render Cairo V2 Double
    C (RenderM ()
     -> Render
          Cairo (V (DImage Double Embedded)) (N (DImage Double Embedded)))
    -> (Render () -> RenderM ())
    -> Render ()
    -> Render
         Cairo (V (DImage Double Embedded)) (N (DImage Double Embedded))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Render () -> RenderM ()
    forall a. Render a -> RenderM a
    liftC (Render ()
     -> Render
          Cairo (V (DImage Double Embedded)) (N (DImage Double Embedded)))
    -> Render ()
    -> Render
         Cairo (V (DImage Double Embedded)) (N (DImage Double Embedded))
    forall a b. (a -> b) -> a -> b
    $ do
         Render ()
    C.save
         T2 Double -> Render ()
    cairoTransf (T2 Double
    tr T2 Double -> T2 Double -> T2 Double
    forall a. Semigroup a => a -> a -> a
    <> T2 Double
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    Transformation v n
    reflectionY)

         let fmt :: Format
    fmt = Format
    C.FormatARGB32
         dataSurf <- IO Surface -> Render Surface
    forall a. IO a -> Render a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Surface -> Render Surface) -> IO Surface -> Render Surface
    forall a b. (a -> b) -> a -> b
    $ Format -> Int -> Int -> IO Surface
    C.createImageSurface Format
    fmt Int
    w Int
    h

         surData :: C.SurfaceData Int Word32
                 <- liftIO $ C.imageSurfaceGetPixels dataSurf

         stride <- C.imageSurfaceGetStride dataSurf

         _ <- forMOf imageIPixels img $ \(Int
    x, Int
    y, PixelRGBA8
    px) -> do
            let p :: Int
    p = Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    strideInt -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div`Int
    4) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x
            IO () -> Render ()
    forall a. IO a -> Render a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Render ()) -> (Word32 -> IO ()) -> Word32 -> Render ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SurfaceData Int Word32 -> Int -> Word32 -> IO ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    MA.writeArray SurfaceData Int Word32
    surData Int
    p (Word32 -> Render ()) -> Word32 -> Render ()
    forall a b. (a -> b) -> a -> b
    $ PixelRGBA8 -> Word32
    toARGB PixelRGBA8
    px
            PixelRGBA8 -> Render PixelRGBA8
    forall a. a -> Render a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PixelRGBA8
    px

         C.surfaceMarkDirty dataSurf

         w' <- C.imageSurfaceGetWidth dataSurf
         h' <- C.imageSurfaceGetHeight dataSurf
         let sz = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double) -> SizeSpec V2 Int -> SizeSpec V2 Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Int -> SizeSpec V2 Int
    forall n. n -> n -> SizeSpec V2 n
    dims2D Int
    w Int
    h
         cairoTransf $ requiredScaling sz (fromIntegral <$> V2 w' h')
         C.setSourceSurface dataSurf (-fromIntegral w' / 2)
                                     (-fromIntegral h' / 2)

         C.paint
         C.restore
        where
          ImageRaster DynamicImage
    dImg = ImageData Embedded
    iD
          img :: Image PixelRGBA8
    img@(Image Int
    w Int
    h Vector (PixelBaseComponent PixelRGBA8)
    _) = DynamicImage -> Image PixelRGBA8
    toImageRGBA8 DynamicImage
    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 :: PixelRGBA8 -> Word32
    toARGB PixelRGBA8
    px = Word32
    ga Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    rotateL Word32
    rb Int
    16
     where rgba :: PackedRepresentation PixelRGBA8
    rgba = PixelRGBA8 -> PackedRepresentation PixelRGBA8
    forall a. PackeablePixel a => a -> PackedRepresentation a
    packPixel PixelRGBA8
    px
           rb :: Word32
    rb = Word32
    PackedRepresentation PixelRGBA8
    rgba Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    0x00FF00FF
           ga :: Word32
    ga = Word32
    PackedRepresentation PixelRGBA8
    rgba Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. Word32
    0xFF00FF00

    if' :: Monad m => (a -> m ()) -> Maybe a -> m ()
    if' :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
    if' = m () -> (a -> m ()) -> Maybe a -> m ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    instance Renderable (Text Double) Cairo where
      render :: Cairo
    -> Text Double -> Render Cairo (V (Text Double)) (N (Text Double))
    render Cairo
    _ Text Double
    txt = RenderM () -> Render Cairo V2 Double
    C (RenderM () -> Render Cairo V2 Double)
    -> RenderM () -> Render Cairo V2 Double
    forall a b. (a -> b) -> a -> b
    $ do
        RenderM ()
    save
        Maybe (Texture Double) -> RenderM ()
    setTexture (Maybe (Texture Double) -> RenderM ())
    -> RenderM (Maybe (Texture Double)) -> RenderM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (FillTexture Double -> Texture Double)
    -> RenderM (Maybe (Texture Double))
    forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
    getStyleAttrib FillTexture Double -> Texture Double
    forall n. FillTexture n -> Texture n
    getFillTexture
        sty <- Getting (Style V2 Double) CairoState (Style V2 Double)
    -> StateStackT CairoState Render (Style V2 Double)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting (Style V2 Double) CairoState (Style V2 Double)
    Lens' CairoState (Style V2 Double)
    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 :: Style V2 Double -> Text Double -> Render PangoLayout
    layoutStyledText Style V2 Double
    sty (Text T2 Double
    tt TextAlignment Double
    al String
    str) =
      let tr :: T2 Double
    tr = T2 Double
    tt T2 Double -> T2 Double -> T2 Double
    forall a. Semigroup a => a -> a -> a
    <> T2 Double
    forall (v :: * -> *) n.
    (Additive v, R2 v, Num n) =>
    Transformation v n
    reflectionY
          styAttr :: AttributeClass a => (a -> b) -> Maybe b
          styAttr :: forall a b. AttributeClass a => (a -> b) -> Maybe b
    styAttr a -> b
    f = (a -> b) -> Maybe a -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Maybe a -> Maybe b) -> Maybe a -> Maybe b
    forall a b. (a -> b) -> a -> b
    $ Style V2 Double -> Maybe a
    forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr Style V2 Double
    sty
          ff :: Maybe String
    ff = (Font -> String) -> Maybe String
    forall a b. AttributeClass a => (a -> b) -> Maybe b
    styAttr Font -> String
    getFont
          fs :: Maybe FontStyle
    fs = (FontSlant -> FontStyle) -> Maybe FontStyle
    forall a b. AttributeClass a => (a -> b) -> Maybe b
    styAttr FontSlant -> FontStyle
    fromFontSlant
          fw :: Maybe Weight
    fw = (FontWeight -> Weight) -> Maybe Weight
    forall a b. AttributeClass a => (a -> b) -> Maybe b
    styAttr FontWeight -> Weight
    fromFontWeight
          size' :: Maybe Double
    size' = (FontSize Double -> Double) -> Maybe Double
    forall a b. AttributeClass a => (a -> b) -> Maybe b
    styAttr FontSize Double -> Double
    forall n. FontSize n -> n
    getFontSize
      in do
        T2 Double -> Render ()
    cairoTransf T2 Double
    tr -- non-uniform scale
        layout <- String -> Render PangoLayout
    forall string. GlibString string => string -> Render PangoLayout
    P.createLayout String
    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 Double
    xt Double
    yt -> do
            (_,P.PangoRectangle _ _ w h) <- PangoLayout -> IO (PangoRectangle, PangoRectangle)
    P.layoutGetExtents PangoLayout
    layout
            return $ r2 (w * xt, h * (1 - yt))
          TextAlignment Double
    BaselineText -> do
            baseline <- LayoutIter -> IO Double
    P.layoutIterGetBaseline (LayoutIter -> IO Double) -> IO LayoutIter -> IO Double
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< PangoLayout -> IO LayoutIter
    P.layoutGetIter PangoLayout
    layout
            return $ r2 (0, baseline)
        let t = V2 Double -> T2 Double -> T2 Double
    forall t (v :: * -> *) n.
    (V t ~ v, N t ~ n, HasOrigin t) =>
    v n -> t -> t
    moveOriginBy V2 Double
    ref T2 Double
    forall a. Monoid a => a
    mempty :: T2 Double
        cairoTransf t
        P.updateLayout layout
        return layout