diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,1 @@ + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 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/diagrams-pdf.cabal b/diagrams-pdf.cabal new file mode 100644 --- /dev/null +++ b/diagrams-pdf.cabal @@ -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 diff --git a/src/Diagrams/Backend/Pdf.hs b/src/Diagrams/Backend/Pdf.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Backend/Pdf.hs @@ -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) + + diff --git a/src/Diagrams/Backend/Pdf/CmdLine.hs b/src/Diagrams/Backend/Pdf/CmdLine.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Backend/Pdf/CmdLine.hs @@ -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))