{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
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)
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
}
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
}
runBackend :: CEnv
-> BackendProgram a
-> C.Render a
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
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
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
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))
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
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
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
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)
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
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 )