Chart-cairo-1.8.1/Graphics/0000755000000000000000000000000012472544103013605 5ustar0000000000000000Chart-cairo-1.8.1/Graphics/Rendering/0000755000000000000000000000000012472544103015522 5ustar0000000000000000Chart-cairo-1.8.1/Graphics/Rendering/Chart/0000755000000000000000000000000012472544103016563 5ustar0000000000000000Chart-cairo-1.8.1/Graphics/Rendering/Chart/Backend/0000755000000000000000000000000012707515507020121 5ustar0000000000000000Chart-cairo-1.8.1/Graphics/Rendering/Chart/Backend/Cairo.hs0000644000000000000000000002452312707515507021520 0ustar0000000000000000{-# 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 { ceAlignmentFns :: AlignmentFns , ceFontColor :: AlphaColour Double , cePathColor :: AlphaColour Double , ceFillColor :: AlphaColour Double } -- | Produce a environment with no transformation and clipping. -- It will use the default styles. defaultEnv :: AlignmentFns -> CEnv defaultEnv alignFns = CEnv { ceAlignmentFns = alignFns , ceFontColor = opaque black , cePathColor = opaque black , ceFillColor = opaque 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 env m = runBackend' env (withDefaultStyle m) runBackend' :: CEnv -> BackendProgram a -> C.Render a runBackend' env m = eval env (view m) where eval :: CEnv -> ProgramView ChartBackendInstr a -> C.Render a eval env (Return v)= return v eval env (StrokePath p :>>= f) = cStrokePath env p >>= step env f eval env (FillPath p :>>= f) = cFillPath env p >>= step env f eval env (GetTextSize s :>>= f) = cTextSize s >>= step env f eval env (DrawText p s :>>= f) = cDrawText env p s >>= step env f eval env (GetAlignments :>>= f) = return (ceAlignmentFns env) >>= step env f eval env (WithTransform m p :>>= f) = cWithTransform env m p >>= step env f eval env (WithFontStyle font p :>>= f) = cWithFontStyle env font p >>= step env f eval env (WithFillStyle fs p :>>= f) = cWithFillStyle env fs p >>= step env f eval env (WithLineStyle ls p :>>= f) = cWithLineStyle env ls p >>= step env f eval env (WithClipRegion r p :>>= f) = cWithClipRegion env r p >>= step env f step :: CEnv -> (v -> BackendProgram a) -> v -> C.Render a step env f = \v -> runBackend' env (f v) walkPath :: Path -> C.Render () walkPath (MoveTo p path) = C.moveTo (p_x p) (p_y p) >> walkPath path walkPath (LineTo p path) = C.lineTo (p_x p) (p_y p) >> walkPath path walkPath (Arc p r a1 a2 path) = C.arc (p_x p) (p_y p) r a1 a2 >> walkPath path walkPath (ArcNeg p r a1 a2 path) = C.arcNegative (p_x p) (p_y p) r a1 a2 >> walkPath path walkPath End = return () walkPath Close = C.closePath cStrokePath :: CEnv -> Path -> C.Render () cStrokePath env p = preserveCState0 $ do setSourceColor (cePathColor env) C.newPath >> walkPath p >> C.stroke cFillPath :: CEnv -> Path -> C.Render () cFillPath env p = preserveCState0 $ do setSourceColor (ceFillColor env) C.newPath >> walkPath p >> C.fill cTextSize :: String -> C.Render TextSize cTextSize text = do te <- C.textExtents text fe <- C.fontExtents return $ TextSize { textSizeWidth = C.textExtentsWidth te , textSizeAscent = C.fontExtentsAscent fe , textSizeDescent = C.fontExtentsDescent fe , textSizeYBearing = C.textExtentsYbearing te , textSizeHeight = C.fontExtentsHeight fe } cDrawText :: CEnv -> Point -> String -> C.Render () cDrawText env p text = preserveCState0 $ do setSourceColor $ (ceFontColor env) cTranslate p C.moveTo 0 0 C.showText text cWithTransform :: CEnv -> Matrix -> BackendProgram a -> C.Render a cWithTransform env m p = preserveCState0 $ do C.transform (convertMatrix m) runBackend' env p cWithFontStyle :: CEnv -> FontStyle -> BackendProgram a -> C.Render a cWithFontStyle env font p = preserveCState0 $ do C.selectFontFace (G._font_name font) (convertFontSlant $ G._font_slant font) (convertFontWeight $ G._font_weight font) C.setFontSize (G._font_size font) runBackend' env{ceFontColor=G._font_color font} p cWithFillStyle :: CEnv -> FillStyle -> BackendProgram a -> C.Render a cWithFillStyle env fs p = do runBackend' env{ceFillColor=G._fill_color fs} p cWithLineStyle :: CEnv -> LineStyle -> BackendProgram a -> C.Render a cWithLineStyle env ls p = preserveCState0 $ do C.setLineWidth (G._line_width ls) C.setLineCap (convertLineCap $ G._line_cap ls) C.setLineJoin (convertLineJoin $ G._line_join ls) C.setDash (G._line_dashes ls) 0 runBackend' env{cePathColor=G._line_color ls} p cWithClipRegion :: CEnv -> Rect -> BackendProgram a -> C.Render a cWithClipRegion env r p = preserveCState0 $ do setClipRegion r runBackend' env p -- ----------------------------------------------------------------------- -- Output rendering functions -- ----------------------------------------------------------------------- data FileFormat = PNG | SVG | PS | PDF data FileOptions = FileOptions { _fo_size :: (Int,Int), _fo_format :: FileFormat } instance Default FileOptions where def = FileOptions (800,600) 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 fo path r = cBackendToFile fo cr path where cr = render r (fromIntegral width, fromIntegral height) (width,height) = _fo_size 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 fo path ec = void $ renderableToFile fo path (toRenderable (execEC 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 fo cr path = do case (_fo_format fo) of PS -> write C.withPSSurface PDF -> write C.withPDFSurface SVG -> write C.withSVGSurface PNG -> writePNG where write withSurface = do withSurface path (fromIntegral width) (fromIntegral height) $ \result -> do pf <- C.renderWith result $ do pf <- runBackend (defaultEnv vectorAlignmentFns) cr C.showPage return pf C.surfaceFinish result return pf writePNG = C.withImageSurface C.FormatARGB32 width height $ \result -> do pf <- C.renderWith result $ runBackend (defaultEnv bitmapAlignmentFns) cr C.surfaceWriteToPNG result path return pf (width,height) = _fo_size fo -- ----------------------------------------------------------------------- -- Type Conversions: Chart -> Cairo -- ----------------------------------------------------------------------- -- | Convert a charts line join to a cairo line join. convertLineJoin :: G.LineJoin -> C.LineJoin convertLineJoin lj = case lj of G.LineJoinMiter -> C.LineJoinMiter G.LineJoinRound -> C.LineJoinRound G.LineJoinBevel -> C.LineJoinBevel -- | Convert a charts line cap to a cairo line cap. convertLineCap :: G.LineCap -> C.LineCap convertLineCap lc = case lc of G.LineCapRound -> C.LineCapRound G.LineCapButt -> C.LineCapButt G.LineCapSquare -> C.LineCapSquare convertFontSlant :: G.FontSlant -> C.FontSlant convertFontSlant fs = case fs of G.FontSlantItalic -> C.FontSlantItalic G.FontSlantNormal -> C.FontSlantNormal G.FontSlantOblique -> C.FontSlantOblique convertFontWeight :: G.FontWeight -> C.FontWeight convertFontWeight fw = case fw of G.FontWeightBold -> C.FontWeightBold G.FontWeightNormal -> C.FontWeightNormal convertMatrix :: G.Matrix -> CM.Matrix convertMatrix (G.Matrix a1 a2 b1 b2 c1 c2) = CM.Matrix a1 a2 b1 b2 c1 c2 -- ----------------------------------------------------------------------- -- Assorted helper functions in Cairo Usage -- ----------------------------------------------------------------------- setClipRegion :: Rect -> C.Render () setClipRegion (Rect p2 p3) = do C.moveTo (p_x p2) (p_y p2) C.lineTo (p_x p2) (p_y p3) C.lineTo (p_x p3) (p_y p3) C.lineTo (p_x p3) (p_y p2) C.lineTo (p_x p2) (p_y p2) C.clip colourChannel :: (Floating a, Ord a) => AlphaColour a -> Colour a colourChannel c = darken (recip (alphaChannel c)) (c `over` black) setSourceColor :: AlphaColour Double -> C.Render () setSourceColor c = let (RGB r g b) = toSRGB $ colourChannel c in C.setSourceRGBA r g b (alphaChannel 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 a = do C.save v <- a C.restore return v -- -- ----------------------------------------------------------------------- -- -- Cairo Operation Wrappers -- -- ----------------------------------------------------------------------- cTranslate :: Point -> C.Render () cTranslate p = C.translate (p_x p) (p_y p) cLineTo :: Point -> C.Render () cLineTo p = C.lineTo (p_x p) (p_y p) cMoveTo :: Point -> C.Render () cMoveTo p = C.moveTo (p_x p) (p_y p) cArc :: Point -> Double -> Double -> Double -> C.Render () cArc p r a1 a2 = C.arc (p_x p) (p_y p) r a1 a2 cArcNegative :: Point -> Double -> Double -> Double -> C.Render () cArcNegative p r a1 a2 = C.arcNegative (p_x p) (p_y p) r a1 a2 $( makeLenses ''FileOptions ) Chart-cairo-1.8.1/LICENSE0000644000000000000000000000271212472544103013054 0ustar0000000000000000Copyright (c) 2006, Tim Docker All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Chart-cairo-1.8.1/Setup.hs0000644000000000000000000000014712472544103013503 0ustar0000000000000000#!/usr/bin/env runghc module Main where import Distribution.Simple main :: IO () main = defaultMain Chart-cairo-1.8.1/Chart-cairo.cabal0000644000000000000000000000156013005464431015165 0ustar0000000000000000Name: Chart-cairo Version: 1.8.1 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2014 Author: Tim Docker Maintainer: Tim Docker Homepage: https://github.com/timbod7/haskell-chart/wiki Synopsis: Cairo backend for Charts. Description: Cairo backend for Charts. Category: Graphics Cabal-Version: >= 1.6 Build-Type: Simple library Build-depends: base >= 3 && < 5 , old-locale , time, mtl, array , cairo >= 0.9.11 , colour >= 2.2.1 && < 2.4 , data-default-class < 0.2 , operational >= 0.2.2 && < 0.3 , lens >= 3.9 && < 4.16 , Chart >= 1.8.1 && < 1.9 Exposed-modules: Graphics.Rendering.Chart.Backend.Cairo source-repository head type: git location: https://github.com/timbod7/haskell-chart