diff --git a/Graphics/PDF.hs b/Graphics/PDF.hs --- a/Graphics/PDF.hs +++ b/Graphics/PDF.hs @@ -72,7 +72,11 @@ , module Graphics.PDF.Fonts.StandardFont , module Graphics.PDF.Fonts.Type1 , readType1Font + , readType1FontWithEncoding , mkType1Font + , PostscriptName + , Encodings(..) + , unionEncodings -- ** Typesetting , module Graphics.PDF.Typesetting ) where @@ -112,6 +116,7 @@ import Graphics.PDF.Fonts.Font import Graphics.PDF.Fonts.StandardFont import Graphics.PDF.Fonts.Type1 +import Graphics.PDF.Fonts.Encoding (unionEncodings, Encodings(..), PostscriptName) -- | Create a new PDF document and return a first page -- The page is using the document size by default diff --git a/Graphics/PDF/Colors.hs b/Graphics/PDF/Colors.hs --- a/Graphics/PDF/Colors.hs +++ b/Graphics/PDF/Colors.hs @@ -58,10 +58,10 @@ registerResource "ExtGState" strokeAlphas (\newMap s -> s { strokeAlphas = newMap }) (StrokeAlpha alpha) - tell . mconcat $[ serialize "\n/" - , serialize newName - , serialize " gs" - ] + tell . mconcat $ [ serialize "\n/" + , serialize newName + , serialize " gs" + ] -- | Set alpha value for transparency setFillAlpha :: Double -> Draw () @@ -70,10 +70,10 @@ registerResource "ExtGState" fillAlphas (\newMap s -> s { fillAlphas = newMap }) (FillAlpha alpha) - tell . mconcat $[ serialize "\n/" - , serialize newName - , serialize " gs" - ] + tell . mconcat $ [ serialize "\n/" + , serialize newName + , serialize " gs" + ] -- | Init the PDF color space to RGB. setRGBColorSpace :: Draw () @@ -85,46 +85,46 @@ fillColor :: MonadPath m => Color -- ^ Filling color -> m () fillColor (Rgb r g b) = do - tell . mconcat $[ serialize "\n" - , toPDF r - , serialize ' ' - , toPDF g - , serialize ' ' - , toPDF b - , serialize " rg" - ] + tell . mconcat $ [ serialize "\n" + , toPDF r + , serialize ' ' + , toPDF g + , serialize ' ' + , toPDF b + , serialize " rg" + ] fillColor (Hsv h s v) = do let (r,g,b) = hsvToRgb (h,s,v) - tell . mconcat $[ serialize "\n" - , toPDF r - , serialize ' ' - , toPDF g - , serialize ' ' - , toPDF b - , serialize " rg" - ] + tell . mconcat $ [ serialize "\n" + , toPDF r + , serialize ' ' + , toPDF g + , serialize ' ' + , toPDF b + , serialize " rg" + ] -- | Select the drawing color strokeColor :: MonadPath m => Color -- ^ Drawing color -> m () strokeColor (Rgb r g b) = do - tell . mconcat $[ serialize "\n" - , toPDF r - , serialize ' ' - , toPDF g - , serialize ' ' - , toPDF b - , serialize " RG" - ] + tell . mconcat $ [ serialize "\n" + , toPDF r + , serialize ' ' + , toPDF g + , serialize ' ' + , toPDF b + , serialize " RG" + ] strokeColor (Hsv h s v) = do let (r,g,b) = hsvToRgb (h,s,v) - tell . mconcat $[ serialize "\n" - , toPDF r - , serialize ' ' - , toPDF g - , serialize ' ' - , toPDF b - , serialize " RG" - ] + tell . mconcat $ [ serialize "\n" + , toPDF r + , serialize ' ' + , toPDF g + , serialize ' ' + , toPDF b + , serialize " RG" + ] diff --git a/Graphics/PDF/Draw.hs b/Graphics/PDF/Draw.hs --- a/Graphics/PDF/Draw.hs +++ b/Graphics/PDF/Draw.hs @@ -1124,17 +1124,17 @@ applyMatrix :: Matrix -> Draw () applyMatrix m@(Matrix a b c d e f) = do multiplyCurrentMatrixWith m - tell . mconcat $[ serialize '\n' - , toPDF a - , serialize ' ' - , toPDF b - , serialize ' ' - , toPDF c - , serialize ' ' - , toPDF d - , serialize ' ' - , toPDF e - , serialize ' ' - , toPDF f - , serialize " cm" - ] + tell . mconcat $ [ serialize '\n' + , toPDF a + , serialize ' ' + , toPDF b + , serialize ' ' + , toPDF c + , serialize ' ' + , toPDF d + , serialize ' ' + , toPDF e + , serialize ' ' + , toPDF f + , serialize " cm" + ] diff --git a/Graphics/PDF/Fonts/Encoding.hs b/Graphics/PDF/Fonts/Encoding.hs --- a/Graphics/PDF/Fonts/Encoding.hs +++ b/Graphics/PDF/Fonts/Encoding.hs @@ -15,6 +15,7 @@ --------------------------------------------------------- module Graphics.PDF.Fonts.Encoding( getEncoding + , unionEncodings , Encodings(..) , PostscriptName , parseMacEncoding @@ -32,6 +33,7 @@ data Encodings = AdobeStandardEncoding | ZapfDingbatsEncoding + | OtherEncoding (M.Map PostscriptName Char) deriving(Eq) isLine :: C.ByteString -> Bool @@ -73,3 +75,14 @@ getEncoding :: Encodings -> IO (M.Map PostscriptName Char) getEncoding AdobeStandardEncoding = parseGlyphListEncoding glyphlist getEncoding ZapfDingbatsEncoding= parseGlyphListEncoding zapfdingbats +getEncoding (OtherEncoding enc) = pure enc + +-- Merge two encodings enc1 and enc2; it prefers enc1 when duplicate keys are encountered +-- +-- This example will overwrite the glyph name "a" in AdobeStandardEncoding: +-- >>> unionEncodings (OtherEncoding (M.singleton "a" '☃')) AdobeStandardEncoding +unionEncodings :: Encodings -> Encodings -> IO Encodings +unionEncodings enc1 enc2 = do + edata1 <- getEncoding enc1 + edata2 <- getEncoding enc2 + pure (OtherEncoding (M.union edata1 edata2)) diff --git a/Graphics/PDF/Fonts/Type1.hs b/Graphics/PDF/Fonts/Type1.hs --- a/Graphics/PDF/Fonts/Type1.hs +++ b/Graphics/PDF/Fonts/Type1.hs @@ -57,9 +57,9 @@ parseAfmData :: B.ByteString -> Either ParseError AFMData parseAfmData bs = second AFMData $ parseAfm "" bs -mkType1FontStructure :: FontData -> AFMData -> IO Type1FontStructure -mkType1FontStructure pdfRef (AFMData f) = do - theEncoding <- getEncoding AdobeStandardEncoding +mkType1FontStructure :: Encodings -> FontData -> AFMData -> IO Type1FontStructure +mkType1FontStructure encoding pdfRef (AFMData f) = do + theEncoding <- getEncoding encoding let theFont = fontToStructure f theEncoding Nothing return $ Type1FontStructure pdfRef theFont diff --git a/Graphics/PDF/Pages.hs b/Graphics/PDF/Pages.hs --- a/Graphics/PDF/Pages.hs +++ b/Graphics/PDF/Pages.hs @@ -33,10 +33,12 @@ , setPageResource , setPageAnnotations , readType1Font + , readType1FontWithEncoding , mkType1Font ) where - + import qualified Data.IntMap as IM +import Graphics.PDF.Fonts.Encoding(Encodings(..)) import Control.Monad.State import Graphics.PDF.LowLevel.Types import Graphics.PDF.Draw @@ -280,18 +282,41 @@ PDFReference s <- createContent (tell $ fromByteString d) Nothing return (PDFReference s) --- | Create a type 1 font -readType1Font :: FilePath - -> FilePath - -> IO (Either ParseError Type1FontStructure) -readType1Font pfb afmPath = do - fd <- readFontData pfb +-- | Create a type 1 font from pfb and afm files +readType1Font + :: FilePath -- ^ Path to pfb file + -> FilePath -- ^ Path to afm file + -> IO (Either ParseError Type1FontStructure) +readType1Font = readType1FontWithEncoding AdobeStandardEncoding + +-- | Create a type 1 font from pfb and afm files, using the specified encoding +-- +-- Say you've edited a font in fontforge and put a snowman on the +-- glyph with the name "a" and exported as snowman.pfb, you can +-- +-- >> readType1FontWithEncoding (OtherEncoding (M.singleton "a" '☃')) "./snowman.pfb" "./snowman.afm" +readType1FontWithEncoding + :: Encodings + -> FilePath -- ^ Path to pfb file + -> FilePath -- ^ Path to afm file + -> IO (Either ParseError Type1FontStructure) +readType1FontWithEncoding encoding pfb afmPath = do + fd <- readFontData pfb result <- readAfmData afmPath case result of Left pe -> pure $ Left pe - Right afm -> Right <$> mkType1FontStructure fd afm + Right afm -> Right <$> mkType1FontStructure encoding fd afm -mkType1Font :: Type1FontStructure -> PDF AnyFont -mkType1Font (Type1FontStructure fd fs) = do - ref <- createEmbeddedFont fd +-- | Given a correctly parsed output of 'readType1Font' or +-- 'readType1FontWithEncoding', create a font usable inside the PDF +-- +-- >>> myFontStructureOrError <- readType1Font "./myfont.pfb" "./myfont.afm" +-- >>> case myFontStructureOrError of +-- >>> Left msg -> error msg +-- >>> Right myFontStructure -> run docInfo docRect $ do +-- >>> myFont <- mkType1Font myFontStructure +-- >>> … +mkType1Font :: Type1FontStructure -> PDF AnyFont +mkType1Font (Type1FontStructure fd fs) = do + ref <- createEmbeddedFont fd return (AnyFont $ Type1Font fs ref) diff --git a/Graphics/PDF/Pattern.hs b/Graphics/PDF/Pattern.hs --- a/Graphics/PDF/Pattern.hs +++ b/Graphics/PDF/Pattern.hs @@ -131,21 +131,21 @@ colorMap <- gets colorSpaces (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap newName <- registerPattern ref - tell . mconcat $[ serialize "\n/" - , serialize newColorName - , serialize " cs" - ] - tell . mconcat $[ serialize '\n' - , toPDF r - , serialize ' ' - , toPDF g - , serialize ' ' - , toPDF b - , serialize ' ' - , serialize " /" - , serialize newName - , serialize " scn" - ] + tell . mconcat $ [ serialize "\n/" + , serialize newColorName + , serialize " cs" + ] + tell . mconcat $ [ serialize '\n' + , toPDF r + , serialize ' ' + , toPDF g + , serialize ' ' + , toPDF b + , serialize ' ' + , serialize " /" + , serialize newName + , serialize " scn" + ] -- | Set the stroke pattern setUncoloredStrokePattern :: PDFReference PDFUncoloredPattern -> Color -> Draw () @@ -154,10 +154,10 @@ colorMap <- gets colorSpaces (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap newName <- registerPattern ref - tell . mconcat $[ serialize "\n/" - , serialize newColorName - , serialize " CS" - ] + tell . mconcat $ [ serialize "\n/" + , serialize newColorName + , serialize " CS" + ] tell . mconcat $ [ serialize '\n' , toPDF r , serialize ' ' diff --git a/Graphics/PDF/Shading.hs b/Graphics/PDF/Shading.hs --- a/Graphics/PDF/Shading.hs +++ b/Graphics/PDF/Shading.hs @@ -80,10 +80,10 @@ registerResource "Shading" shadings (\newMap s -> s { shadings = newMap }) shade - tell . mconcat $[ serialize "\n/" - , serialize newName - , serialize " sh" - ] + tell . mconcat $ [ serialize "\n/" + , serialize newName + , serialize " sh" + ] paintWithShading :: PDFShading -- ^ Shading -> Draw a -- ^ Shape to paint diff --git a/Graphics/PDF/Shapes.hs b/Graphics/PDF/Shapes.hs --- a/Graphics/PDF/Shapes.hs +++ b/Graphics/PDF/Shapes.hs @@ -151,17 +151,17 @@ -- | Set pen width setWidth :: MonadPath m => PDFFloat -> m () -setWidth w = tell . mconcat $[ serialize "\n" - , toPDF w - , serialize " w" - ] +setWidth w = tell . mconcat $ [ serialize "\n" + , toPDF w + , serialize " w" + ] -- | Set pen width setMiterLimit :: MonadPath m => PDFFloat -> m () -setMiterLimit w = tell . mconcat $[ serialize "\n" - , toPDF w - , serialize " M" - ] +setMiterLimit w = tell . mconcat $ [ serialize "\n" + , toPDF w + , serialize " M" + ] -- | Line cap styles data CapStyle = ButtCap @@ -177,17 +177,17 @@ -- | Set line cap setLineCap :: MonadPath m => CapStyle -> m () -setLineCap w = tell . mconcat $[ serialize "\n " - , toPDF (fromEnum w) - , serialize " J" - ] +setLineCap w = tell . mconcat $ [ serialize "\n " + , toPDF (fromEnum w) + , serialize " J" + ] -- | Set line join setLineJoin :: MonadPath m => JoinStyle -> m () -setLineJoin w = tell . mconcat $[ serialize "\n " - , toPDF (fromEnum w) - , serialize " j" - ] +setLineJoin w = tell . mconcat $ [ serialize "\n " + , toPDF (fromEnum w) + , serialize " j" + ] data DashPattern = DashPattern ![PDFFloat] PDFFloat deriving(Eq) @@ -247,10 +247,10 @@ lineto :: Point -> Draw () lineto a = do - tell . mconcat $[ serialize "\n" - , toPDF a - , serialize " l" - ] + tell . mconcat $ [ serialize "\n" + , toPDF a + , serialize " l" + ] writeDrawST penPosition a curveto :: Point -> Point -> Point -> Draw () diff --git a/Graphics/PDF/Text.hs b/Graphics/PDF/Text.hs --- a/Graphics/PDF/Text.hs +++ b/Graphics/PDF/Text.hs @@ -251,20 +251,20 @@ -- | Set the text transformation matrix setTextMatrix :: Matrix -> PDFText() setTextMatrix (Matrix a b c d e f) = - tell . mconcat $[ serialize '\n' - , toPDF a - , serialize ' ' - , toPDF b - , serialize ' ' - , toPDF c - , serialize ' ' - , toPDF d - , serialize ' ' - , toPDF e - , serialize ' ' - , toPDF f - , serialize " Tm" - ] + tell . mconcat $ [ serialize '\n' + , toPDF a + , serialize ' ' + , toPDF b + , serialize ' ' + , toPDF c + , serialize ' ' + , toPDF d + , serialize ' ' + , toPDF e + , serialize ' ' + , toPDF f + , serialize " Tm" + ] -- | Utility function to quickly display one line of text text :: PDFFont diff --git a/HPDF.cabal b/HPDF.cabal --- a/HPDF.cabal +++ b/HPDF.cabal @@ -1,5 +1,5 @@ Name: HPDF -Version: 1.7 +Version: 1.8 cabal-version: >=1.10 License: BSD3 License-file:LICENSE @@ -8,7 +8,6 @@ synopsis: Generation of PDF documents maintainer: sylvain@haskus.fr build-type: Simple -tested-with: GHC==7.10.2 homepage: http://www.alpheccar.org description: A PDF library with support for several pages, page transitions, outlines, annotations, compression, colors, shapes, patterns, jpegs, fonts, typesetting ... Have a look at the "Graphics.PDF.Documentation" module to see how to use it. Or, download the package and look at the test.hs file in the Test folder. That file is giving an example of each feature. extra-source-files: @@ -50,6 +49,8 @@ Build-depends: base >= 4, HTF >= 0.10, HPDF + build-tool-depends: + HTF:htfpp Default-language: Haskell2010 Executable HPDF-Demo diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ [![Hackage](https://img.shields.io/hackage/v/HPDF.svg)](https://hackage.haskell.org/package/HPDF) +[![Master CI badge](https://github.com/hsyl20/HPDF/actions/workflows/ci.yml/badge.svg?branch=master)](https://github.com/hsyl20/HPDF/actions/workflows/ci.yml?query=branch%3Amaster) -HPDF -==== +# HPDF A PDF library with support for several pages, page transitions, outlines, annotations, compression, colors, shapes, patterns, jpegs, fonts, typesetting... @@ -11,14 +11,15 @@ Or, download the package and look at the test.hs file in the Test folder. That file is giving an example of each feature. -Documentation -------------- +## Documentation The library documentation can be accessed on [Hackage](https://hackage.haskell.org/package/HPDF) -TO TEST THE LIBRARY -===================== +## Testing -> stack run HPDF-demo -> open demo.pdf +``` +$ cabal test all +$ cabal run HPDF-demo +$ open demo.pdf +``` diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ # Changelog for [`HPDF` package](http://hackage.haskell.org/package/HPDF) +## 1.8 + + * Added Github CI + * Allow specifying encodings and merging them (#17) + ## 1.7 * Add transparency support and more function types (#16)