{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}

-- | The backend to render charts with cairo.
module Graphics.Rendering.Chart.Backend.Cairo
  ( FileFormat(..)
  , FileOptions(..)
  , runBackend
  , renderableToFile
  , toFile
  , defaultEnv

  , fo_size
  , fo_format

  , cBackendToFile

  ) where

import Data.Default.Class
import Data.Colour
import Data.Colour.Names
import Data.Colour.SRGB
import Data.List (unfoldr)
import Data.Monoid

import Control.Lens(makeLenses)
import Control.Monad.Reader
import Control.Monad.Operational

import qualified Graphics.Rendering.Cairo as C
import qualified Graphics.Rendering.Cairo.Matrix as CM

import Graphics.Rendering.Chart.Backend as G
import Graphics.Rendering.Chart.Backend.Impl
import Graphics.Rendering.Chart.Backend.Types
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Geometry as G
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.SparkLine
import Graphics.Rendering.Chart.State(EC, execEC)

-----------------------------------------------------------------------
-- Rendering Backend Environment
-----------------------------------------------------------------------

-- | The environment we need to track when rendering to cairo
data CEnv = CEnv
  { CEnv -> AlignmentFns
ceAlignmentFns :: AlignmentFns
  , CEnv -> AlphaColour Double
ceFontColor :: AlphaColour Double
  , CEnv -> AlphaColour Double
cePathColor :: AlphaColour Double
  , CEnv -> AlphaColour Double
ceFillColor :: AlphaColour Double
}

-- | Produce a environment with no transformation and clipping. 
--   It will use the default styles.
defaultEnv :: AlignmentFns
           -> CEnv
defaultEnv :: AlignmentFns -> CEnv
defaultEnv AlignmentFns
alignFns = CEnv :: AlignmentFns
-> AlphaColour Double
-> AlphaColour Double
-> AlphaColour Double
-> CEnv
CEnv 
  { ceAlignmentFns :: AlignmentFns
ceAlignmentFns = AlignmentFns
alignFns
  , ceFontColor :: AlphaColour Double
ceFontColor = Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black
  , cePathColor :: AlphaColour Double
cePathColor = Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black
  , ceFillColor :: AlphaColour Double
ceFillColor = Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
white
  }

-- -----------------------------------------------------------------------
-- Backend and Monad
-- -----------------------------------------------------------------------

-- | Run this backends renderer.
runBackend :: CEnv -- ^ Environment to start rendering with.
           -> BackendProgram a  -- ^ Chart render code.
           -> C.Render a      -- ^ Cairo render code.
runBackend :: forall a. CEnv -> BackendProgram a -> Render a
runBackend CEnv
env BackendProgram a
m = CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env (BackendProgram a -> BackendProgram a
forall a. BackendProgram a -> BackendProgram a
withDefaultStyle BackendProgram a
m)

runBackend' :: CEnv -> BackendProgram a -> C.Render a
runBackend' :: forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env BackendProgram a
m = CEnv -> ProgramView ChartBackendInstr a -> Render a
forall a. CEnv -> ProgramView ChartBackendInstr a -> Render a
eval CEnv
env (BackendProgram a -> ProgramView ChartBackendInstr a
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
view BackendProgram a
m)
  where
    eval :: CEnv -> ProgramView ChartBackendInstr a -> C.Render a
    eval :: forall a. CEnv -> ProgramView ChartBackendInstr a -> Render a
eval CEnv
env (Return a
v)= a -> Render a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    eval CEnv
env (StrokePath Path
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> Path -> Render ()
cStrokePath CEnv
env Path
p Render () -> (() -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (FillPath Path
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> Path -> Render ()
cFillPath CEnv
env Path
p Render () -> (() -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (GetTextSize String
s :>>= b -> ProgramT ChartBackendInstr Identity a
f) = String -> Render TextSize
cTextSize String
s Render TextSize -> (TextSize -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (DrawText Point
p String
s :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> Point -> String -> Render ()
cDrawText CEnv
env Point
p String
s Render () -> (() -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (ChartBackendInstr b
GetAlignments :>>= b -> ProgramT ChartBackendInstr Identity a
f) = AlignmentFns -> Render AlignmentFns
forall (m :: * -> *) a. Monad m => a -> m a
return (CEnv -> AlignmentFns
ceAlignmentFns CEnv
env) Render AlignmentFns -> (AlignmentFns -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (WithTransform Matrix
m Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> Matrix -> Program ChartBackendInstr b -> Render b
forall a. CEnv -> Matrix -> BackendProgram a -> Render a
cWithTransform CEnv
env Matrix
m Program ChartBackendInstr b
p Render b -> (b -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (WithFontStyle FontStyle
font Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> FontStyle -> Program ChartBackendInstr b -> Render b
forall a. CEnv -> FontStyle -> BackendProgram a -> Render a
cWithFontStyle CEnv
env FontStyle
font Program ChartBackendInstr b
p Render b -> (b -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (WithFillStyle FillStyle
fs Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> FillStyle -> Program ChartBackendInstr b -> Render b
forall a. CEnv -> FillStyle -> BackendProgram a -> Render a
cWithFillStyle CEnv
env FillStyle
fs Program ChartBackendInstr b
p Render b -> (b -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (WithLineStyle LineStyle
ls Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> LineStyle -> Program ChartBackendInstr b -> Render b
forall a. CEnv -> LineStyle -> BackendProgram a -> Render a
cWithLineStyle CEnv
env LineStyle
ls Program ChartBackendInstr b
p Render b -> (b -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f
    eval CEnv
env (WithClipRegion Rect
r Program ChartBackendInstr b
p :>>= b -> ProgramT ChartBackendInstr Identity a
f) = CEnv -> Rect -> Program ChartBackendInstr b -> Render b
forall a. CEnv -> Rect -> BackendProgram a -> Render a
cWithClipRegion CEnv
env Rect
r Program ChartBackendInstr b
p Render b -> (b -> Render a) -> Render a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CEnv
-> (b -> ProgramT ChartBackendInstr Identity a) -> b -> Render a
forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env b -> ProgramT ChartBackendInstr Identity a
f

    step :: CEnv -> (v -> BackendProgram a) -> v -> C.Render a
    step :: forall v a. CEnv -> (v -> BackendProgram a) -> v -> Render a
step CEnv
env v -> BackendProgram a
f =  \v
v -> CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env (v -> BackendProgram a
f v
v)
    
walkPath :: Path -> C.Render ()
walkPath :: Path -> Render ()
walkPath (MoveTo Point
p Path
path) = Double -> Double -> Render ()
C.moveTo (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p) Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> Render ()
walkPath Path
path
walkPath (LineTo Point
p Path
path) = Double -> Double -> Render ()
C.lineTo (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p) Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> Render ()
walkPath Path
path
walkPath (Arc Point
p Double
r Double
a1 Double
a2 Path
path) = Double -> Double -> Double -> Double -> Double -> Render ()
C.arc (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p) Double
r Double
a1 Double
a2 Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> Render ()
walkPath Path
path
walkPath (ArcNeg Point
p Double
r Double
a1 Double
a2 Path
path) = Double -> Double -> Double -> Double -> Double -> Render ()
C.arcNegative (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p) Double
r Double
a1 Double
a2 Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> Render ()
walkPath Path
path
walkPath Path
End = () -> Render ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
walkPath Path
Close = Render ()
C.closePath

cStrokePath :: CEnv -> Path -> C.Render ()
cStrokePath :: CEnv -> Path -> Render ()
cStrokePath CEnv
env Path
p = Render () -> Render ()
forall a. Render a -> Render a
preserveCState0 (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$ do
    AlphaColour Double -> Render ()
setSourceColor (CEnv -> AlphaColour Double
cePathColor CEnv
env)
    Render ()
C.newPath Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> Render ()
walkPath Path
p Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Render ()
C.stroke

cFillPath :: CEnv -> Path -> C.Render ()
cFillPath :: CEnv -> Path -> Render ()
cFillPath CEnv
env Path
p = Render () -> Render ()
forall a. Render a -> Render a
preserveCState0 (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$ do
    AlphaColour Double -> Render ()
setSourceColor (CEnv -> AlphaColour Double
ceFillColor CEnv
env)
    Render ()
C.newPath Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> Render ()
walkPath Path
p Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Render ()
C.fill

cTextSize :: String -> C.Render TextSize
cTextSize :: String -> Render TextSize
cTextSize String
text = do
  TextExtents
te <- String -> Render TextExtents
forall string. CairoString string => string -> Render TextExtents
C.textExtents String
text
  FontExtents
fe <- Render FontExtents
C.fontExtents
  TextSize -> Render TextSize
forall (m :: * -> *) a. Monad m => a -> m a
return (TextSize -> Render TextSize) -> TextSize -> Render TextSize
forall a b. (a -> b) -> a -> b
$ TextSize :: Double -> Double -> Double -> Double -> Double -> TextSize
TextSize 
    { textSizeWidth :: Double
textSizeWidth    = TextExtents -> Double
C.textExtentsWidth TextExtents
te
    , textSizeAscent :: Double
textSizeAscent   = FontExtents -> Double
C.fontExtentsAscent FontExtents
fe
    , textSizeDescent :: Double
textSizeDescent  = FontExtents -> Double
C.fontExtentsDescent FontExtents
fe
    , textSizeYBearing :: Double
textSizeYBearing = TextExtents -> Double
C.textExtentsYbearing TextExtents
te
    , textSizeHeight :: Double
textSizeHeight   = FontExtents -> Double
C.fontExtentsHeight FontExtents
fe
    }

cDrawText :: CEnv -> Point -> String -> C.Render ()
cDrawText :: CEnv -> Point -> String -> Render ()
cDrawText CEnv
env Point
p String
text = Render () -> Render ()
forall a. Render a -> Render a
preserveCState0 (Render () -> Render ()) -> Render () -> Render ()
forall a b. (a -> b) -> a -> b
$ do
  AlphaColour Double -> Render ()
setSourceColor (AlphaColour Double -> Render ())
-> AlphaColour Double -> Render ()
forall a b. (a -> b) -> a -> b
$ (CEnv -> AlphaColour Double
ceFontColor CEnv
env)
  Point -> Render ()
cTranslate Point
p
  Double -> Double -> Render ()
C.moveTo Double
0 Double
0
  String -> Render ()
forall string. CairoString string => string -> Render ()
C.showText String
text

cWithTransform :: CEnv -> Matrix -> BackendProgram a -> C.Render a
cWithTransform :: forall a. CEnv -> Matrix -> BackendProgram a -> Render a
cWithTransform CEnv
env Matrix
m BackendProgram a
p = Render a -> Render a
forall a. Render a -> Render a
preserveCState0 (Render a -> Render a) -> Render a -> Render a
forall a b. (a -> b) -> a -> b
$ do
  Matrix -> Render ()
C.transform (Matrix -> Matrix
convertMatrix Matrix
m)
  CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env BackendProgram a
p

cWithFontStyle :: CEnv -> FontStyle -> BackendProgram a -> C.Render a
cWithFontStyle :: forall a. CEnv -> FontStyle -> BackendProgram a -> Render a
cWithFontStyle CEnv
env FontStyle
font BackendProgram a
p = Render a -> Render a
forall a. Render a -> Render a
preserveCState0 (Render a -> Render a) -> Render a -> Render a
forall a b. (a -> b) -> a -> b
$ do
  String -> FontSlant -> FontWeight -> Render ()
forall string.
CairoString string =>
string -> FontSlant -> FontWeight -> Render ()
C.selectFontFace (FontStyle -> String
G._font_name FontStyle
font) 
                   (FontSlant -> FontSlant
convertFontSlant (FontSlant -> FontSlant) -> FontSlant -> FontSlant
forall a b. (a -> b) -> a -> b
$ FontStyle -> FontSlant
G._font_slant FontStyle
font) 
                   (FontWeight -> FontWeight
convertFontWeight (FontWeight -> FontWeight) -> FontWeight -> FontWeight
forall a b. (a -> b) -> a -> b
$ FontStyle -> FontWeight
G._font_weight FontStyle
font)
  Double -> Render ()
C.setFontSize (FontStyle -> Double
G._font_size FontStyle
font)
  CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env{ceFontColor :: AlphaColour Double
ceFontColor=FontStyle -> AlphaColour Double
G._font_color FontStyle
font} BackendProgram a
p

cWithFillStyle :: CEnv -> FillStyle -> BackendProgram a -> C.Render a
cWithFillStyle :: forall a. CEnv -> FillStyle -> BackendProgram a -> Render a
cWithFillStyle CEnv
env FillStyle
fs BackendProgram a
p = do
  CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env{ceFillColor :: AlphaColour Double
ceFillColor=FillStyle -> AlphaColour Double
G._fill_color FillStyle
fs} BackendProgram a
p

cWithLineStyle :: CEnv -> LineStyle -> BackendProgram a -> C.Render a
cWithLineStyle :: forall a. CEnv -> LineStyle -> BackendProgram a -> Render a
cWithLineStyle CEnv
env LineStyle
ls BackendProgram a
p = Render a -> Render a
forall a. Render a -> Render a
preserveCState0 (Render a -> Render a) -> Render a -> Render a
forall a b. (a -> b) -> a -> b
$ do
  Double -> Render ()
C.setLineWidth (LineStyle -> Double
G._line_width LineStyle
ls)
  LineCap -> Render ()
C.setLineCap (LineCap -> LineCap
convertLineCap (LineCap -> LineCap) -> LineCap -> LineCap
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineCap
G._line_cap LineStyle
ls)
  LineJoin -> Render ()
C.setLineJoin (LineJoin -> LineJoin
convertLineJoin (LineJoin -> LineJoin) -> LineJoin -> LineJoin
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineJoin
G._line_join LineStyle
ls)
  [Double] -> Double -> Render ()
C.setDash (LineStyle -> [Double]
G._line_dashes LineStyle
ls) Double
0
  CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env{cePathColor :: AlphaColour Double
cePathColor=LineStyle -> AlphaColour Double
G._line_color LineStyle
ls} BackendProgram a
p

cWithClipRegion :: CEnv -> Rect -> BackendProgram a -> C.Render a
cWithClipRegion :: forall a. CEnv -> Rect -> BackendProgram a -> Render a
cWithClipRegion CEnv
env Rect
r BackendProgram a
p = Render a -> Render a
forall a. Render a -> Render a
preserveCState0 (Render a -> Render a) -> Render a -> Render a
forall a b. (a -> b) -> a -> b
$ do
  Rect -> Render ()
setClipRegion Rect
r
  CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend' CEnv
env BackendProgram a
p

-- -----------------------------------------------------------------------
-- Output rendering functions
-- -----------------------------------------------------------------------

data FileFormat = PNG
                | SVG
                | PS
                | PDF

data FileOptions = FileOptions {
  FileOptions -> (Int, Int)
_fo_size :: (Int,Int),
  FileOptions -> FileFormat
_fo_format :: FileFormat
}

instance Default FileOptions where
  def :: FileOptions
def =  (Int, Int) -> FileFormat -> FileOptions
FileOptions (Int
800,Int
600) FileFormat
PNG

-- | Generate an image file for the given renderable, at the specified path. Size and
-- format are set through the `FileOptions` parameter.
renderableToFile :: FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile :: forall a. FileOptions -> String -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo String
path Renderable a
r = FileOptions -> BackendProgram (PickFn a) -> String -> IO (PickFn a)
forall a. FileOptions -> BackendProgram a -> String -> IO a
cBackendToFile FileOptions
fo BackendProgram (PickFn a)
cr String
path
  where
    cr :: BackendProgram (PickFn a)
cr = Renderable a -> RectSize -> BackendProgram (PickFn a)
forall a. Renderable a -> RectSize -> BackendProgram (PickFn a)
render Renderable a
r (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
    (Int
width,Int
height) = FileOptions -> (Int, Int)
_fo_size FileOptions
fo

-- | Generate an image file from from the state content of an EC
-- computation. The state may have any type that is an instance of
-- `ToRenderable`
toFile :: (Default r, ToRenderable r) => FileOptions -> FilePath -> EC r () -> IO ()
toFile :: forall r.
(Default r, ToRenderable r) =>
FileOptions -> String -> EC r () -> IO ()
toFile FileOptions
fo String
path EC r ()
ec = IO (PickFn ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (PickFn ()) -> IO ()) -> IO (PickFn ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ FileOptions -> String -> Renderable () -> IO (PickFn ())
forall a. FileOptions -> String -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo String
path (r -> Renderable ()
forall a. ToRenderable a => a -> Renderable ()
toRenderable (EC r () -> r
forall l a. Default l => EC l a -> l
execEC EC r ()
ec))

-- | Generate an image file for the given drawing instructions, at the specified path. Size and
-- format are set through the `FileOptions` parameter.
cBackendToFile :: FileOptions -> BackendProgram a -> FilePath -> IO a
cBackendToFile :: forall a. FileOptions -> BackendProgram a -> String -> IO a
cBackendToFile FileOptions
fo BackendProgram a
cr String
path = do
    case (FileOptions -> FileFormat
_fo_format FileOptions
fo) of
      FileFormat
PS -> (String -> Double -> Double -> (Surface -> IO a) -> IO a) -> IO a
write String -> Double -> Double -> (Surface -> IO a) -> IO a
forall a. String -> Double -> Double -> (Surface -> IO a) -> IO a
C.withPSSurface
      FileFormat
PDF -> (String -> Double -> Double -> (Surface -> IO a) -> IO a) -> IO a
write String -> Double -> Double -> (Surface -> IO a) -> IO a
forall a. String -> Double -> Double -> (Surface -> IO a) -> IO a
C.withPDFSurface
      FileFormat
SVG -> (String -> Double -> Double -> (Surface -> IO a) -> IO a) -> IO a
write String -> Double -> Double -> (Surface -> IO a) -> IO a
forall a. String -> Double -> Double -> (Surface -> IO a) -> IO a
C.withSVGSurface
      FileFormat
PNG -> IO a
writePNG
  where
    write :: (String -> Double -> Double -> (Surface -> IO a) -> IO a) -> IO a
write String -> Double -> Double -> (Surface -> IO a) -> IO a
withSurface = do
      String -> Double -> Double -> (Surface -> IO a) -> IO a
withSurface String
path (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) ((Surface -> IO a) -> IO a) -> (Surface -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Surface
result -> do
      a
pf <- Surface -> Render a -> IO a
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
C.renderWith Surface
result (Render a -> IO a) -> Render a -> IO a
forall a b. (a -> b) -> a -> b
$ do
        a
pf <- CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend (AlignmentFns -> CEnv
defaultEnv AlignmentFns
vectorAlignmentFns) BackendProgram a
cr
        Render ()
C.showPage
        a -> Render a
forall (m :: * -> *) a. Monad m => a -> m a
return a
pf
      Surface -> IO ()
forall (m :: * -> *). MonadIO m => Surface -> m ()
C.surfaceFinish Surface
result
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
pf

    writePNG :: IO a
writePNG = Format -> Int -> Int -> (Surface -> IO a) -> IO a
forall a. Format -> Int -> Int -> (Surface -> IO a) -> IO a
C.withImageSurface Format
C.FormatARGB32 Int
width Int
height ((Surface -> IO a) -> IO a) -> (Surface -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Surface
result -> do
      a
pf <- Surface -> Render a -> IO a
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
C.renderWith Surface
result (Render a -> IO a) -> Render a -> IO a
forall a b. (a -> b) -> a -> b
$ CEnv -> BackendProgram a -> Render a
forall a. CEnv -> BackendProgram a -> Render a
runBackend (AlignmentFns -> CEnv
defaultEnv AlignmentFns
bitmapAlignmentFns) BackendProgram a
cr
      Surface -> String -> IO ()
C.surfaceWriteToPNG Surface
result String
path
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
pf

    (Int
width,Int
height) = FileOptions -> (Int, Int)
_fo_size FileOptions
fo

-- -----------------------------------------------------------------------
-- Type Conversions: Chart -> Cairo
-- -----------------------------------------------------------------------

-- | Convert a charts line join to a cairo line join.
convertLineJoin :: G.LineJoin -> C.LineJoin
convertLineJoin :: LineJoin -> LineJoin
convertLineJoin LineJoin
lj = case LineJoin
lj of
  LineJoin
G.LineJoinMiter -> LineJoin
C.LineJoinMiter
  LineJoin
G.LineJoinRound -> LineJoin
C.LineJoinRound
  LineJoin
G.LineJoinBevel -> LineJoin
C.LineJoinBevel

-- | Convert a charts line cap to a cairo line cap.
convertLineCap :: G.LineCap -> C.LineCap
convertLineCap :: LineCap -> LineCap
convertLineCap LineCap
lc = case LineCap
lc of
  LineCap
G.LineCapRound  -> LineCap
C.LineCapRound
  LineCap
G.LineCapButt   -> LineCap
C.LineCapButt
  LineCap
G.LineCapSquare -> LineCap
C.LineCapSquare

convertFontSlant :: G.FontSlant -> C.FontSlant
convertFontSlant :: FontSlant -> FontSlant
convertFontSlant FontSlant
fs = case FontSlant
fs of
  FontSlant
G.FontSlantItalic  -> FontSlant
C.FontSlantItalic
  FontSlant
G.FontSlantNormal  -> FontSlant
C.FontSlantNormal
  FontSlant
G.FontSlantOblique -> FontSlant
C.FontSlantOblique

convertFontWeight :: G.FontWeight -> C.FontWeight
convertFontWeight :: FontWeight -> FontWeight
convertFontWeight FontWeight
fw = case FontWeight
fw of
  FontWeight
G.FontWeightBold   -> FontWeight
C.FontWeightBold
  FontWeight
G.FontWeightNormal -> FontWeight
C.FontWeightNormal

convertMatrix :: G.Matrix -> CM.Matrix
convertMatrix :: Matrix -> Matrix
convertMatrix (G.Matrix Double
a1 Double
a2 Double
b1 Double
b2 Double
c1 Double
c2) = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
CM.Matrix Double
a1 Double
a2 Double
b1 Double
b2 Double
c1 Double
c2

-- -----------------------------------------------------------------------
-- Assorted helper functions in Cairo Usage
-- -----------------------------------------------------------------------

setClipRegion :: Rect -> C.Render ()
setClipRegion :: Rect -> Render ()
setClipRegion (Rect Point
p2 Point
p3) = do    
    Double -> Double -> Render ()
C.moveTo (Point -> Double
p_x Point
p2) (Point -> Double
p_y Point
p2)
    Double -> Double -> Render ()
C.lineTo (Point -> Double
p_x Point
p2) (Point -> Double
p_y Point
p3)
    Double -> Double -> Render ()
C.lineTo (Point -> Double
p_x Point
p3) (Point -> Double
p_y Point
p3)
    Double -> Double -> Render ()
C.lineTo (Point -> Double
p_x Point
p3) (Point -> Double
p_y Point
p2)
    Double -> Double -> Render ()
C.lineTo (Point -> Double
p_x Point
p2) (Point -> Double
p_y Point
p2)
    Render ()
C.clip

colourChannel :: (Floating a, Ord a) => AlphaColour a -> Colour a
colourChannel :: forall a. (Floating a, Ord a) => AlphaColour a -> Colour a
colourChannel AlphaColour a
c = a -> Colour a -> Colour a
forall (f :: * -> *) a. (ColourOps f, Num a) => a -> f a -> f a
darken (a -> a
forall a. Fractional a => a -> a
recip (AlphaColour a -> a
forall a. AlphaColour a -> a
alphaChannel AlphaColour a
c)) (AlphaColour a
c AlphaColour a -> Colour a -> Colour a
forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` Colour a
forall a. Num a => Colour a
black)

setSourceColor :: AlphaColour Double -> C.Render ()
setSourceColor :: AlphaColour Double -> Render ()
setSourceColor AlphaColour Double
c = let (RGB Double
r Double
g Double
b) = Colour Double -> RGB Double
forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB (Colour Double -> RGB Double) -> Colour Double -> RGB Double
forall a b. (a -> b) -> a -> b
$ AlphaColour Double -> Colour Double
forall a. (Floating a, Ord a) => AlphaColour a -> Colour a
colourChannel AlphaColour Double
c
                   in Double -> Double -> Double -> Double -> Render ()
C.setSourceRGBA Double
r Double
g Double
b (AlphaColour Double -> Double
forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
c)

-- | Execute a rendering action in a saved context (ie bracketed
--   between C.save and C.restore).
preserveCState0 :: C.Render a -> C.Render a
preserveCState0 :: forall a. Render a -> Render a
preserveCState0 Render a
a = do 
  Render ()
C.save
  a
v <- Render a
a
  Render ()
C.restore
  a -> Render a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

-- -- -----------------------------------------------------------------------
-- -- Cairo Operation Wrappers
-- -- -----------------------------------------------------------------------
  
cTranslate :: Point -> C.Render ()
cTranslate :: Point -> Render ()
cTranslate Point
p = Double -> Double -> Render ()
C.translate (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p)

cLineTo :: Point -> C.Render ()
cLineTo :: Point -> Render ()
cLineTo Point
p = Double -> Double -> Render ()
C.lineTo (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p)

cMoveTo :: Point -> C.Render ()
cMoveTo :: Point -> Render ()
cMoveTo Point
p = Double -> Double -> Render ()
C.moveTo (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p)

cArc :: Point -> Double -> Double -> Double -> C.Render ()
cArc :: Point -> Double -> Double -> Double -> Render ()
cArc Point
p Double
r Double
a1 Double
a2 = Double -> Double -> Double -> Double -> Double -> Render ()
C.arc (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p) Double
r Double
a1 Double
a2

cArcNegative :: Point -> Double -> Double -> Double -> C.Render ()
cArcNegative :: Point -> Double -> Double -> Double -> Render ()
cArcNegative Point
p Double
r Double
a1 Double
a2 = Double -> Double -> Double -> Double -> Double -> Render ()
C.arcNegative (Point -> Double
p_x Point
p) (Point -> Double
p_y Point
p) Double
r Double
a1 Double
a2

$( makeLenses ''FileOptions )