diagrams-pdf 0.1.0.0 → 0.2.0
raw patch · 3 files changed
+101/−67 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Diagrams.Backend.Pdf.CmdLine: renderDia' :: Diagram Pdf R2 -> Options Pdf R2 -> Draw ()
Files
- diagrams-pdf.cabal +1/−1
- src/Diagrams/Backend/Pdf.hs +98/−45
- src/Diagrams/Backend/Pdf/CmdLine.hs +2/−21
diagrams-pdf.cabal view
@@ -1,5 +1,5 @@ name: diagrams-pdf-version: 0.1.0.0+version: 0.2.0 synopsis: PDF backend for diagrams drawing EDSL homepage: http://www.alpheccar.org license: BSD3
src/Diagrams/Backend/Pdf.hs view
@@ -145,7 +145,15 @@ -- 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+data DrawingState = DrawingState { _fontSlant :: FontSlant+ , _fontWeight :: FontWeight+ , _fontSize :: Int+ , _fillRule :: FillRule + , _currentPoint :: P.Point + , _mustFill :: Bool+ , _mustStroke :: Bool+ , _isloop :: Bool+ } -- | The stack of drawing state data StateStack = StateStack { _current :: DrawingState@@ -155,9 +163,15 @@ defaultFontSize :: Num a => a defaultFontSize = 1 +diagramDefaultUnit :: Fractional a => a +diagramDefaultUnit = 0.01 ++defaultWidth :: Fractional a => a +defaultWidth = 0.01+ -- | Initial drawing state initState :: StateStack-initState = StateStack (DrawingState FontSlantNormal FontWeightNormal 1 Winding (0 :+ 0) False True) []+initState = StateStack (DrawingState FontSlantNormal FontWeightNormal 1 Winding (0 :+ 0) False True False) [] -- | The drawing monad with state@@ -178,55 +192,55 @@ -- | 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+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+ StateStack (DrawingState fsl fw _ wr p f st ilp) l <- S.get + S.put $! StateStack (DrawingState fsl fw s wr p f st ilp) 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+ StateStack (DrawingState fsl _ fs wr p f st ilp) l <- S.get + S.put $! StateStack (DrawingState fsl w fs wr p f st ilp) 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+ StateStack (DrawingState _ fw fs wr p f st ilp) l <- S.get + S.put $! StateStack (DrawingState sl fw fs wr p f st ilp) 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+ StateStack (DrawingState sl fw fs _ p f st ilp) l <- S.get + S.put $! StateStack (DrawingState sl fw fs wr p f st ilp) 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+ StateStack (DrawingState sl fw fs wr _ f st ilp) l <- S.get + S.put $! StateStack (DrawingState sl fw fs wr p f st ilp) l currentPoint :: DrawS P.Point currentPoint = do - StateStack (DrawingState _ _ _ _ p _ _) _ <- S.get + StateStack (DrawingState _ _ _ _ p _ _ _) _ <- S.get return p getFillState :: DrawS FillRule getFillState = do - StateStack (DrawingState _ _ _ w _ _ _) _ <- S.get + StateStack (DrawingState _ _ _ w _ _ _ _) _ <- S.get return w mustFill :: DrawS Bool mustFill = do- StateStack (DrawingState _ _ _ _ _ b _) _ <- S.get + StateStack (DrawingState _ _ _ _ _ b _ _) _ <- S.get return b -- | From the alpha value of a fill color, we check if the filling must be disabled@@ -234,12 +248,12 @@ 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+ StateStack (DrawingState fsl w fs wr p _ st ilp) l <- S.get + S.put $! StateStack (DrawingState fsl w fs wr p b st ilp) l mustStroke :: DrawS Bool mustStroke = do - StateStack (DrawingState _ _ _ _ _ _ b) _ <- S.get + StateStack (DrawingState _ _ _ _ _ _ b _) _ <- S.get return b -- | From the linew width we check if stroke must be disabled@@ -247,18 +261,43 @@ 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+ StateStack (DrawingState fsl fw fs wr p b _ ilp) l <- S.get + S.put $! StateStack (DrawingState fsl fw fs wr p b st ilp) l +isALoop :: DrawS Bool +isALoop = do + StateStack s _ <- S.get+ return $ _isloop s +setLoop :: Bool -> DrawS () +setLoop b = do + StateStack s l <- S.get+ S.put $! StateStack (s {_isloop = b}) 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+ P.setWidth defaultWidth d +strokeOrFill :: DrawS () +strokeOrFill = do + mf <- mustFill+ ms <- mustStroke + fs <- getFillState+ isloop <- isALoop+ -- Set the diagram opacity in a new PDF context+ case (ms,mf,fs,isloop) of + (True,True,Winding,True) -> drawM (P.fillAndStrokePath)+ (True,True,EvenOdd,True) -> drawM (P.fillAndStrokePathEO)+ (False,True,Winding,True) -> drawM (P.fillPath)+ (False,True,EvenOdd,True) -> drawM (P.fillPathEO)+ (True,_,_,_) -> drawM (P.strokePath) + (_,_,_,_) -> return ()+ setLoop True+ instance Backend Pdf R2 where data Render Pdf R2 = D (DrawS ()) type Result Pdf R2 = Draw ()@@ -272,32 +311,23 @@ 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)+ pdfTransf t 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 ()- + pdfFrozenStyle s+ when (mf || ms) $ do + withPdfOpacity s $ do+ r+ strokeOrFill doRender _ _ (D r) = setTranform (runDS r) renderDia Pdf opts d =- doRender Pdf opts' . mconcat . map renderOne . prims $ d'+ centerAndScale 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@@ -308,6 +338,26 @@ -- Here is the difference from the default -- implementation: "t2" instead of "t1 <> t2". = withStyle Pdf s t1 (render Pdf (transform t2 p))+ centerAndScale opts diag renderedDiagram = do+ let bd = boundingBox diag+ (w,h) = sizeFromSpec (pdfsizeSpec opts)+ rescaledD (Just (ll,ur)) =+ let (vx,vy) = 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 = (w / 2.0) P.:+ (h/2.0)+ in+ do+ P.applyMatrix (P.translate pageCenter) + P.applyMatrix (P.scale sx sy)+ P.applyMatrix (P.translate $ (-vx) P.:+ (-vy))+ rescaledD Nothing = return ()+ rescaledD (getCorners bd)+ P.withNewContext $ do+ renderedDiagram instance Monoid (Render Pdf R2) where mempty = D (return ())@@ -403,7 +453,9 @@ pdfLineCap LineCapSquare = SquareCap pdfDashing :: Dashing -> DashPattern -pdfDashing (Dashing l a) = DashPattern l a+pdfDashing (Dashing l a) = DashPattern (map convert l) (convert a)+ where + convert x = defaultWidth * x / diagramDefaultUnit {- @@ -481,7 +533,7 @@ handle f = f `fmap` getAttr s lWidth w = do let d = getLineWidth w- drawM . setWidth $ d+ drawM . setWidth $ (defaultWidth * d / diagramDefaultUnit) setTrokeState d lCap = drawM . setLineCap . pdfLineCap . getLineCap lJoin = drawM . setLineJoin . pdfLineJoin . getLineJoin@@ -516,6 +568,7 @@ do mapM_ renderC segs when (isLoop t) (drawM closePath)+ setLoop (isLoop t) instance Renderable (Path R2) Pdf where render _ (Path t) = D $ do
src/Diagrams/Backend/Pdf/CmdLine.hs view
@@ -16,7 +16,6 @@ module Diagrams.Backend.Pdf.CmdLine ( defaultMain , multipleMain- , renderDia' , Pdf ) where @@ -123,7 +122,7 @@ 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+ P.drawWithPage page1 $ renderDia Pdf pdfOpts d -- | Generate a multipage PDF document from several diagrams. -- Each diagram is scaled to the page size@@ -144,7 +143,7 @@ pdfOpts = PdfOptions sizeSpec createPage aDiag = do page1 <- P.addPage Nothing- P.drawWithPage page1 $ renderDia' aDiag pdfOpts+ P.drawWithPage page1 $ renderDia Pdf pdfOpts aDiag ifCanRender opts $ do P.runPdf (output opts) (P.standardDocInfo { P.author=P.toPDFString theAuthor, P.compressed = compression}) docRect $ do@@ -159,21 +158,3 @@ 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))