diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/craftwerk-cairo.cabal b/craftwerk-cairo.cabal new file mode 100644 --- /dev/null +++ b/craftwerk-cairo.cabal @@ -0,0 +1,43 @@ +Name: craftwerk-cairo +Version: 0.1 +License: MIT +License-file: LICENSE +Author: Malte Harder +Maintainer: Malte Harder +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: . + . + 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 + + diff --git a/src/Graphics/Craftwerk/Core/Driver/Cairo.hs b/src/Graphics/Craftwerk/Core/Driver/Cairo.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Craftwerk/Core/Driver/Cairo.hs @@ -0,0 +1,152 @@ +-- | +-- Module : Craftwerk.Core.Driver.Cairo +-- Copyright : (c) Malte Harder 2011 +-- License : MIT +-- Maintainer : Malte Harder +-- +-- 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 +