HPDF 1.4.4 → 1.4.5

raw patch · 11 files changed

+192/−59 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Graphics/PDF.hs +68/−22
• Graphics/PDF/Action.hs +2/−0
• Graphics/PDF/Annotation.hs +6/−1
• Graphics/PDF/Documentation.hs +0/−2
• Graphics/PDF/Draw.hs +29/−3
• Graphics/PDF/Image.hs +18/−13
• Graphics/PDF/LowLevel/Types.hs +54/−11
• Graphics/PDF/Pages.hs +2/−2
• Graphics/PDF/Resources.hs +9/−1
• HPDF.cabal +1/−1
• Test/Makefile +3/−3

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} --------------------------------------------------------- -- | -- Copyright   : (c) 2006-2012, alpheccar.org@@ -83,6 +84,7 @@ import Data.Binary.Builder(Builder,fromLazyByteString, toLazyByteString) import Graphics.PDF.LowLevel.Serializer import Data.Monoid+import Data.List(unfoldr)  -- | Create a new PDF document and return a first page -- The page is using the document size by default@@ -108,7 +110,7 @@      --myBounds <- gets xobjectBound      --cp <- gets currentPage      --let (_,state',w') = runDrawing d (emptyEnvironment {streamId = r, xobjectb = myBounds, currentp = maybe Nothing (\(PDFReference x) -> Just x) cp })-     let ref = PDFReference r :: PDFReference PDFLength+     let ref = PDFReference r :: PDFReference MaybeLength                -- Pattern NEEDS a resource entry even if empty otherwise don't work with acrobat reader      -- Image DON'T want a resource entry if empty otherwise don't work with apple reader@@ -143,10 +145,12 @@          let w''' = compress . toLazyByteString $ w'              w'' = fromLazyByteString w'''          updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w'' True ref resources)-         updateObject ref (PDFLength (B.length w'''))+         updateObject ref (UnknownLength)+         --updateObject ref (PDFLength (B.length w'''))        else do          updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w' False ref resources)-         updateObject ref (PDFLength (B.length . toLazyByteString $ w'))+         updateObject ref (UnknownLength)+         --updateObject ref (PDFLength (B.length . toLazyByteString $ w'))  -- | Save all the pages and streams in the main object dictionary saveObjects :: PDF (PDFReference PDFCatalog)@@ -186,6 +190,8 @@                  , (PDFName "Producer",AnyPdfObject $ toPDFString "HPDF - The Haskell PDF Library" )                  ] +instance PdfLengthInfo PDFTrailer where+ -- | Write PDF objects in the TOC writeObjectsAndCreateToc :: [Builder] -- ^ List of objects each object being already converted to a bytestring                           -> (Int,Int64,[Builder])@@ -197,7 +203,31 @@    (length l,last lengths,entries) -- foldr writeObject (0,0::Int64,[]) l where -- writeObject obj (nb,len,toc) = (nb+1,len + (B.length . toLazyByteString $ obj),(serialize $ (printf "%010d 00000 n \n" ((fromIntegral len)::Integer))) : toc)-     + +generateStreams root di !nb !totalLen ens [] = +  let entries = reverse (tail ens)  +  in+  toLazyByteString $ mconcat $ [ serialize "xref\n"+                               , serialize $ "0 " ++ show nb ++ "\n"+                               , serialize "0000000000 65535 f \n"+                               ]+                               +++                               entries+                               +++                               [ serialize "\ntrailer\n"+                               , toPDF $ PDFTrailer nb root di+                               , serialize "\nstartxref\n"+                               , serialize (show totalLen)+                               , serialize "\n%%EOF"+                             ]+generateStreams root di !nb !totalLen ens (obj:t) = +     let s = toLazyByteString obj +         createEntry x = serialize $ (printf "%010d 00000 n \n" ((fromIntegral x)::Integer) :: String) +         newLen = B.length s + totalLen+         en = createEntry $! newLen+     in+     (s `B.append`) . generateStreams root di (nb+1) newLen (en : ens) $ t+ defaultPdfSettings :: PdfState defaultPdfSettings =    PdfState {@@ -214,30 +244,46 @@            , firstOutline = [True]            } -createObjectByteStrings :: PdfState -> PDF a -> Builder +createObjectByteStrings :: PdfState -> PDF a -> B.ByteString  createObjectByteStrings pdfState m =       let header = serialize "%PDF-1.5\n"-          objectEncoding (x,a) = toPDF . PDFReferencedObject (fromIntegral x) $ a+          objectEncoding (x,a) = toPDF . PDFReferencedObject (fromIntegral $! x) $ a           (root,s) = flip runState pdfState  . unPDF $ createPDF >> m >> saveObjects           objs = objects s-          objectContents = header : (map objectEncoding . IM.toAscList $ objs)+          k = IM.keys objs +          encodeAnObject (_,[]) = Nothing +          encodeAnObject (im,k:t) = +            let Just o = IM.lookup k im+                result = do +                    (l,PDFReference ref) <- pdfLengthInfo o +                    let im' = IM.insert ref (AnyPdfObject (KnownLength (PDFLength l))) im+                    return im'+            in+            case result of +              Nothing -> Just (objectEncoding (k,o),(im,t)) +              Just im' ->  Just (objectEncoding (k,o),(im',t)) ++          encodedObjects = unfoldr encodeAnObject (objs,k)+          objectContents = header : encodedObjects           (nb,len,toc) = writeObjectsAndCreateToc objectContents       in-        mconcat$ objectContents ++-                [ serialize "xref\n"-                , serialize $ "0 " ++ show nb ++ "\n"-                , serialize "0000000000 65535 f \n"-                ]-                ++-                toc-                ++-                [ serialize "\ntrailer\n"-                , toPDF $ PDFTrailer nb root (docInfo pdfState)-                , serialize "\nstartxref\n"-                , serialize (show len)-                , serialize "\n%%EOF"-                ]+      generateStreams root (docInfo pdfState) 0 0 [] objectContents  +        --mconcat$ objectContents +++        --        [ serialize "xref\n"+        --        , serialize $ "0 " ++ show nb ++ "\n"+        --        , serialize "0000000000 65535 f \n"+        --        ]+        --        +++        --        toc+        --        +++        --        [ serialize "\ntrailer\n"+        --        , toPDF $ PDFTrailer nb root (docInfo pdfState)+        --        , serialize "\nstartxref\n"+        --        , serialize (show len)+        --        , serialize "\n%%EOF"+        --        ]+ -- | Generate a lazy bytestring for the PDF      pdfByteString :: PDFDocumentInfo               -> PDFRect -- ^ Default size for a page@@ -245,7 +291,7 @@               -> IO (B.ByteString)  pdfByteString infos rect m = do      let content = createObjectByteStrings (defaultPdfSettings {defaultRect = rect, docInfo = infos} ) m-    return (toLazyByteString content)+    return content  -- | Generates a PDF document runPdf :: String -- ^ Name of the PDF document

@@ -60,6 +60,8 @@                          ] instance Action GoToURL +instance PdfLengthInfo GoToURL where+  --instance PdfObject ControlMedia where --    toPDF (ControlMedia operation relatedScreenAnnotation rendition) = toPDF . PDFDictionary . M.fromList $

@@ -119,6 +119,8 @@       toPDF a@(TextAnnotation _ _ i) = toPDF . PDFDictionary . M.fromList $             standardAnnotationDict a ++ [(PDFName "Name",AnyPdfObject . PDFName $ show i)] +instance PdfLengthInfo TextAnnotation where+ instance AnnotationObject TextAnnotation where     addAnnotation = addObject     annotationType _ = PDFName "Text"@@ -134,7 +136,9 @@             [ (PDFName "A",AnyPdfObject (GoToURL url))             , (PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))             ]-            ++instance PdfLengthInfo URLLink where+            instance AnnotationObject URLLink where     addAnnotation = addObject     annotationType _ = PDFName "Link"@@ -156,6 +160,7 @@                  , AnyPdfObject y                  , AnyPdfObject (PDFInteger 0)]                                                          +instance PdfLengthInfo PDFLink where  instance AnnotationObject PDFLink where     addAnnotation = addObject

@@ -36,8 +36,6 @@ 	-- $warning 	) where  -import Graphics.PDF- {- $creating   When you create a document, you must give some information for the PDF file like the author,

@@ -88,6 +88,7 @@ import qualified Data.Map as M import qualified Data.IntMap as IM import qualified Data.Binary.Builder as BU+import qualified Data.ByteString.Lazy as B  import Control.Monad.ST import Data.STRef@@ -116,7 +117,8 @@  instance PdfObject AnyAnnotation where     toPDF (AnyAnnotation a) = toPDF a-    +instance PdfLengthInfo AnyAnnotation where+ instance AnnotationObject AnyAnnotation where     addAnnotation (AnyAnnotation a) = do         PDFReference r <- addAnnotation a@@ -208,7 +210,7 @@ modifyDrawST f g = Draw $ \env -> modifySTRef (f env) g  -- | A PDF stream object-data PDFStream = PDFStream !BU.Builder !Bool !(PDFReference PDFLength) !PDFDictionary+data PDFStream = PDFStream !BU.Builder !Bool !(PDFReference MaybeLength) !PDFDictionary                                     instance PdfObject PDFStream where   toPDF (PDFStream s c l d) = @@ -223,6 +225,9 @@       compressedStream True = if not (pdfDictMember (PDFName "Filter") d) then [(PDFName "Filter",AnyPdfObject $ [AnyPdfObject . PDFName $ "FlateDecode"])] else []       lenDict = PDFDictionary. M.fromList $ [ (PDFName "Length",AnyPdfObject l)] ++ compressedStream c       dict = pdfDictUnion lenDict d++instance PdfLengthInfo PDFStream where +  pdfLengthInfo (PDFStream s _ l _) = Just (B.length . BU.toLazyByteString $ s,l)      -- | An empty drawing emptyDrawing :: Draw ()@@ -326,6 +331,7 @@ data AnyPdfXForm = forall a. (PDFXObject a,PdfObject a) => AnyPdfXForm a instance PdfObject AnyPdfXForm where     toPDF (AnyPdfXForm a) = toPDF a+instance PdfLengthInfo AnyPdfXForm where  instance PDFXObject AnyPdfXForm @@ -333,6 +339,8 @@ instance PDFXObject PDFXForm instance PdfObject PDFXForm where     toPDF _ = noPdfObject+instance PdfLengthInfo PDFXForm where+ instance PdfResourceObject (PDFReference PDFXForm) where     toRsrc = AnyPdfObject     @@ -506,6 +514,8 @@   , (PDFName "Last",AnyPdfObject lasto)   ] +instance PdfLengthInfo PDFOutline where+ data OutlineStyle = NormalOutline                   | ItalicOutline                   | BoldOutline@@ -550,7 +560,9 @@    , (PDFName "NonFullScreenPageMode",AnyPdfObject  . PDFName . show $ nfspm)    ] +instance PdfLengthInfo PDFViewerPreferences where + instance Show PDFTransStyle where    show (Split _ _) = "Split"    show (Blinds _) = "Blinds"@@ -576,6 +588,8 @@     optionalDi (Glitter a)  = [ (PDFName "Di",AnyPdfObject (floatDirection a))]     optionalDi _ = []   +instance PdfLengthInfo PDFTransition where+ -- PDF Pages  instance PdfObject PDFPages where@@ -591,7 +605,9 @@   , (PDFName "Count",AnyPdfObject . PDFInteger $ c)   ]  +instance PdfLengthInfo PDFPages where + instance PdfObject PDFPage where  toPDF (PDFPage (Just theParent) box content theRsrc d t theAnnots) = toPDF $ PDFDictionary. M.fromList $    [ (PDFName "Type",AnyPdfObject (PDFName "Page"))@@ -608,6 +624,7 @@   ++ ((\x -> if null x then [] else [(PDFName "Annots",AnyPdfObject x)]) theAnnots)  toPDF (PDFPage Nothing _ _ _ _ _ _) = noPdfObject +instance PdfLengthInfo PDFPage where  -- Main objects in a PDF document @@ -620,12 +637,15 @@    , (PDFName "ViewerPreferences", AnyPdfObject viewerPrefs)    ] ++ (maybe [] (\x -> [(PDFName "Outlines",AnyPdfObject x)]) outlines) +instance PdfLengthInfo PDFCatalog where  instance PdfObject OutlineStyle where    toPDF NormalOutline = toPDF (PDFInteger 0)    toPDF ItalicOutline = toPDF (PDFInteger 1)    toPDF BoldOutline = toPDF (PDFInteger 2) +instance PdfLengthInfo OutlineStyle where+ instance PdfObject PDFOutlineEntry where  toPDF (PDFOutlineEntry title theParent prev next first theLast count dest color style) =       toPDF $ PDFDictionary. M.fromList $ [@@ -647,17 +667,23 @@       , (PDFName "F",AnyPdfObject style)       ] +instance PdfLengthInfo PDFOutlineEntry where   instance PdfObject Destination where   toPDF (Destination r) = toPDF                [ AnyPdfObject r                                                , AnyPdfObject . PDFName $ "Fit"                                                ]-                                               ++instance PdfLengthInfo Destination where++                                               instance PdfObject Color where    toPDF (Rgb r g b) = toPDF . map AnyPdfObject $ [r,g,b]      toPDF (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v)     in toPDF . map AnyPdfObject $ [r,g,b]++instance PdfLengthInfo Color where  -- Degree for a transition direction floatDirection :: PDFTransDirection2 -> PDFFloat

@@ -44,7 +44,7 @@ import Data.Bits import Control.Monad.Error   import Graphics.PDF.Coordinates-import Data.Binary.Builder(Builder,fromLazyByteString)+import Data.Binary.Builder(Builder,fromLazyByteString,singleton) import Control.Exception as E import qualified Data.Vector.Unboxed as U import qualified Data.Bits as BI@@ -316,17 +316,16 @@         recordBound s width height         return (PDFReference s)      where-       img = fromLazyByteString .  pack24 . U.toList $ stream-       pack24 :: [Word32] -> B.ByteString-       pack24 [] = B.empty -       pack24 (a:l) = B.cons xa . B.cons xb . B.cons xc $ (pack24 l)-         where -          xa = fromIntegral $ (a `shiftR` 16) .&. 0x0FF-          xb = fromIntegral $ (a `shiftR` 8) .&. 0x0FF-          xc = fromIntegral $ (a `shiftR` 0) .&. 0x0FF--       a' = -                 do modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $ +        addPixel (a:t) =  +           let xa = fromIntegral $ (a `shiftR` 16) .&. 0x0FF+               xb = fromIntegral $ (a `shiftR` 8) .&. 0x0FF+               xc = fromIntegral $ (a `shiftR` 0) .&. 0x0FF+           in+           xa:xb:xc:addPixel t+        addPixel [] = []+                        +        a' =  do +                modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $                                                     [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject")                                                    , (PDFName "Subtype",AnyPdfObject . PDFName $ "Image")                                                    , (PDFName "Width",AnyPdfObject . PDFInteger $ round width)@@ -336,7 +335,7 @@                                                    , (PDFName "Interpolate", AnyPdfObject interpolate)                                                    ]                                              }-                    tell img        +                tell . fromLazyByteString . B.pack . addPixel . U.toList $ stream         -- | A Jpeg file    data JpegFile = JpegFile !Int !PDFFloat !PDFFloat !Int !Builder@@ -351,6 +350,9 @@          instance PdfObject PDFJpeg where   toPDF _ = noPdfObject++instance PdfLengthInfo PDFJpeg where+ instance PdfResourceObject (PDFReference PDFJpeg) where   toRsrc = AnyPdfObject @@ -365,6 +367,9 @@          instance PdfObject RawImage where   toPDF _ = noPdfObject++instance PdfLengthInfo RawImage where+ instance PdfResourceObject (PDFReference RawImage) where   toRsrc = AnyPdfObject 

@@ -38,51 +38,76 @@ class PdfObject a where   toPDF :: a -> Builder +class PdfLengthInfo a where +  pdfLengthInfo :: a -> Maybe (Int64 , PDFReference MaybeLength)+  pdfLengthInfo _ = Nothing+ -- | Anonymous PDF object-data AnyPdfObject = forall a . PdfObject a => AnyPdfObject a+data AnyPdfObject = forall a . (PdfObject a, PdfLengthInfo a) => AnyPdfObject !a  instance PdfObject AnyPdfObject where  toPDF (AnyPdfObject a) = toPDF a++instance PdfLengthInfo AnyPdfObject where +  pdfLengthInfo (AnyPdfObject a) = pdfLengthInfo a   -- | An integer in a PDF document newtype PDFInteger = PDFInteger Int deriving(Eq,Show,Ord,Num)  -- | A length in a PDF document-data PDFLength = PDFLength Int64 deriving(Eq,Show,Ord)+newtype PDFLength = PDFLength Int64 deriving(Eq,Show,Ord,Num) -instance Num PDFLength where-  (+) (PDFLength a) (PDFLength b) = PDFLength (a+b)-  (*) (PDFLength a) (PDFLength b) = PDFLength (a*b)-  negate (PDFLength a) = PDFLength (negate a)-  abs (PDFLength a) = PDFLength (abs a)-  signum (PDFLength a) = PDFLength (signum a)-  fromInteger a = PDFLength (fromInteger a)+data MaybeLength = UnknownLength +                 | KnownLength !PDFLength  +instance PdfObject MaybeLength where +  toPDF (KnownLength a) = toPDF a +  toPDF (UnknownLength) = error "Trying to process an unknown length during PDF generation"++instance PdfLengthInfo MaybeLength where+ -- | A real number in a PDF document type PDFFloat = Double   instance PdfObject PDFInteger where     toPDF (PDFInteger a) = serialize a +instance PdfLengthInfo PDFInteger where+ instance PdfObject Int where     toPDF a = serialize a++instance PdfLengthInfo Int where+            instance PdfObject PDFLength where     toPDF (PDFLength a) = serialize (show a)++instance PdfLengthInfo PDFLength where+      instance PdfObject PDFFloat where   toPDF a = serialize a +instance PdfLengthInfo PDFFloat where++ instance PdfObject (Complex PDFFloat) where   toPDF (x :+ y) = mconcat [ serialize x                            , serialize ' '                            , serialize y                            ] ++instance PdfLengthInfo (Complex PDFFloat) where+    instance PdfObject Bool where   toPDF (True) = serialize "true"   toPDF (False) = serialize "false" +instance PdfLengthInfo Bool where++ -- | A PDFString containing a strict bytestring newtype PDFString = PDFString S.ByteString deriving(Eq,Ord,Show) @@ -155,18 +180,26 @@                     , rparen                     ] +instance PdfLengthInfo PDFString where++ -- | A PDFName object newtype PDFName = PDFName String deriving(Eq,Ord)  instance PdfObject PDFName where  toPDF (PDFName a) = serialize ("/" ++ a)++instance PdfLengthInfo PDFName where+   -- | A PDFArray type PDFArray = [AnyPdfObject]  instance PdfObject a => PdfObject [a] where     toPDF l = mconcat $ (lbracket:intersperse bspace (map toPDF l)) ++ [bspace] ++ [rbracket]-                                 +       +instance PdfObject a => PdfLengthInfo [a] where+ -- | A PDFDictionary  newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject)@@ -185,7 +218,9 @@                                                                                   in             M.foldWithKey convertItem mempty a-           +  +instance PdfLengthInfo PDFDictionary where+ -- | Am empty dictionary emptyDictionary :: PDFDictionary emptyDictionary = PDFDictionary M.empty@@ -206,6 +241,8 @@ instance PdfObject PDFRect where  toPDF (PDFRect a b c d) = toPDF . map (AnyPdfObject . PDFInteger) $ [a,b,c,d]  +instance PdfLengthInfo PDFRect where+        -- | A Referenced objects data PDFReferencedObject a = PDFReferencedObject !Int !a@@ -220,6 +257,9 @@                , serialize "endobj"                , newline , newline                ]++instance PdfObject a => PdfLengthInfo (PDFReferencedObject a) where+                 -- | A reference to a PDF object data PDFReference s = PDFReference !Int deriving(Eq,Ord,Show)@@ -241,10 +281,13 @@                                      , serialize " 0 R"]                                                                           +instance PdfObject s => PdfLengthInfo (PDFReference s) where                 instance (PdfObject a,PdfObject b) => PdfObject (Either a b) where   toPDF (Left a) = toPDF a   toPDF (Right a) = toPDF a++instance (PdfObject a, PdfObject b) => PdfLengthInfo (Either a b) where  modifyStrict :: (MonadState s m) => (s -> s) -> m () modifyStrict f = do

@@ -91,7 +91,7 @@           return r       -- | Add an object to the PDF object dictionary and return a PDF reference     -addObject :: (PdfObject a) => a -> PDF (PDFReference a)+addObject :: (PdfObject a, PdfLengthInfo a) => a -> PDF (PDFReference a) addObject a = do   r <- supply   modifyStrict $ \s -> s {objects = IM.insert r (AnyPdfObject a) (objects s)}@@ -99,7 +99,7 @@     -- | Update a referenced object with a new one-updateObject :: (PdfObject a) => PDFReference a -- ^ Reference to the initial object+updateObject :: (PdfObject a, PdfLengthInfo a) => PDFReference a -- ^ Reference to the initial object              -> a -- ^ New value              -> PDF () updateObject (PDFReference i) obj = do

@@ -106,7 +106,9 @@  instance PdfObject PDFResource where  toPDF r = toPDF . resourceToDict $ r-        +     +instance PdfLengthInfo PDFResource where+ -- | Add a new G State to the G State dictionary for the given resource addResource :: PDFName -- ^ GState dictionary           -> PDFName -- ^ GState name must be unique@@ -142,16 +144,22 @@      instance PdfObject PDFColoredPattern where     toPDF _ = noPdfObject+instance PdfLengthInfo PDFColoredPattern where+ instance PdfResourceObject (PDFReference PDFColoredPattern) where     toRsrc = AnyPdfObject  instance PdfObject PDFUncoloredPattern where         toPDF _ = noPdfObject+instance PdfLengthInfo PDFUncoloredPattern where+ instance PdfResourceObject (PDFReference PDFUncoloredPattern) where         toRsrc = AnyPdfObject  instance PdfObject AnyPdfPattern where         toPDF _ = noPdfObject+instance PdfLengthInfo AnyPdfPattern where+ instance PdfResourceObject (PDFReference AnyPdfPattern) where         toRsrc = AnyPdfObject 

@@ -1,5 +1,5 @@ Name: HPDF-Version: 1.4.4+Version: 1.4.5 cabal-version: >=1.6 License: LGPL License-file:LICENSE

@@ -1,11 +1,11 @@ debug:-	ghc -o test -XForeignFunctionInterface -cpp -Wall -funbox-strict-fields  -fglasgow-exts  -O2 -hidir interfaces -odir bin -optc-I../c -i.. ../c/metrics.c ../c/conversion.c --make test.hs+	ghc -o test -O -package-db ../dist/package.conf.inplace --make test.hs  profile:-	ghc -o test -prof -auto-all -XForeignFunctionInterface -cpp -Wall -funbox-strict-fields  -fglasgow-exts  -O2 -hidir interfaces -odir bin -optc-I../c -i..  ../c/metrics.c ../c/conversion.c --make test.hs+	ghc -o test -prof -fprof-auto -rtsopts -O -package-db ../dist/package.conf.inplace --make test.hs 	 runprof:-	./test +RTS -p -hc+	./test +RTS -p -hy 		 demo: 	ghc -o test -O2 --make test.hs