{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Generation of PDF documents
-- 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.
---------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Graphics.PDF
  (
  -- * HPDF
  -- ** PDF Monad
    PDF 
  , runPdf
  , pdfByteString
  -- ** PDF Common Types
  , PDFRect(..)
  , PDFFloat
  , PDFReference
  , PDFString
  , PDFPage
  , Pages
  -- ** Document management
  , module Graphics.PDF.Document
  -- ** Drawing
  , module Graphics.PDF.Shapes
  -- ** Colors
  , module Graphics.PDF.Colors
  -- ** Geometry
  , module Graphics.PDF.Coordinates
  , applyMatrix
  -- ** Text
  , module Graphics.PDF.Text
  -- ** Navigation
  , module Graphics.PDF.Navigation
  -- ** Annotations
  , module Graphics.PDF.Annotation
  -- ** Actions
  , module Graphics.PDF.Action
  -- ** Images
  , module Graphics.PDF.Image
  -- ** Patterns
  , module Graphics.PDF.Pattern
  -- ** Shading
  , module Graphics.PDF.Shading
  -- ** Transparency
  , module Graphics.PDF.Transparency
  , ColorSpace(..)
  , calculator1
  , calculator2
  , ColorFunction1(..)
  , ColorFunction2(..)
  , Function1(..)
  , Function2(..)
  , Global
  , Local
  , linearStitched
  , FunctionObject
  -- ** Fonts
  , module Graphics.PDF.Fonts.Font 
  , module Graphics.PDF.Fonts.StandardFont
  , module Graphics.PDF.Fonts.Type1
  , readType1Font
  , mkType1Font
  -- ** Typesetting
  , module Graphics.PDF.Typesetting
  ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
 
import Graphics.PDF.Typesetting
import Graphics.PDF.Transparency
import Graphics.PDF.Shading
import Graphics.PDF.Pattern
import Graphics.PDF.Navigation
import Graphics.PDF.Text
import qualified Data.IntMap as IM
import qualified Data.ByteString.Lazy as B
import Data.Int
import Text.Printf(printf)
import Control.Monad.State
import Graphics.PDF.Annotation
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Colors
import Graphics.PDF.Shapes
import Graphics.PDF.Coordinates
import Graphics.PDF.Pages
import Graphics.PDF.Document hiding (createPDFXFormExtra)
import Codec.Compression.Zlib
import Graphics.PDF.Action
import Graphics.PDF.Image
import Graphics.PDF.Resources(emptyResource)
import Data.Binary.Builder(Builder,fromLazyByteString, toLazyByteString)
import Graphics.PDF.LowLevel.Serializer
import Data.List(mapAccumL)
import Data.Maybe(fromMaybe)
import qualified Data.Text as T
import Graphics.PDF.Fonts.Font 
import Graphics.PDF.Fonts.StandardFont
import Graphics.PDF.Fonts.Type1

-- | Create a new PDF document and return a first page
-- The page is using the document size by default
createPDF :: PDF ()
createPDF :: PDF ()
createPDF  = do
  -- Create the Proc structure
  --proc <- addObject PDFProc
  -- Create an empty resource
  --addObject $ PDFResource proc
  () -> PDF ()
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
-- Create the PDF stream objects from the draw monads
createStreams :: PDF ()
createStreams :: PDF ()
createStreams = do
    [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
ls <- (PdfState
 -> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder)))
-> PDF
     (IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState
-> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams PDF (IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder)))
-> (IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
    -> PDF
         [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))])
-> PDF
     [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
forall a b. PDF a -> (a -> PDF b) -> PDF b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
-> PDF
     [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
 -> PDF
      [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))])
-> (IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
    -> [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))])
-> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
-> PDF
     [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
-> [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
forall a. IntMap a -> [(Int, a)]
IM.toList
    (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {streams = IM.empty}
    ((Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))
 -> PDF ())
-> [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
-> PDF ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))
-> PDF ()
addStream [(Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))]
ls
 where
    addStream :: (Int, (Maybe (PDFReference PDFPage), (DrawState, Builder)))
-> PDF ()
addStream (Int
k,(Maybe (PDFReference PDFPage)
p,(DrawState
state',Builder
w'))) = do
     -- New reference for the stream
     Int
r <- PDF Int
supply
     -- Run the drawing and get the new state (resource, annotation)
     --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 MaybeLength
ref = Int -> PDFReference MaybeLength
forall s. Int -> PDFReference s
PDFReference Int
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
     PDFDictionary
resources <- if (PDFResource -> Bool
emptyResource (DrawState -> PDFResource
rsrc DrawState
state')) Bool -> Bool -> Bool
&& (Bool -> Bool
not (PDFName -> PDFDictionary -> Bool
pdfDictMember (String -> PDFName
PDFName String
"PatternType") (DrawState -> PDFDictionary
otherRsrcs DrawState
state')))
       then do
         case Maybe (PDFReference PDFPage)
p of
            -- Not linked to a page
            -- otherResource are entries specific to a special stream (like an XObject) so we return empty for a page
            Maybe (PDFReference PDFPage)
Nothing -> PDFDictionary -> PDF PDFDictionary
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (DrawState -> PDFDictionary
otherRsrcs DrawState
state') 
            -- Linked to a page
            Just PDFReference PDFPage
pageRef -> do
                 [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations (DrawState -> [AnyAnnotation]
annots DrawState
state') PDFReference PDFPage
pageRef
                 PDFDictionary -> PDF PDFDictionary
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return PDFDictionary
emptyDictionary
       -- Some resource are needed by the stream
       else do
         PDFReference PDFResource
rsrcRef <- PDFResource -> PDF (PDFReference PDFResource)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (DrawState -> PDFResource
rsrc DrawState
state')
         case Maybe (PDFReference PDFPage)
p of
             -- Not linked to a page
             Maybe (PDFReference PDFPage)
Nothing -> do                  
                  PDFDictionary -> PDF PDFDictionary
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFDictionary -> PDF PDFDictionary)
-> PDFDictionary -> PDF PDFDictionary
forall a b. (a -> b) -> a -> b
$ (DrawState -> PDFDictionary
otherRsrcs DrawState
state') PDFDictionary -> PDFDictionary -> PDFDictionary
`pdfDictUnion` ([(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList  ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [String -> PDFReference PDFResource -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Resources" PDFReference PDFResource
rsrcRef])
             -- Linked to a page
             Just PDFReference PDFPage
pageRef -> do
                  [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations (DrawState -> [AnyAnnotation]
annots DrawState
state') PDFReference PDFPage
pageRef
                  PDFReference PDFResource -> PDFReference PDFPage -> PDF ()
setPageResource PDFReference PDFResource
rsrcRef PDFReference PDFPage
pageRef
                  PDFDictionary -> PDF PDFDictionary
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return PDFDictionary
emptyDictionary
              
     PDFDocumentInfo
infos <- (PdfState -> PDFDocumentInfo) -> PDF PDFDocumentInfo
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFDocumentInfo
docInfo
     -- Resources to add to the stream
     -- We compress only if the stream is not using its own filter
     if (PDFDocumentInfo -> Bool
compressed PDFDocumentInfo
infos) Bool -> Bool -> Bool
&& (Bool -> Bool
not (PDFName -> PDFDictionary -> Bool
pdfDictMember (String -> PDFName
PDFName String
"Filter") PDFDictionary
resources))
       then do
         let w''' :: ByteString
w''' = ByteString -> ByteString
compress (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
w'
             w'' :: Builder
w'' = ByteString -> Builder
fromLazyByteString ByteString
w'''
         PDFReference PDFStream -> PDFStream -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (Int -> PDFReference PDFStream
forall s. Int -> PDFReference s
PDFReference Int
k :: PDFReference PDFStream) (Builder
-> Bool
-> Either (PDFReference MaybeLength) PDFLength
-> PDFDictionary
-> PDFStream
PDFStream Builder
w'' Bool
True (PDFReference MaybeLength
-> Either (PDFReference MaybeLength) PDFLength
forall a b. a -> Either a b
Left PDFReference MaybeLength
ref) PDFDictionary
resources)
         PDFReference MaybeLength -> MaybeLength -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference MaybeLength
ref MaybeLength
UnknownLength
         --updateObject ref (PDFLength (B.length w'''))
       else do
         PDFReference PDFStream -> PDFStream -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (Int -> PDFReference PDFStream
forall s. Int -> PDFReference s
PDFReference Int
k :: PDFReference PDFStream) (Builder
-> Bool
-> Either (PDFReference MaybeLength) PDFLength
-> PDFDictionary
-> PDFStream
PDFStream Builder
w' Bool
False (PDFReference MaybeLength
-> Either (PDFReference MaybeLength) PDFLength
forall a b. a -> Either a b
Left PDFReference MaybeLength
ref) PDFDictionary
resources)
         PDFReference MaybeLength -> MaybeLength -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference MaybeLength
ref MaybeLength
UnknownLength
         --updateObject ref (PDFLength (B.length . toLazyByteString $ w'))

-- | Save all the pages and streams in the main object dictionary
saveObjects :: PDF (PDFReference PDFCatalog)
saveObjects :: PDF (PDFReference PDFCatalog)
saveObjects  = do
  -- Save streams to the object dictionary so that they are saved in the PDF document
  PDF ()
createStreams
  PDFDocumentInfo
infos <- (PdfState -> PDFDocumentInfo) -> PDF PDFDocumentInfo
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFDocumentInfo
docInfo
  -- Save pages to the object dictionary so that they are saved in the PDF document
  PDFReference PDFPages
pRef <- PDF (PDFReference PDFPages)
addPages
  -- Create outlines object
  Maybe Outline
o <- (PdfState -> Maybe Outline) -> PDF (Maybe Outline)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe Outline
outline
  Maybe (PDFReference PDFOutline)
oref <- Maybe Outline -> PDF (Maybe (PDFReference PDFOutline))
addOutlines Maybe Outline
o
  -- Create the catalog
  PDFReference PDFCatalog
cat <- PDFCatalog -> PDF (PDFReference PDFCatalog)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (PDFCatalog -> PDF (PDFReference PDFCatalog))
-> PDFCatalog -> PDF (PDFReference PDFCatalog)
forall a b. (a -> b) -> a -> b
$ Maybe (PDFReference PDFOutline)
-> PDFReference PDFPages
-> PDFDocumentPageMode
-> PDFDocumentPageLayout
-> PDFViewerPreferences
-> PDFCatalog
PDFCatalog Maybe (PDFReference PDFOutline)
oref PDFReference PDFPages
pRef (PDFDocumentInfo -> PDFDocumentPageMode
pageMode PDFDocumentInfo
infos) (PDFDocumentInfo -> PDFDocumentPageLayout
pageLayout PDFDocumentInfo
infos) (PDFDocumentInfo -> PDFViewerPreferences
viewerPreferences PDFDocumentInfo
infos)
  (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {catalog = cat}
  (PdfState -> PDFReference PDFCatalog)
-> PDF (PDFReference PDFCatalog)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFReference PDFCatalog
catalog

-- | The PDFTrailer
#ifndef __HADDOCK__
data PDFTrailer = PDFTrailer 
  !Int -- Number of PDF objects in the document
  !(PDFReference PDFCatalog) -- Reference to the PDf catalog
  !(PDFDocumentInfo)
#else
data PDFTrailer
#endif
    
instance PdfObject PDFTrailer where
   toPDF :: PDFTrailer -> Builder
toPDF (PDFTrailer Int
size PDFReference PDFCatalog
root PDFDocumentInfo
infos) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
     [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Size" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
forall a b. (a -> b) -> a -> b
$ Int
size)
     , String -> PDFReference PDFCatalog -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Root" PDFReference PDFCatalog
root
     , String -> PDFDictionary -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Info" ([(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [(PDFName, AnyPdfObject)]
allInfos)
     ]
     where
      allInfos :: [(PDFName, AnyPdfObject)]
allInfos = [ String -> PDFString -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Author" (Text -> PDFString
toPDFString (Text -> PDFString)
-> (PDFDocumentInfo -> Text) -> PDFDocumentInfo -> PDFString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentInfo -> Text
author (PDFDocumentInfo -> PDFString) -> PDFDocumentInfo -> PDFString
forall a b. (a -> b) -> a -> b
$ PDFDocumentInfo
infos)
                 , String -> PDFString -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Subject" (Text -> PDFString
toPDFString (Text -> PDFString)
-> (PDFDocumentInfo -> Text) -> PDFDocumentInfo -> PDFString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentInfo -> Text
subject (PDFDocumentInfo -> PDFString) -> PDFDocumentInfo -> PDFString
forall a b. (a -> b) -> a -> b
$ PDFDocumentInfo
infos)
                 , String -> PDFString -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Producer" (Text -> PDFString
toPDFString (String -> Text
T.pack String
"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])
writeObjectsAndCreateToc :: [Builder] -> (Int, Int64, [Builder])
writeObjectsAndCreateToc [Builder]
l = 
   let lengths :: [Int64]
lengths =  [Int64] -> [Int64]
forall a. HasCallStack => [a] -> [a]
tail ([Int64] -> [Int64])
-> ([Builder] -> [Int64]) -> [Builder] -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Builder -> Int64) -> Int64 -> [Builder] -> [Int64]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int64
len Builder
obj -> Int64
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (ByteString -> Int64
B.length (ByteString -> Int64)
-> (Builder -> ByteString) -> Builder -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> Int64) -> Builder -> Int64
forall a b. (a -> b) -> a -> b
$ Builder
obj)) Int64
0 ([Builder] -> [Int64]) -> [Builder] -> [Int64]
forall a b. (a -> b) -> a -> b
$ [Builder]
l
       createEntry :: a -> s
createEntry a
x = String -> s
forall s a. SerializeValue s a => a -> s
serialize (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$ (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%010d 00000 n \n" ((a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)::Integer) :: String)
       entries :: [Builder]
entries = (Int64 -> Builder) -> [Int64] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> Builder
forall {s} {a}. (SerializeValue s String, Integral a) => a -> s
createEntry ([Int64] -> [Int64]
forall a. HasCallStack => [a] -> [a]
init [Int64]
lengths) 
   in
   ([Builder] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
l,[Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
lengths,[Builder]
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 :: PDFReference PDFCatalog -> PDFDocumentInfo -> Int -> Int64 -> [Builder]
                -> [Builder] -> B.ByteString
generateStreams :: PDFReference PDFCatalog
-> PDFDocumentInfo
-> Int
-> Int64
-> [Builder]
-> [Builder]
-> ByteString
generateStreams PDFReference PDFCatalog
root PDFDocumentInfo
di !Int
nb !Int64
totalLen [Builder]
ens [] = 
  let entries :: [Builder]
entries = [Builder] -> [Builder]
forall a. [a] -> [a]
reverse ([Builder] -> [Builder]
forall a. HasCallStack => [a] -> [a]
tail [Builder]
ens)  
  in
  Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"xref\n"
                               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String
"0 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"0000000000 65535 f \n"
                               ]
                               [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++
                               [Builder]
entries
                               [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++
                               [ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\ntrailer\n"
                               , PDFTrailer -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFTrailer -> Builder) -> PDFTrailer -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> PDFReference PDFCatalog -> PDFDocumentInfo -> PDFTrailer
PDFTrailer Int
nb PDFReference PDFCatalog
root PDFDocumentInfo
di
                               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\nstartxref\n"
                               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (Int64 -> String
forall a. Show a => a -> String
show Int64
totalLen)
                               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n%%EOF"
                             ]
generateStreams PDFReference PDFCatalog
root PDFDocumentInfo
di !Int
nb !Int64
totalLen [Builder]
ens (Builder
obj:[Builder]
t) = 
     let s :: ByteString
s = Builder -> ByteString
toLazyByteString Builder
obj 
         createEntry :: a -> s
createEntry a
x = String -> s
forall s a. SerializeValue s a => a -> s
serialize (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$ (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%010d 00000 n \n" ((a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)::Integer) :: String) 
         newLen :: Int64
newLen = ByteString -> Int64
B.length ByteString
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
totalLen
         en :: Builder
en = Int64 -> Builder
forall {s} {a}. (SerializeValue s String, Integral a) => a -> s
createEntry (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$! Int64
newLen
     in
     (ByteString
s ByteString -> ByteString -> ByteString
`B.append`) (ByteString -> ByteString)
-> ([Builder] -> ByteString) -> [Builder] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFReference PDFCatalog
-> PDFDocumentInfo
-> Int
-> Int64
-> [Builder]
-> [Builder]
-> ByteString
generateStreams PDFReference PDFCatalog
root PDFDocumentInfo
di (Int
nbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int64
newLen (Builder
en Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
ens) ([Builder] -> ByteString) -> [Builder] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder]
t

defaultPdfSettings :: PdfState
defaultPdfSettings :: PdfState
defaultPdfSettings = 
  PdfState {
             supplySrc :: Int
supplySrc = Int
1
           , objects :: IntMap AnyPdfObject
objects = IntMap AnyPdfObject
forall a. IntMap a
IM.empty
           , pages :: Pages
pages = Pages
noPages
           , streams :: IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams = IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
forall a. IntMap a
IM.empty
           , catalog :: PDFReference PDFCatalog
catalog = Int -> PDFReference PDFCatalog
forall s. Int -> PDFReference s
PDFReference Int
0
           , defaultRect :: PDFRect
defaultRect = PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> PDFRect
PDFRect PDFFloat
0 PDFFloat
0 PDFFloat
600 PDFFloat
400 
           , docInfo :: PDFDocumentInfo
docInfo = PDFDocumentInfo
standardDocInfo { author=T.pack "Unknown", compressed = True}
           , outline :: Maybe Outline
outline = Maybe Outline
forall a. Maybe a
Nothing
           , currentPage :: Maybe (PDFReference PDFPage)
currentPage = Maybe (PDFReference PDFPage)
forall a. Maybe a
Nothing
           , xobjectBound :: IntMap (PDFFloat, PDFFloat)
xobjectBound = IntMap (PDFFloat, PDFFloat)
forall a. IntMap a
IM.empty
           , firstOutline :: [Bool]
firstOutline = [Bool
True]
           }

createObjectByteStrings :: PdfState -> PDF a -> B.ByteString 
createObjectByteStrings :: forall a. PdfState -> PDF a -> ByteString
createObjectByteStrings PdfState
pdfState PDF a
m =
      let header :: Builder
header = String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"%PDF-1.5\n"
          objectEncoding :: (a, b) -> Builder
objectEncoding (a
x,b
a) = PDFReferencedObject b -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFReferencedObject b -> Builder)
-> (b -> PDFReferencedObject b) -> b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> PDFReferencedObject b
forall a. Int -> a -> PDFReferencedObject a
PDFReferencedObject (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$! a
x) (b -> Builder) -> b -> Builder
forall a b. (a -> b) -> a -> b
$ b
a
          (PDFReference PDFCatalog
root,PdfState
s) = (State PdfState (PDFReference PDFCatalog)
 -> PdfState -> (PDFReference PDFCatalog, PdfState))
-> PdfState
-> State PdfState (PDFReference PDFCatalog)
-> (PDFReference PDFCatalog, PdfState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State PdfState (PDFReference PDFCatalog)
-> PdfState -> (PDFReference PDFCatalog, PdfState)
forall s a. State s a -> s -> (a, s)
runState PdfState
pdfState  (State PdfState (PDFReference PDFCatalog)
 -> (PDFReference PDFCatalog, PdfState))
-> (PDF (PDFReference PDFCatalog)
    -> State PdfState (PDFReference PDFCatalog))
-> PDF (PDFReference PDFCatalog)
-> (PDFReference PDFCatalog, PdfState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDF (PDFReference PDFCatalog)
-> State PdfState (PDFReference PDFCatalog)
forall a. PDF a -> State PdfState a
unPDF (PDF (PDFReference PDFCatalog)
 -> (PDFReference PDFCatalog, PdfState))
-> PDF (PDFReference PDFCatalog)
-> (PDFReference PDFCatalog, PdfState)
forall a b. (a -> b) -> a -> b
$ PDF ()
createPDF PDF () -> PDF a -> PDF a
forall a b. PDF a -> PDF b -> PDF b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PDF a
m PDF a
-> PDF (PDFReference PDFCatalog) -> PDF (PDFReference PDFCatalog)
forall a b. PDF a -> PDF b -> PDF b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PDF (PDFReference PDFCatalog)
saveObjects
          objs :: IntMap AnyPdfObject
objs = PdfState -> IntMap AnyPdfObject
objects PdfState
s
          encodeAnObject :: IntMap AnyPdfObject -> Int -> (IntMap AnyPdfObject, Builder)
encodeAnObject IntMap AnyPdfObject
im Int
k =
            let Just AnyPdfObject
o = Int -> IntMap AnyPdfObject -> Maybe AnyPdfObject
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap AnyPdfObject
im
                mim :: Maybe (IntMap AnyPdfObject)
mim = do
                    (PDFLength
l, PDFReference Int
ref) <- AnyPdfObject -> Maybe (PDFLength, PDFReference MaybeLength)
forall a.
PdfLengthInfo a =>
a -> Maybe (PDFLength, PDFReference MaybeLength)
pdfLengthInfo AnyPdfObject
o
                    IntMap AnyPdfObject -> Maybe (IntMap AnyPdfObject)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap AnyPdfObject -> Maybe (IntMap AnyPdfObject))
-> IntMap AnyPdfObject -> Maybe (IntMap AnyPdfObject)
forall a b. (a -> b) -> a -> b
$ Int -> AnyPdfObject -> IntMap AnyPdfObject -> IntMap AnyPdfObject
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
ref (MaybeLength -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFLength -> MaybeLength
KnownLength PDFLength
l)) IntMap AnyPdfObject
im
            in (IntMap AnyPdfObject
-> Maybe (IntMap AnyPdfObject) -> IntMap AnyPdfObject
forall a. a -> Maybe a -> a
fromMaybe IntMap AnyPdfObject
im Maybe (IntMap AnyPdfObject)
mim, (Int, AnyPdfObject) -> Builder
forall {b} {a}. (PdfObject b, Integral a) => (a, b) -> Builder
objectEncoding (Int
k,AnyPdfObject
o))

          encodedObjects :: [Builder]
encodedObjects = (IntMap AnyPdfObject, [Builder]) -> [Builder]
forall a b. (a, b) -> b
snd ((IntMap AnyPdfObject, [Builder]) -> [Builder])
-> (IntMap AnyPdfObject, [Builder]) -> [Builder]
forall a b. (a -> b) -> a -> b
$ (IntMap AnyPdfObject -> Int -> (IntMap AnyPdfObject, Builder))
-> IntMap AnyPdfObject -> [Int] -> (IntMap AnyPdfObject, [Builder])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL IntMap AnyPdfObject -> Int -> (IntMap AnyPdfObject, Builder)
encodeAnObject IntMap AnyPdfObject
objs (IntMap AnyPdfObject -> [Int]
forall a. IntMap a -> [Int]
IM.keys IntMap AnyPdfObject
objs)
          objectContents :: [Builder]
objectContents = Builder
header Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
encodedObjects
          (Int
_nb, Int64
_len, [Builder]
_toc) = [Builder] -> (Int, Int64, [Builder])
writeObjectsAndCreateToc [Builder]
objectContents
      in
      PDFReference PDFCatalog
-> PDFDocumentInfo
-> Int
-> Int64
-> [Builder]
-> [Builder]
-> ByteString
generateStreams PDFReference PDFCatalog
root (PdfState -> PDFDocumentInfo
docInfo PdfState
pdfState) Int
0 Int64
0 [] [Builder]
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
              -> PDF a  -- ^ PDF action 
              -> B.ByteString
pdfByteString :: forall a. PDFDocumentInfo -> PDFRect -> PDF a -> ByteString
pdfByteString PDFDocumentInfo
infos PDFRect
rect PDF a
m = PdfState -> PDF a -> ByteString
forall a. PdfState -> PDF a -> ByteString
createObjectByteStrings (PdfState
defaultPdfSettings {defaultRect = rect, docInfo = infos} ) PDF a
m

-- | Generates a PDF document
runPdf :: String -- ^ Name of the PDF document
       -> PDFDocumentInfo
       -> PDFRect -- ^ Default size for a page
       -> PDF a  -- ^ PDF action 
       -> IO ()
runPdf :: forall a. String -> PDFDocumentInfo -> PDFRect -> PDF a -> IO ()
runPdf String
filename PDFDocumentInfo
infos PDFRect
rect PDF a
m = do
  let bytestring :: ByteString
bytestring = PDFDocumentInfo -> PDFRect -> PDF a -> ByteString
forall a. PDFDocumentInfo -> PDFRect -> PDF a -> ByteString
pdfByteString PDFDocumentInfo
infos PDFRect
rect PDF a
m 
  String -> ByteString -> IO ()
B.writeFile String
filename ByteString
bytestring