---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Management of the PDF structure
---------------------------------------------------------
{-# LANGUAGE CPP #-}
module Graphics.PDF.Document(
 -- * Document actions
 -- ** Special document objects
   PDFXForm
 -- ** Page management
 , addPage
 , addPageWithTransition
 , drawWithPage
 , createPDFXForm
 , createPDFXFormExtra
 -- ** Page transitions
 , PDFTransition(..)
 , PDFTransStyle(..)
 , PDFTransDirection(..)
 , PDFTransDimension(..)
 , PDFTransDirection2(..)
 -- ** Document information
 , PDFDocumentInfo(..)
 , PDFDocumentPageMode(..)
 , PDFDocumentPageLayout(..)
 , PDFViewerPreferences(..)
 , standardDocInfo
 , standardViewerPrefs
 -- * Draw monad and drawing functions
 -- ** Types
 , Draw
 , PDFXObject(drawXObject)
 , PDFGlobals(..)
 -- ** General drawing functions
 , withNewContext
 , emptyDrawing
 ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif

import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Pages
import Graphics.PDF.Shapes (Rectangle(Rectangle))
import Control.Monad.State
import qualified Data.IntMap as IM
import qualified Data.Text as T
import Data.Complex (Complex((:+)))

-- | No information for the document  
standardDocInfo :: PDFDocumentInfo          
standardDocInfo :: PDFDocumentInfo
standardDocInfo = Text
-> Text
-> PDFDocumentPageMode
-> PDFDocumentPageLayout
-> PDFViewerPreferences
-> Bool
-> PDFDocumentInfo
PDFDocumentInfo Text
T.empty Text
T.empty PDFDocumentPageMode
UseNone PDFDocumentPageLayout
SinglePage PDFViewerPreferences
standardViewerPrefs Bool
True

-- | Create a PDF XObject
createPDFXForm :: PDFFloat -- ^ Left
              -> PDFFloat -- ^ Bottom
              -> PDFFloat -- ^ Right
              -> PDFFloat -- ^ Top
              -> Draw a -- ^ Drawing commands
              -> PDF (PDFReference PDFXForm)
createPDFXForm :: forall a.
PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> Draw a
-> PDF (PDFReference PDFXForm)
createPDFXForm PDFFloat
xa PDFFloat
ya PDFFloat
xb PDFFloat
yb Draw a
d =
    Rectangle -> Draw a -> PDFDictionary -> PDF (PDFReference PDFXForm)
forall a.
Rectangle -> Draw a -> PDFDictionary -> PDF (PDFReference PDFXForm)
createPDFXFormExtra (Point -> Point -> Rectangle
Rectangle (PDFFloat
xaPDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+PDFFloat
ya) (PDFFloat
xbPDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+PDFFloat
yb)) Draw a
d PDFDictionary
emptyDictionary

-- | Create a PDF XObject
createPDFXFormExtra ::
                 Rectangle -- ^ Bounding Box
              -> Draw a -- ^ Drawing commands
              -> PDFDictionary
              -> PDF (PDFReference PDFXForm)
createPDFXFormExtra :: forall a.
Rectangle -> Draw a -> PDFDictionary -> PDF (PDFReference PDFXForm)
createPDFXFormExtra (Rectangle (PDFFloat
xa:+PDFFloat
ya) (PDFFloat
xb:+PDFFloat
yb)) Draw a
d PDFDictionary
dict =
 let a' :: Draw a
a' = do
            (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {
                otherRsrcs = pdfDictUnion dict $ dictFromList $
                    [ entry "Type" (PDFName $ "XObject")
                    , entry "Subtype" (PDFName $ "Form")
                    , entry "FormType" (PDFInteger $ 1)
                    , entry "Matrix" (map PDFInteger $ [1,0,0,1,0,0])
                    , entry "BBox" (map AnyPdfObject $ [xa,ya,xb,yb])
                    ]
              }
            Draw a
d
 in do
     PDFReference Int
s <- Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw a
a' Maybe (PDFReference PDFPage)
forall a. Maybe a
Nothing  
     Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
s (PDFFloat
xbPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
xa) (PDFFloat
ybPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
ya)
     PDFReference PDFXForm -> PDF (PDFReference PDFXForm)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PDFReference PDFXForm
forall s. Int -> PDFReference s
PDFReference Int
s)       

 
-- Create a new empty page
createANewPage :: Maybe PDFRect -- ^ Page size or default document's one
               -> PDF (Int,PDFPage) -- ^ Reference to the new page
createANewPage :: Maybe PDFRect -> PDF (Int, PDFPage)
createANewPage Maybe PDFRect
rect' = do
       PDFRect
rect <- PDF PDFRect
-> (PDFRect -> PDF PDFRect) -> Maybe PDFRect -> PDF PDFRect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((PdfState -> PDFRect) -> PDF PDFRect
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> PDFRect
defaultRect) PDFRect -> PDF PDFRect
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PDFRect
rect'
       -- Get the root page reference
       -- Create a new page reference
       Int
pageref <- PDF Int
supply
       -- Create a new empty content for the page
       PDFReference PDFStream
pageContent <- Draw ()
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent (() -> Draw ()
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (PDFReference PDFPage -> Maybe (PDFReference PDFPage)
forall a. a -> Maybe a
Just (Int -> PDFReference PDFPage
forall s. Int -> PDFReference s
PDFReference Int
pageref :: PDFReference PDFPage))
       -- Create a new page having as parent the root page
       let page :: PDFPage
page = Maybe (PDFReference PDFPages)
-> PDFRect
-> PDFReference PDFStream
-> Maybe (PDFReference PDFResource)
-> Maybe PDFFloat
-> Maybe PDFTransition
-> [AnyPdfObject]
-> PDFPage
PDFPage Maybe (PDFReference PDFPages)
forall a. Maybe a
Nothing PDFRect
rect PDFReference PDFStream
pageContent Maybe (PDFReference PDFResource)
forall a. Maybe a
Nothing Maybe PDFFloat
forall a. Maybe a
Nothing Maybe PDFTransition
forall a. Maybe a
Nothing []
       (Int, PDFPage) -> PDF (Int, PDFPage)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pageref , PDFPage
page)
       
-- | Add a new page to a PDF document
addPage :: Maybe PDFRect -- ^ Page size or default document's one
        -> PDF (PDFReference PDFPage) -- ^ Reference to the new page
addPage :: Maybe PDFRect -> PDF (PDFReference PDFPage)
addPage Maybe PDFRect
rect'   = do
   (Int
pf,PDFPage
page) <- Maybe PDFRect -> PDF (Int, PDFPage)
createANewPage Maybe PDFRect
rect'
   let pageref :: PDFReference s
pageref = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference Int
pf
   (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 {pages = recordPage pageref page (pages s), currentPage = Just pageref}
   PDFReference PDFPage -> PDF (PDFReference PDFPage)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return PDFReference PDFPage
forall {s}. PDFReference s
pageref
   
addPageWithTransition :: Maybe PDFRect -- ^ Page size or default document's one
                      -> Maybe PDFFloat -- ^ Optional duration
                      -> Maybe PDFTransition -- ^ Optional transition
                      -> PDF (PDFReference PDFPage) -- ^ Reference to the new page
addPageWithTransition :: Maybe PDFRect
-> Maybe PDFFloat
-> Maybe PDFTransition
-> PDF (PDFReference PDFPage)
addPageWithTransition Maybe PDFRect
rect' Maybe PDFFloat
dur Maybe PDFTransition
t = do
    (Int
pf,PDFPage Maybe (PDFReference PDFPages)
a PDFRect
b PDFReference PDFStream
c Maybe (PDFReference PDFResource)
d Maybe PDFFloat
_ Maybe PDFTransition
_ [AnyPdfObject]
pageAnnots) <- Maybe PDFRect -> PDF (Int, PDFPage)
createANewPage Maybe PDFRect
rect'
    let pageref :: PDFReference s
pageref = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference Int
pf
    (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 {pages = recordPage pageref (PDFPage a b c d dur t pageAnnots) (pages s), currentPage = Just pageref}
    PDFReference PDFPage -> PDF (PDFReference PDFPage)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return PDFReference PDFPage
forall {s}. PDFReference s
pageref

        
-- | Draw on a given page
drawWithPage :: PDFReference PDFPage -- ^ Page
            -> Draw a -- ^ Drawing commands
            -> PDF a
drawWithPage :: forall a. PDFReference PDFPage -> Draw a -> PDF a
drawWithPage PDFReference PDFPage
page Draw a
draw = do
     -- Get the page dictionary
     Pages
lPages <- (PdfState -> Pages) -> PDF Pages
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
     -- Get the stream dictionary
     IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
lStreams <- (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
     -- Look for the page
     let thePage :: Maybe PDFPage
thePage = PDFReference PDFPage -> Pages -> Maybe PDFPage
findPage PDFReference PDFPage
page Pages
lPages
     case Maybe PDFPage
thePage of
       Maybe PDFPage
Nothing -> String -> PDF a
forall a. HasCallStack => String -> a
error String
"Can't find the page to draw on it"
       -- If the page is found, get its stream reference and look for the stream
       Just(PDFPage Maybe (PDFReference PDFPages)
_ PDFRect
_ (PDFReference Int
streamRef) Maybe (PDFReference PDFResource)
_ Maybe PDFFloat
_ Maybe PDFTransition
_ [AnyPdfObject]
_) -> do
          let theContent :: Maybe (Maybe (PDFReference PDFPage), (DrawState, Builder))
theContent = Int
-> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
-> Maybe (Maybe (PDFReference PDFPage), (DrawState, Builder))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
streamRef IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
lStreams
          case Maybe (Maybe (PDFReference PDFPage), (DrawState, Builder))
theContent of
            Maybe (Maybe (PDFReference PDFPage), (DrawState, Builder))
Nothing -> String -> PDF a
forall a. HasCallStack => String -> a
error String
"Can't find a content for the page to draw on it"
            -- If the stream is found
            Just (Maybe (PDFReference PDFPage)
_,(DrawState
oldState,Builder
oldW)) -> do
              -- Create a new cntent and update the stream
              IntMap (PDFFloat, PDFFloat)
myBounds <- (PdfState -> IntMap (PDFFloat, PDFFloat))
-> PDF (IntMap (PDFFloat, PDFFloat))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> IntMap (PDFFloat, PDFFloat)
xobjectBound
              let (a
a,DrawState
state',Builder
w') = Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
forall a.
Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
runDrawing Draw a
draw (DrawEnvironment
emptyEnvironment {streamId = streamRef, xobjectBoundD = myBounds}) DrawState
oldState
              (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.insert streamRef (Just page,(state',mappend oldW w')) lStreams}
              a -> PDF a
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a