module Graphics.PDF
(
PDF
, runPdf
, PDFRect(..)
, PDFFloat
, PDFReference
, PDFString
, PDFPage
, Pages
, module Graphics.PDF.Document
, module Graphics.PDF.Shapes
, module Graphics.PDF.Colors
, module Graphics.PDF.Coordinates
, applyMatrix
, module Graphics.PDF.Text
, module Graphics.PDF.Navigation
, module Graphics.PDF.Annotation
, module Graphics.PDF.Action
, module Graphics.PDF.Image
, module Graphics.PDF.Pattern
, module Graphics.PDF.Shading
, module Graphics.PDF.Typesetting
, module Graphics.PDF.Hyphenate
) where
import Graphics.PDF.Hyphenate
import Graphics.PDF.Typesetting
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.Map as M
import qualified Data.ByteString.Lazy as B
import Data.Int
import System.IO
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
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.Monoid
createPDF :: PDF ()
createPDF = do
return ()
createStreams :: PDF ()
createStreams = do
ls <- gets streams >>= return . IM.toList
modifyStrict $ \s -> s {streams = IM.empty}
mapM_ addStream ls
where
addStream (k,(p,(state',w'))) = do
r <- supply
let ref = PDFReference r :: PDFReference PDFLength
resources <- if (emptyResource (rsrc state')) && (not (pdfDictMember (PDFName "PatternType") (otherRsrcs state')))
then do
case p of
Nothing -> return (otherRsrcs state')
Just pageRef -> do
setPageAnnotations (annots state') pageRef
return emptyDictionary
else do
rsrcRef <- addObject (rsrc state')
case p of
Nothing -> do
return $ (otherRsrcs state') `pdfDictUnion` (PDFDictionary . M.fromList $ [(PDFName "Resources",AnyPdfObject rsrcRef)])
Just pageRef -> do
setPageAnnotations (annots state') pageRef
setPageResource rsrcRef pageRef
return emptyDictionary
infos <- gets docInfo
if (compressed infos) && (not (pdfDictMember (PDFName "Filter") resources))
then do
let w''' = compress . toLazyByteString $ w'
w'' = fromLazyByteString w'''
updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w'' True ref resources)
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'))
saveObjects :: PDF (PDFReference PDFCatalog)
saveObjects = do
createStreams
infos <- gets docInfo
pRef <- addPages
o <- gets outline
oref <- addOutlines o
cat <- addObject $ PDFCatalog oref pRef (pageMode infos) (pageLayout infos) (viewerPreferences infos)
modifyStrict $ \s -> s {catalog = cat}
gets catalog
#ifndef __HADDOCK__
data PDFTrailer = PDFTrailer
!Int
!(PDFReference PDFCatalog)
!(PDFDocumentInfo)
#else
data PDFTrailer
#endif
instance PdfObject PDFTrailer where
toPDF (PDFTrailer size root infos) = toPDF $ PDFDictionary. M.fromList $
[ (PDFName "Size",AnyPdfObject . PDFInteger $ size)
, (PDFName "Root",AnyPdfObject root)
, (PDFName "Info",AnyPdfObject . PDFDictionary . M.fromList $ allInfos)
]
where
allInfos = [ (PDFName "Author",AnyPdfObject . author $ infos)
, (PDFName "Subject",AnyPdfObject . subject $ infos)
, (PDFName "Producer",AnyPdfObject $ toPDFString "HPDF - The Haskell PDF Library" )
]
writeObjectsAndCreateToc :: [Builder]
-> (Int,Int64,[Builder])
writeObjectsAndCreateToc l =
let lengths = tail . scanl (\len obj -> len + (B.length . toLazyByteString $ obj)) 0 $ l
createEntry x = serialize $ (printf "%010d 00000 n \n" ((fromIntegral x)::Integer) :: String)
entries = map createEntry (init lengths)
in
(length l,last lengths,entries)
defaultPdfSettings :: PdfState
defaultPdfSettings =
PdfState {
supplySrc = 1
, objects = IM.empty
, pages = noPages
, streams = IM.empty
, catalog = PDFReference 0
, defaultRect = PDFRect 0 0 600 400
, docInfo = standardDocInfo { author=toPDFString "Unknown", compressed = True}
, outline = Nothing
, currentPage = Nothing
, xobjectBound = IM.empty
, firstOutline = [True]
}
createObjectByteStrings :: PdfState -> PDF a -> Builder
createObjectByteStrings pdfState m =
let header = serialize "%PDF-1.5\n"
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)
(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"
]
runPdf :: String
-> PDFDocumentInfo
-> PDFRect
-> PDF a
-> IO ()
runPdf filename infos rect m = do
let content = createObjectByteStrings (defaultPdfSettings {defaultRect = rect, docInfo = infos} ) m
B.writeFile filename (toLazyByteString content)