craftwerk-cairo (empty) → 0.1
raw patch · 4 files changed
+216/−0 lines, 4 filesdep +basedep +cairodep +craftwerksetup-changed
Dependencies added: base, cairo, craftwerk, mtl
Files
- LICENSE +19/−0
- Setup.hs +2/−0
- craftwerk-cairo.cabal +43/−0
- src/Graphics/Craftwerk/Core/Driver/Cairo.hs +152/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2011 Malte Harder++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ craftwerk-cairo.cabal view
@@ -0,0 +1,43 @@+Name: craftwerk-cairo+Version: 0.1+License: MIT+License-file: LICENSE+Author: Malte Harder <malte.harder@gmail.com>+Maintainer: Malte Harder <malte.harder@gmail.com>+Category: Graphics+Homepage: http://mahrz.github.com/craftwerk.html+Synopsis: Cairo backend for Craftwerk.+Description: Cairo backend for Craftwerk, a high-level and easy to use graphics library+ with integrated TikZ output.+ . + Craftwerk is a high-level 2D vector graphics library for output of+ TikZ pictures that can be typeset using (pdf)LaTeX. The TikZ library+ and documentation can be found at: <http://sourceforge.net/projects/pgf>.+ . + Craftwerk tries to encapsulate the graphics backend such that figures+ can also be rendered with a Cairo backend and quickly displayed in a+ Gtk window. The aim is to support TikZ and Cairo seamlessly as+ possible, meaning that graphics produced with either backend should+ look as similar as possible. Other backends are easily written and the+ aim is to provide generic fallback functions for features that are not+ natively supported by some backend.++Stability: experimental+Build-Type: Simple+Cabal-Version: >=1.8++Extra-Source-Files: LICENSE++Library+ Hs-Source-Dirs: src+ Build-Depends: base >= 3 && < 5,+ mtl,+ cairo >= 0.11.1 && < 0.13,+ craftwerk >= 0.1 && < 0.2+ Exposed-Modules: Graphics.Craftwerk.Core.Driver.Cairo++source-repository head+ type: git+ location: git://github.com/mahrz/Craftwerk.git++
+ src/Graphics/Craftwerk/Core/Driver/Cairo.hs view
@@ -0,0 +1,152 @@+-- |+-- Module : Craftwerk.Core.Driver.Cairo+-- Copyright : (c) Malte Harder 2011+-- License : MIT+-- Maintainer : Malte Harder <malte.harder@gmail.com>+--+-- Renders a craftwerk 'Figure' into a 'Cairo.Render' render context.++module Graphics.Craftwerk.Core.Driver.Cairo (+ -- * Cairo rendering+ figureToRenderContext+ )where++import Graphics.Craftwerk.Core.Figure+import Graphics.Craftwerk.Core.Color+import Graphics.Craftwerk.Core.Style++import Graphics.Craftwerk.Core.Driver.Generic++import qualified Graphics.Rendering.Cairo as Cairo+import Graphics.Rendering.Cairo (Matrix)+import qualified Graphics.Rendering.Cairo.Matrix as Matrix++import Control.Monad+import Control.Monad.Reader++data Context = Context { styleP :: StyleProperties+ , strokeMatrix :: Matrix+ , noDecorations :: Bool+ }++type Render a = ReaderT Context Cairo.Render a++-- | Render a Craftwerk 'Figure' within a 'Cairo.Render' context+figureToRenderContext :: Figure -> Cairo.Render ()+figureToRenderContext f = do+ strokeMatrix <- Cairo.getMatrix+ runReaderT (figureToRenderContextWithStyle f)+ Context { styleP = defaultStyle+ , strokeMatrix = strokeMatrix+ , noDecorations = False+ }++figureToRenderContextWithStyle Blank = return ()+figureToRenderContextWithStyle (Style ns a) =+ local (\c -> c { styleP = mergeProperties (styleP c) ns}) $+ figureToRenderContextWithStyle a++figureToRenderContextWithStyle (Transform t a) = do+ lift $ Cairo.save >>+ case t of+ Rotate r -> Cairo.rotate (radians r)+ Scale p -> fnC Cairo.scale p+ Translate p -> fnC Cairo.translate p+ figureToRenderContextWithStyle a+ lift Cairo.restore++figureToRenderContextWithStyle (Canvas t a) =+ local (\c -> c { strokeMatrix = transformationMatrix t (strokeMatrix c)+ }) $ figureToRenderContextWithStyle (Transform t a)++figureToRenderContextWithStyle (Composition a) =+ mapM_ figureToRenderContextWithStyle a++figureToRenderContextWithStyle (NoDecorations a) =+ local (\c -> c { noDecorations = True+ }) $ figureToRenderContextWithStyle a++figureToRenderContextWithStyle (Path a) = ask >>= \c ->+ let sp = getProperty $ styleP c+ in do lift $ do when (sp clip) (do cairoPath a sp+ Cairo.clip)+ when (sp fill && not (sp clip))+ (do cairoSetColor (sp fillColor)+ cairoPath a sp+ Cairo.fill)+ when (sp stroke && not (sp clip))+ (do cairoSetColor (sp lineColor)+ cairoSetLineJoin (sp lineJoin)+ cairoSetLineCap (sp lineCap)+ Cairo.setMiterLimit (sp miterLimit)+ Cairo.setDash (sp dashes) (sp dashPhase)+ cairoPath a sp+ Cairo.setLineWidth (sp lineWidth)+ Cairo.save+ Cairo.setMatrix (strokeMatrix c)+ Cairo.stroke+ Cairo.restore)+ -- Avoid running into a deadlock when rendering arrow tips+ unless (noDecorations c)+ (figureToRenderContextWithStyle $ + arrowTipsForPath a (sp lineWidth) (sp arrowTips))+++figureToRenderContextWithStyle (Text a) = lift $ Cairo.textPath a >> Cairo.fill++figureToRenderContextWithStyle other =+ figureToRenderContextWithStyle (genericFigure other)++-- Helper functions++fnC :: (Double -> Double -> c) -> (Double, Double) -> c+fnC = uncurry++cairoSetColor color =+ let rgb = toSRGB color+ in Cairo.setSourceRGB (channelRed rgb)+ (channelGreen rgb)+ (channelBlue rgb)+++cairoSetLineJoin lj =+ Cairo.setLineJoin (case lj of+ JoinRound -> Cairo.LineJoinRound+ JoinBevel -> Cairo.LineJoinBevel+ JoinMiter -> Cairo.LineJoinMiter)+++cairoSetLineCap lc =+ Cairo.setLineCap (case lc of+ CapRect -> Cairo.LineCapSquare+ CapButt -> Cairo.LineCapButt+ CapRound -> Cairo.LineCapRound)++cairoPath a sp = do mapM_ cairoSegment a+ when (sp closePath) Cairo.closePath++cairoSegment (MoveTo p) = fnC Cairo.moveTo p+cairoSegment (LineSegment p) = fnC Cairo.lineTo p+cairoSegment (ArcSegment (x,y) sa ea r) =+ if sa > ea then+ Cairo.arcNegative (x-r*cos(radians sa)) (y-r*sin(radians sa))+ r (radians sa) (radians ea)+ else+ Cairo.arc (x-r*cos(radians sa)) (y-r*sin(radians sa))+ r (radians sa) (radians ea)+cairoSegment (CurveSegment (px,py) (c1x,c1y) (c2x,c2y)) =+ Cairo.curveTo+ c1x+ c1y+ c2x+ c2y+ px+ py+++transformationMatrix t m = case t of+ Rotate r ->+ Matrix.rotate (radians r) m+ Scale p -> fnC Matrix.scale p m+ Translate p -> fnC Matrix.translate p m+