diagrams-pdf (empty) → 0.1.0.0
raw patch · 7 files changed
+910/−0 lines, 7 filesdep +HPDFdep +basedep +cmdargssetup-changed
Dependencies added: HPDF, base, cmdargs, colour, diagrams-core, diagrams-lib, filepath, monoid-extras, mtl, semigroups, split, vector-space
Files
- CHANGES.md +1/−0
- LICENSE +31/−0
- README.md +92/−0
- Setup.hs +2/−0
- diagrams-pdf.cabal +59/−0
- src/Diagrams/Backend/Pdf.hs +546/−0
- src/Diagrams/Backend/Pdf/CmdLine.hs +179/−0
+ CHANGES.md view
@@ -0,0 +1,1 @@+
+ LICENSE view
@@ -0,0 +1,31 @@++Copyright 2013 alpheccar.org++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.++ * Neither the name of Ryan Yates nor the names of other+ contributors may 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.
+ README.md view
@@ -0,0 +1,92 @@++_diagrams-pdf_ is a an [HPDF] backend for [diagrams]. Diagrams is a powerful,+flexible, declarative domain-specific language for creating vector graphics,+using the [Haskell programming language][haskell].++[diagrams]: http://projects.haskell.org/diagrams/+[haskell]: http://www.haskell.org/haskellwiki/Haskell+[HPDF]: http://hackage.haskell.org/packages/archive/HPDF/1.4.5/doc/html/Graphics-PDF-Documentation.html++_diagrams-pdf_ is a work in progress, and some features are not implemented yet. However, it +is functional enough. ++# Installation++```+cabal update && cabal install diagrams-pdf+```++# Usage++A simple example that uses _diagrams-pdf_ to draw a square.++``` haskell+import Diagrams.Prelude+import Diagrams.Backend.Pdf.CmdLine++b1 = square 20 # lw 0.002++main = defaultMain (pad 1.1 b1)+```++Save this to file named `Square.hs` and compile this program:++```+ghc --make Square.hs+```++This will generate an executable which, when run produces a Pdf file. Run the+executable with the `--help` option to find out more about how to call it.++```+$ ./Square --help+Command-line diagram generation.++Square [OPTIONS]++Common flags:+ -w --width=INT Desired width of the output image (default 400)+ -h --height=INT Desired height of the output image (default 400)+ -o --output=FILE Output file+ -c --compressed Compressed PDF file+ -? --help Display help message+ -V --version Print version information+```++You _must_ pass an output file name with a `.pdf` extension to generate the PDF+file.++```+$ ./Square -o square.pdf+```++# Limitations++Two goals of the HPDF library were : powerful typesetting and no dependence on the OS libraries (for better portability).+But, HPDF was also my first big library mainly done to learn. So I had to limit myself.++As a consequence, HPDF is only using the standard fonts defined in the PDF specification. It is not (yet) possible+to include and use any other fonts.++So, for diagrams it is causing a problem : the face setting has nearly no meaning.+Face is currently selected from the Italic and Oblique settings. Times is the default but when+oblique is chosen, Helvetica is used.++I hope to improve this in future releases.++Here is a list of the fonts in HPDF:++* Helvetica +* Helvetica_Bold +* Helvetica_Oblique +* Helvetica_BoldOblique +* Times_Roman +* Times_Bold +* Times_Italic +* Times_BoldItalic +* Courier +* Courier_Bold +* Courier_Oblique +* Courier_BoldOblique +* Symbol +* ZapfDingbats
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ diagrams-pdf.cabal view
@@ -0,0 +1,59 @@+name: diagrams-pdf+version: 0.1.0.0+synopsis: PDF backend for diagrams drawing EDSL+homepage: http://www.alpheccar.org+license: BSD3+license-file: LICENSE+Extra-source-files: README.md, CHANGES.md+author: alpheccar+maintainer: misc@alpheccar.org+Bug-reports: http://github.com/alpheccar/diagrams-pdf/issues+Stability: Experimental+copyright: 2013, alpheccar.org +category: Graphics+build-type: Simple+Tested-with: GHC == 7.6.3+cabal-version: >=1.10+Description: This package provides a modular backend for rendering+ diagrams created with the diagrams EDSL to PDF+ files. It uses @HPDF@ making it suitable for use on+ any platform.+ .+ It is a very preliminary version where only the+ diagrams Logo generation has been tested.+ .+ The package provides the following modules:+ .+ * "Diagrams.Backend.Pdf.CmdLine" - if you're+ just getting started with diagrams, begin here.+ .+ * "Diagrams.Backend.Pdf" - look at this next.+ The general API for the HPDF backend.+ .+ Additional documentation can be found in the+ README file distributed with the source tarball+Source-repository head+ type: git+ location: http://github.com/alpheccar/diagrams-pdf++library+ Exposed-modules: Diagrams.Backend.Pdf+ Diagrams.Backend.Pdf.CmdLine + -- other-modules: + build-depends: base >= 4.6 && < 4.8,+ mtl >= 2.1 && < 2.2 ,+ monoid-extras >= 0.3 && < 0.4,+ semigroups >= 0.9.2 && < 0.10,+ HPDF >= 1.4.5 && < 1.5,+ vector-space >= 0.8.6 && < 0.9,+ diagrams-lib >= 0.7 && < 0.8,+ diagrams-core >= 0.7 && < 0.8,+ filepath >= 1.3 && < 1.4,+ split >= 0.2.2 && < 0.3,+ cmdargs >= 0.10 && < 0.11,+ colour >= 2.3.3 && < 2.4+ Hs-source-dirs: src++ Ghc-options: -Wall++ Default-language: Haskell2010
+ src/Diagrams/Backend/Pdf.hs view
@@ -0,0 +1,546 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Pdf+-- Copyright : (c) 2013 alpheccar.org (see LICENSE)+-- License : BSD-style (see LICENSE)+--+-- A Pdf rendering backend for diagrams.+--+-- To build diagrams for Pdf rendering use the @Pdf@+-- type in the diagram type construction+--+-- > d :: Diagram Pdf R2+-- > d = ...+--+-- and render giving the @Pdf@ token+--+-- > renderDia Pdf (PdfOptions (Width 400)) d+--+-- This IO action will write the specified file.+--+-----------------------------------------------------------------------------+module Diagrams.Backend.Pdf++ ( -- * Backend token+ Pdf(..)+ , Options(..)+ , sizeFromSpec+ ) where+++import Graphics.PDF hiding(transform,Style,translate,scale)+import qualified Graphics.PDF as P++import Diagrams.Prelude++import Diagrams.TwoD.Text++import Data.Maybe (catMaybes)+++import qualified Data.Foldable as F+import Data.Monoid.Split+import Data.Typeable+import qualified Control.Monad.State.Strict as S+import Control.Monad.Trans(lift)+import Diagrams.TwoD.Path+import Control.Monad(when)++-- | This data declaration is simply used as a token to distinguish this rendering engine.+data Pdf = Pdf+ deriving (Eq,Ord,Read,Show,Typeable)++{-+ +For a future release to support some specific HPDF features++-}+{-+data LabelStyle = LabelStyle Int Justification P.Orientation ++data TextBox = TextBox T2 Double Double LabelStyle String++type instance V TextBox = R2++instance Transformable TextBox where+ transform t (TextBox tt w h a s) = TextBox (t <> tt) w h a s++instance IsPrim TextBox++instance HasOrigin TextBox where+ moveOriginTo p = translate (origin .-. p)++instance Renderable TextBox NullBackend where+ render _ _ = mempty++pdfText :: (Renderable TextBox b) + => LabelStyle + -> String + -> Double + -> Double + -> Diagram b R2+pdfText ls s w h = mkQD (Prim (TextBox mempty w h ls s))+ (getEnvelope r)+ (getTrace r)+ mempty+ (Query $ \p -> Any (isInsideEvenOdd p r))++ where r :: Path R2+ r = rect w h++drawStringLabel :: LabelStyle + -> String + -> PDFFloat + -> PDFFloat + -> PDFFloat + -> PDFFloat + -> Draw () +drawStringLabel (LabelStyle fs j o) s x y w h = do+ let (r,b) = drawTextBox x y w h o NormalParagraph (P.Font (PDFFont Times_Roman fs) P.black P.black) $ do+ setJustification j+ paragraph $ do+ txt $ s+ b++instance Renderable TextBox Pdf where+ render _ (TextBox t w h ls text) = D $ do+ let r :: Path R2+ r = rect w h + r' = transform t r + b = boundingBox r' + corners = getCorners b + case corners of + Just (a,b) -> do + let (xa,ya) = unp2 a + (xb,yb) = unp2 b+ drawM $ P.stroke $ Rectangle (xa :+ ya) (xb :+ yb) + drawM (drawStringLabel ls text xa ya (xb-xa) (yb-ya)) + Nothing -> return() +-}++{-+ +End of the specific part++-}++-- | The drawing state+-- I should give a name to the different fields and use lens+-- The first three parameters are for the font+-- The P.Point is because the PDF specification is using absolute+-- coordinates but relative coordinates are needed for diagrams.+-- So the last point is tracked here.+-- The last bools are to disable fill and stroke.+-- Fill is disabled when transparency is total (color transparency and not diagram transparency)+-- Stroke is disabled when line width is 0 because in the PDF specification+-- line width 0 means the smallest width and something is displayed.+data DrawingState = DrawingState FontSlant FontWeight Int FillRule P.Point Bool Bool++-- | The stack of drawing state+data StateStack = StateStack { _current :: DrawingState+ , _last :: [DrawingState]+ }++defaultFontSize :: Num a => a+defaultFontSize = 1 ++-- | Initial drawing state+initState :: StateStack+initState = StateStack (DrawingState FontSlantNormal FontWeightNormal 1 Winding (0 :+ 0) False True) []+++-- | The drawing monad with state+newtype DrawS a = DS (S.StateT StateStack Draw a) deriving(Monad,S.MonadState StateStack)++-- | List a Draw value into the DrawS monad+drawM :: Draw a -> DrawS a+drawM = DS . lift+++-- | Get the MonadState wrapped in DS+unDS :: DrawS t -> S.StateT StateStack Draw t+unDS (DS r) = r ++-- | Get the Draw value from an initial state+runDS :: DrawS a -> Draw a+runDS d = S.evalStateT (unDS d) initState++-- | Generate an HPDF font+mkFont :: DrawingState -> PDFFont +mkFont (DrawingState FontSlantNormal FontWeightNormal s _ _ _ _) = PDFFont Times_Roman s+mkFont (DrawingState FontSlantNormal FontWeightBold s _ _ _ _) = PDFFont Times_Bold s+mkFont (DrawingState FontSlantItalic FontWeightNormal s _ _ _ _) = PDFFont Times_Italic s+mkFont (DrawingState FontSlantItalic FontWeightBold s _ _ _ _) = PDFFont Times_BoldItalic s+mkFont (DrawingState FontSlantOblique FontWeightNormal s _ _ _ _) = PDFFont Helvetica_Oblique s+mkFont (DrawingState FontSlantOblique FontWeightBold s _ _ _ _) = PDFFont Helvetica_BoldOblique s++++setFontSize :: Double -> DrawS ()+setFontSize fs = do + let s = floor fs+ StateStack (DrawingState fsl fw _ wr p f st) l <- S.get + S.put $! StateStack (DrawingState fsl fw s wr p f st) l++setFontWeight :: FontWeight -> DrawS ()+setFontWeight w = do + StateStack (DrawingState fsl _ fs wr p f st) l <- S.get + S.put $! StateStack (DrawingState fsl w fs wr p f st) l+ ++setFontSlant :: FontSlant -> DrawS ()+setFontSlant sl = do + StateStack (DrawingState _ fw fs wr p f st) l <- S.get + S.put $! StateStack (DrawingState sl fw fs wr p f st) l+ +setFillRule :: FillRule -> DrawS ()+setFillRule wr = do + StateStack (DrawingState sl fw fs _ p f st) l <- S.get + S.put $! StateStack (DrawingState sl fw fs wr p f st) l++savePoint :: P.Point -> DrawS () +savePoint p = do + StateStack (DrawingState sl fw fs wr _ f st) l <- S.get + S.put $! StateStack (DrawingState sl fw fs wr p f st) l++currentPoint :: DrawS P.Point +currentPoint = do + StateStack (DrawingState _ _ _ _ p _ _) _ <- S.get + return p ++getFillState :: DrawS FillRule +getFillState = do + StateStack (DrawingState _ _ _ w _ _ _) _ <- S.get + return w++mustFill :: DrawS Bool +mustFill = do+ StateStack (DrawingState _ _ _ _ _ b _) _ <- S.get + return b++-- | From the alpha value of a fill color, we check if the filling must be disabled+setFillingColor :: Double -> DrawS() +setFillingColor alpha = do + let b | alpha /= 0.0 = True + | otherwise = False+ StateStack (DrawingState fsl w fs wr p _ st) l <- S.get + S.put $! StateStack (DrawingState fsl w fs wr p b st) l++mustStroke :: DrawS Bool+mustStroke = do + StateStack (DrawingState _ _ _ _ _ _ b) _ <- S.get + return b++-- | From the linew width we check if stroke must be disabled+setTrokeState :: Double -> DrawS () +setTrokeState w = do + let st | w == 0 = False + | otherwise = True+ StateStack (DrawingState fsl fw fs wr p b _) l <- S.get + S.put $! StateStack (DrawingState fsl fw fs wr p b st) l+++-- | Initial settings before rendering the diagram+setTranform :: Draw () -> Draw ()+setTranform d = do+ P.fillColor P.white + P.strokeColor P.black+ P.setWidth 0.1+ d++instance Backend Pdf R2 where+ data Render Pdf R2 = D (DrawS ())+ type Result Pdf R2 = Draw ()+ data Options Pdf R2 = PdfOptions {+ pdfsizeSpec :: SizeSpec2D+ } deriving(Show)+ + -- There is something I don't understand here with the frozen style.+ -- On the tests it is working but I would not have put+ -- the calls in this order ... so it must be checked later + withStyle _ s t (D r) = D $ do+ withContext $ do+ pdfMiscStyle s+ pdfFrozenStyle s+ pdfTransf t+ fs <- getFillState+ mf <- mustFill+ ms <- mustStroke + -- Set the clip region into a new PDF context+ -- since it is the only way to restore the old clip region+ -- (by popping the PDF stack of contexts)+ withClip s $ do+ when (mf || ms) r+ + -- Set the diagram opacity in a new PDF context+ withPdfOpacity s $ do+ case (ms,mf,fs) of + (True,True,Winding) -> drawM (P.fillAndStrokePath)+ (True,True,EvenOdd) -> drawM (P.fillAndStrokePathEO)+ (False,True,Winding) -> drawM (P.fillPath)+ (False,True,EvenOdd) -> drawM (P.fillPathEO)+ (True,False,_) -> drawM (P.strokePath) + (False,False,_) -> return ()+ ++ doRender _ _ (D r) = setTranform (runDS r)++ renderDia Pdf opts d =+ doRender Pdf opts' . mconcat . map renderOne . prims $ d'+ where (opts', d') = adjustDia Pdf opts d+ renderOne :: (Prim Pdf R2, (Split (Transformation R2), Style R2))+ -> Render Pdf R2+ renderOne (p, (M t, s))+ = withStyle Pdf s mempty (render Pdf (transform t p))++ renderOne (p, (t1 :| t2, s))+ -- Here is the difference from the default+ -- implementation: "t2" instead of "t1 <> t2".+ = withStyle Pdf s t1 (render Pdf (transform t2 p))++instance Monoid (Render Pdf R2) where+ mempty = D (return ())+ (D a) `mappend` (D b) = D (a >> b)++sizeFromSpec :: SizeSpec2D -> (Double,Double) +sizeFromSpec size = case size of+ Width w' -> (w',w')+ Height h' -> (h',h')+ Dims w' h' -> (w',h')+ Absolute -> (200,200)++-- | Relative lineto+relativeLine :: P.Point -> DrawS ()+relativeLine p = do + c <- currentPoint + let c' = p + c+ drawM (lineto c')+ savePoint c'++-- | Relative curveto+relativeCurveTo :: P.Point -> P.Point -> P.Point -> DrawS () +relativeCurveTo x y z = do + c <- currentPoint + let x' = x + c + y' = y + c + z' = z + c + drawM (curveto x' y' z')+ savePoint z'++-- | moveto but with saving of the point+moveToAndSave :: P.Point -> DrawS () +moveToAndSave p = do + drawM (moveto p)+ savePoint p++-- | Convenience functions+renderC :: (Renderable a Pdf, V a ~ R2) => a -> DrawS ()+renderC a = case render Pdf a of D r -> r++{-+push :: DrawS()+push = do + StateStack c l <- S.get + S.put $! (StateStack c (c:l))++pop :: DrawS()+pop = do + StateStack _ l <- S.get + S.put $! (StateStack (head l) (tail l))+-}++-- | With a new context do something+-- It is a bit comlex because the withNewContext from the HPDF library+-- must be used to push / pop a new PDF context+withContext :: DrawS a -> DrawS a+withContext d = do + s <- S.get+ let d' = S.evalStateT (unDS d) s+ a <- drawM (withNewContext d') + return a++++pdfFillColor :: (Real b, Floating b) => AlphaColour b -> DrawS ()+pdfFillColor c = do+ let (r,g,b,a) = colorToSRGBA c+ drawM $ do+ P.setFillAlpha a+ P.fillColor (Rgb r g b)+ setFillingColor a++pdfStrokeColor :: (Real b, Floating b) => AlphaColour b -> DrawS ()+pdfStrokeColor c = drawM $ do+ let (r,g,b,a) = colorToSRGBA c+ P.setStrokeAlpha a+ P.strokeColor (Rgb r g b)++{-++Conversions between diagrams and HPDF types+ +-}++pdfLineJoin :: LineJoin -> P.JoinStyle+pdfLineJoin LineJoinMiter = MiterJoin+pdfLineJoin LineJoinRound = RoundJoin+pdfLineJoin LineJoinBevel = BevelJoin++pdfLineCap :: LineCap -> P.CapStyle +pdfLineCap LineCapButt = ButtCap +pdfLineCap LineCapRound = RoundCap+pdfLineCap LineCapSquare = SquareCap++pdfDashing :: Dashing -> DashPattern +pdfDashing (Dashing l a) = DashPattern l a++{-++Opacity and clip attributes must be handled separately from the other+attributes++-}++withPdfOpacity :: Style v -> DrawS a -> DrawS a +withPdfOpacity s m = do + let mo = handle s getOpacity+ case mo of + Nothing -> m + Just d -> do + withContext $ do + drawM (setStrokeAlpha d >> setFillAlpha d) + m++ where handle :: AttributeClass a => Style v -> (a -> b) -> Maybe b+ handle st f = f `fmap` getAttr st++withClip :: Style v -> DrawS () -> DrawS ()+withClip s m = do + let d = handle s m clip+ case d of + Just r -> r + Nothing -> m++ where handle :: AttributeClass a => Style v -> DrawS () -> (DrawS () -> a -> b) -> Maybe b+ handle st dm f = f dm `fmap` getAttr st+ clip dm = clipPath dm . getClip+ addPathToClip p = do + renderC p + f <- getFillState + case f of + Winding -> drawM (setAsClipPath)+ EvenOdd -> drawM (setAsClipPathEO)+ clipPath dm p = do + withContext $ do + mapM_ addPathToClip p + dm+++pdfMiscStyle :: Style v -> DrawS ()+pdfMiscStyle s = do+ sequence_ . catMaybes $ [ handle fSlant+ , handle fWeight+ , handle fSize+ , handle fColor+ , handle lColor+ , handle lFillRule+ , handle checklWidth+ ]+ where handle :: AttributeClass a => (a -> DrawS ()) -> Maybe (DrawS ())+ handle f = f `fmap` getAttr s+ fSize = setFontSize . getFontSize+ --fFace = const (return ())+ fSlant = setFontSlant . getFontSlant+ fWeight = setFontWeight . getFontWeight+ lColor c = pdfStrokeColor . toAlphaColour . getLineColor $ c+ fColor c = pdfFillColor . toAlphaColour . getFillColor $ c+ lFillRule = setFillRule . getFillRule+ checklWidth w = do + let d = getLineWidth w+ setTrokeState d++pdfFrozenStyle :: Style v -> DrawS ()+pdfFrozenStyle s = sequence_ -- foldr (>>) (return ())+ . catMaybes $ [ handle lWidth+ , handle lJoin+ , handle lCap+ , handle lDashing+ ]+ where handle :: (AttributeClass a) => (a -> DrawS ()) -> Maybe (DrawS ())+ handle f = f `fmap` getAttr s+ lWidth w = do + let d = getLineWidth w+ drawM . setWidth $ d+ setTrokeState d+ lCap = drawM . setLineCap . pdfLineCap . getLineCap+ lJoin = drawM . setLineJoin . pdfLineJoin . getLineJoin+ lDashing = drawM . setDash . pdfDashing . getDashing+ +unR :: R2 -> Complex Double+unR r = let (x,y) = unr2 r+ in (x :+ y)++unP :: P2 -> Complex Double+unP r = let (x,y) = unp2 r+ in (x :+ y)+++pdfTransf :: Transformation R2 -> DrawS ()+pdfTransf t = drawM $ applyMatrix (Matrix a1 a2 b1 b2 c1 c2)+ where (a1,a2) = unr2 $ apply t unitX+ (b1,b2) = unr2 $ apply t unitY+ (c1,c2) = unr2 $ transl t++instance Renderable (Segment Closed R2) Pdf where+ render _ (Linear (OffsetClosed (unR -> v))) = D $ relativeLine v+ render _ (Cubic (unR -> po1)+ (unR -> po2)+ (OffsetClosed (unR -> po3)))+ = D $ relativeCurveTo po1 po2 po3++instance Renderable (Trail R2) Pdf where+ render _ t = D . flip withLine t $ renderT . lineSegments+ where+ renderT segs =+ do+ mapM_ renderC segs+ when (isLoop t) (drawM closePath)++instance Renderable (Path R2) Pdf where+ render _ (Path t) = D $ do+ F.mapM_ renderTrail t+ where renderTrail (viewLoc -> (unP -> p, tr)) = do+ moveToAndSave p+ renderC tr++instance Renderable Text Pdf where+ render _ (Text tr al str) = + D $ withContext $ do+ StateStack f _ <- S.get + let theFont = mkFont f+ tw = textWidth theFont (toPDFString str) + descent = getDescent theFont + fontHeight = getHeight theFont + (x,y) = case al of+ BoxAlignedText xt yt -> (xt,yt)+ BaselineText -> (0,0)+ x' = - tw * x + y' = - (fontHeight - descent) * y+ pdfTransf tr+ withContext . drawM $ do+ P.applyMatrix (P.scale (1.0 / defaultFontSize) (1.0 / defaultFontSize))+ P.applyMatrix (P.translate (x' :+ y'))+ P.drawText $ P.text theFont 0 0 (toPDFString str)+ +
+ src/Diagrams/Backend/Pdf/CmdLine.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE DeriveDataTypeable, NoMonomorphismRestriction #-}+-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Pdf.CmdLine+-- Copyright : (c) 2013 alpheccar.org (see LICENSE)+-- License : BSD-style (see LICENSE)+--+-- Convenient creation of command-line-driven executables for+-- rendering diagrams using the Pdf backend.+--+-- * 'defaultMain' creates an executable which can render a single+-- diagram at various options.+--+-----------------------------------------------------------------------------++module Diagrams.Backend.Pdf.CmdLine+ ( defaultMain+ , multipleMain+ , renderDia'+ , Pdf+ ) where++import Diagrams.Prelude hiding (width, height, interval)+import Diagrams.Backend.Pdf++import System.Console.CmdArgs.Implicit hiding (args)++import Prelude++import Data.List.Split++import System.Environment (getProgName)+import qualified Graphics.PDF as P++data DiagramOpts = DiagramOpts+ { width :: Maybe Int+ , height :: Maybe Int+ , output :: FilePath+ , compressed :: Maybe Bool+ , author :: Maybe String+ }+ deriving (Show, Data, Typeable)++diagramOpts :: String -> DiagramOpts+diagramOpts prog = DiagramOpts+ { width = def+ &= typ "INT"+ &= help "Desired width of the output image (default 400)"++ , height = def+ &= typ "INT"+ &= help "Desired height of the output image (default 400)"++ , output = def+ &= typFile+ &= help "Output file"++ , compressed = def+ &= typ "BOOL"+ &= help "Compressed PDF file"+ , author = def + &= typ "STRING"+ &= help "Author of the document"+ }+ &= summary "Command-line diagram generation."+ &= program prog++-- | This is the simplest way to render diagrams, and is intended to+-- be used like so:+--+-- > ... other definitions ...+-- > myDiagram = ...+-- >+-- > main = defaultMain myDiagram+--+-- Compiling a source file like the above example will result in an+-- executable which takes command-line options for setting the size,+-- output file, and so on, and renders @myDiagram@ with the+-- specified options.+--+-- Pass @--help@ to the generated executable to see all available+-- options. Currently it looks something like+--+-- @+-- Command-line diagram generation.+--+-- Foo [OPTIONS]+-- +-- Common flags:+-- -w --width=INT Desired width of the output image (default 400)+-- -h --height=INT Desired height of the output image (default 400)+-- -o --output=FILE Output file+-- -c --compressed Compressed PDF file+-- -? --help Display help message+-- -V --version Print version information+-- @+--+-- For example, a couple common scenarios include+--+-- @+-- $ ghc --make MyDiagram+--+-- # output image.eps with a width of 400pt (and auto-determined height)+-- $ ./MyDiagram --compressed -o image.pdf -w 400+-- @++defaultMain :: Diagram Pdf R2 -> IO ()+defaultMain d = do+ prog <- getProgName+ opts <- cmdArgs (diagramOpts prog)+ let sizeSpec = case (width opts, height opts) of+ (Nothing, Nothing) -> Absolute+ (Just wi, Nothing) -> Width (fromIntegral wi)+ (Nothing, Just he) -> Height (fromIntegral he)+ (Just wi, Just he) -> Dims (fromIntegral wi)+ (fromIntegral he)+ (w,h) = sizeFromSpec sizeSpec+ theAuthor = maybe "diagrams-pdf" id (author opts)+ compression = maybe False id (compressed opts)+ docRect = P.PDFRect 0 0 (floor w) (floor h)+ pdfOpts = PdfOptions sizeSpec+ ifCanRender opts $ do + P.runPdf (output opts) + (P.standardDocInfo { P.author=P.toPDFString theAuthor, P.compressed = compression}) docRect $ do+ page1 <- P.addPage Nothing+ P.drawWithPage page1 $ renderDia' d pdfOpts++-- | Generate a multipage PDF document from several diagrams.+-- Each diagram is scaled to the page size+multipleMain :: [Diagram Pdf R2] -> IO ()+multipleMain d = do+ prog <- getProgName+ opts <- cmdArgs (diagramOpts prog)+ let sizeSpec = case (width opts, height opts) of+ (Nothing, Nothing) -> Absolute+ (Just wi, Nothing) -> Width (fromIntegral wi)+ (Nothing, Just he) -> Height (fromIntegral he)+ (Just wi, Just he) -> Dims (fromIntegral wi)+ (fromIntegral he)+ (w,h) = sizeFromSpec sizeSpec+ theAuthor = maybe "diagrams-pdf" id (author opts)+ compression = maybe False id (compressed opts)+ docRect = P.PDFRect 0 0 (floor w) (floor h)+ pdfOpts = PdfOptions sizeSpec+ createPage aDiag = do + page1 <- P.addPage Nothing+ P.drawWithPage page1 $ renderDia' aDiag pdfOpts+ ifCanRender opts $ do + P.runPdf (output opts) + (P.standardDocInfo { P.author=P.toPDFString theAuthor, P.compressed = compression}) docRect $ do+ mapM_ createPage d+ +++ifCanRender :: DiagramOpts -> IO () -> IO ()+ifCanRender opts action =+ case splitOn "." (output opts) of+ [""] -> putStrLn "No output file given."+ ps | last ps `elem` ["pdf"] -> action+ | otherwise -> putStrLn $ "Unknown file type: " ++ last ps++renderDia' :: Diagram Pdf R2 -- ^ Diagram to be rendered+ -> Options Pdf R2 -- ^ PDF Options+ -> P.Draw () -- ^ Draw monad to include in a PDF document+renderDia' diag opts = do+ let bd = boundingBox diag+ (w,h) = sizeFromSpec (pdfsizeSpec opts)+ rescaledD (Just (ll,ur)) =+ let v = r2 . unp2 $ centroid [ll,ur]+ (xa,ya) = unp2 ll + (xb,yb) = unp2 ur + ps = max (abs (xb - xa)) (abs (yb - ya))+ sx = w / ps+ sy = h / ps+ pageCenter = r2 (w / 2.0, h/2.0)+ in+ translate pageCenter . scaleX sx . scaleY sy . translate (-v) $ diag+ rescaledD Nothing = diag+ renderDia Pdf opts (rescaledD (getCorners bd))