---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Low level page management
---------------------------------------------------------
-- #hide
module Graphics.PDF.Pages(
 -- * Low level stuff
 -- ** Document management
   standardViewerPrefs
 -- ** Page management
 , findPage
 , recordPage
 , noPages
 , addPages
 , getCurrentPage
 -- ** PDF Object management
 , addObject
 , supply
 , updateObject
 , addOutlines
 , insertDown
 , insertRight
 , up
 , createContent
 , recordBound
 , setPageResource
 , setPageAnnotations
 , readType1Font
 , mkType1Font
 ) where
     
import qualified Data.IntMap as IM
import Control.Monad.State
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import qualified Graphics.PDF.Data.PDFTree as PT hiding(PDFTree,Key)
import Graphics.PDF.Resources
import Data.List(zip4)
import Graphics.PDF.Fonts.Font
import Graphics.PDF.Data.PDFTree(PDFTree,Key)
import Control.Monad.Writer 
import Data.Binary.Builder(fromByteString)
import Graphics.PDF.Fonts.FontTypes(FontData(..))
import Graphics.PDF.Fonts.Type1 
import Text.Parsec.Error (ParseError)

-- | Set page annotations
setPageAnnotations :: [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations :: [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations [AnyAnnotation]
an PDFReference PDFPage
page = do
    -- Get the page dictionary
    Pages
lPages <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
    -- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       -- If the page is found, get its stream reference and look for the stream
       Just (PDFPage Maybe (PDFReference PDFPages)
a PDFRect
b PDFReference PDFStream
c Maybe (PDFReference PDFResource)
d Maybe PDFFloat
e Maybe PDFTransition
f [AnyPdfObject]
_) -> do
           [AnyPdfObject]
refs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\AnyAnnotation
x -> forall a. AnnotationObject a => a -> PDF (PDFReference a)
addAnnotation AnyAnnotation
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject) [AnyAnnotation]
an
           forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {pages :: Pages
pages = PDFReference PDFPage -> PDFPage -> Pages -> Pages
recordPage PDFReference PDFPage
page (Maybe (PDFReference PDFPages)
-> PDFRect
-> PDFReference PDFStream
-> Maybe (PDFReference PDFResource)
-> Maybe PDFFloat
-> Maybe PDFTransition
-> [AnyPdfObject]
-> PDFPage
PDFPage Maybe (PDFReference PDFPages)
a PDFRect
b PDFReference PDFStream
c Maybe (PDFReference PDFResource)
d Maybe PDFFloat
e Maybe PDFTransition
f [AnyPdfObject]
refs) Pages
lPages}
           
-- | Set page resource
setPageResource :: PDFReference PDFResource -> PDFReference PDFPage -> PDF ()
setPageResource :: PDFReference PDFResource -> PDFReference PDFPage -> PDF ()
setPageResource PDFReference PDFResource
newr PDFReference PDFPage
page = do
    -- Get the page dictionary
    Pages
lPages <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
    -- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- If the page is found, get its stream reference and look for the stream
        Just (PDFPage Maybe (PDFReference PDFPages)
a PDFRect
b PDFReference PDFStream
c Maybe (PDFReference PDFResource)
_ Maybe PDFFloat
e Maybe PDFTransition
f [AnyPdfObject]
g) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {pages :: Pages
pages = PDFReference PDFPage -> PDFPage -> Pages -> Pages
recordPage PDFReference PDFPage
page (Maybe (PDFReference PDFPages)
-> PDFRect
-> PDFReference PDFStream
-> Maybe (PDFReference PDFResource)
-> Maybe PDFFloat
-> Maybe PDFTransition
-> [AnyPdfObject]
-> PDFPage
PDFPage Maybe (PDFReference PDFPages)
a PDFRect
b PDFReference PDFStream
c (forall a. a -> Maybe a
Just PDFReference PDFResource
newr) Maybe PDFFloat
e Maybe PDFTransition
f [AnyPdfObject]
g) Pages
lPages}


-- | Create a new empty content for a page
createContent :: Draw a -- ^ List of drawing commands
              -> Maybe (PDFReference PDFPage)
              -> PDF (PDFReference PDFStream) -- ^ Reference to the drawing
createContent :: forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw a
d Maybe (PDFReference PDFPage)
page = do
  -- Create a new stream referenbce
  Int
streamref <- PDF Int
supply
  IntMap (PDFFloat, PDFFloat)
myBounds <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> IntMap (PDFFloat, PDFFloat)
xobjectBound
  let (a
_,DrawState
state',Builder
w') = forall a.
Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
runDrawing Draw a
d (DrawEnvironment
emptyEnvironment {streamId :: Int
streamId = Int
streamref, xobjectBoundD :: IntMap (PDFFloat, PDFFloat)
xobjectBoundD = IntMap (PDFFloat, PDFFloat)
myBounds}) (Int -> DrawState
emptyDrawState Int
streamref)
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {streams :: IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
streamref (Maybe (PDFReference PDFPage)
page,(DrawState
state',Builder
w')) (PdfState
-> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams PdfState
s)}
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
streamref)

-- | Returns a new unique identifier
supply :: PDF Int
supply :: PDF Int
supply = do
          Int
r <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Int
supplySrc
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {supplySrc :: Int
supplySrc = Int
rforall a. Num a => a -> a -> a
+Int
1}
          forall (m :: * -> *) a. Monad m => a -> m a
return Int
r
     
-- | Add an object to the PDF object dictionary and return a PDF reference     
addObject :: (PdfObject a, PdfLengthInfo a) => a -> PDF (PDFReference a)
addObject :: forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject a
a = do
  Int
r <- PDF Int
supply
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {objects :: IntMap AnyPdfObject
objects = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
r (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject a
a) (PdfState -> IntMap AnyPdfObject
objects PdfState
s)}
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
r)
  

-- | Update a referenced object with a new one
updateObject :: (PdfObject a, PdfLengthInfo a) => PDFReference a -- ^ Reference to the initial object
             -> a -- ^ New value
             -> PDF ()
updateObject :: forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (PDFReference Int
i) a
obj = do
   forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {objects :: IntMap AnyPdfObject
objects = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject a
obj) (PdfState -> IntMap AnyPdfObject
objects PdfState
s)}


                          

                  
standardViewerPrefs :: PDFViewerPreferences
standardViewerPrefs :: PDFViewerPreferences
standardViewerPrefs = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> PDFDocumentPageMode
-> PDFViewerPreferences
PDFViewerPreferences Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False PDFDocumentPageMode
UseNone


                        




-- | Record the page in the page catalog
recordPage :: PDFReference  PDFPage -- ^ Reference to the page
           -> PDFPage -- ^ Page content
           -> Pages -- ^ Pages n the documents
           -> Pages
recordPage :: PDFReference PDFPage -> PDFPage -> Pages -> Pages
recordPage PDFReference PDFPage
pageref PDFPage
page (Pages PDFTree PDFPage
lPages) = PDFTree PDFPage -> Pages
Pages (forall a. Key a -> a -> PDFTree a -> PDFTree a
PT.insert PDFReference PDFPage
pageref PDFPage
page PDFTree PDFPage
lPages)

-- | Find a page in the catalog
findPage :: PDFReference PDFPage -- ^ Reference to the page
         -> Pages -- ^ Pages in the document
         -> Maybe PDFPage -- ^ Page content if found
findPage :: PDFReference PDFPage -> Pages -> Maybe PDFPage
findPage PDFReference PDFPage
page (Pages PDFTree PDFPage
lPages) = forall a. Key a -> PDFTree a -> Maybe a
PT.lookup PDFReference PDFPage
page PDFTree PDFPage
lPages

-- | Add a node PDFTree object
nodePage :: Maybe (PDFReference PDFPages) -- ^ Parent node
         -> PDFTree PDFPage -- ^ Left tree
         -> PDFTree PDFPage -- ^ Right tree
         -> PDF (Int,PDFReference PDFPages) -- ^ PDF reference to the new node pointing to the left and right ones
nodePage :: Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
nodePage Maybe (PDFReference PDFPages)
ref PDFTree PDFPage
l PDFTree PDFPage
r = do
    Int
n <- PDF Int
supply
    -- Reserve an identifier for the root page object
    let pRef :: PDFReference PDFPages
pRef = (forall s. Int -> PDFReference s
PDFReference Int
n) :: PDFReference PDFPages
    (Int
sl,PDFReference PDFPages
lr) <- forall (m :: * -> *) b a.
Monad m =>
Maybe b
-> (Maybe b -> PDFTree a -> PDFTree a -> m (Int, b))
-> (Maybe b -> Key a -> a -> m (Int, b))
-> PDFTree a
-> m (Int, b)
PT.fold2 (forall a. a -> Maybe a
Just PDFReference PDFPages
pRef) Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
nodePage Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages)
leafPage PDFTree PDFPage
l
    (Int
sr,PDFReference PDFPages
rr) <- forall (m :: * -> *) b a.
Monad m =>
Maybe b
-> (Maybe b -> PDFTree a -> PDFTree a -> m (Int, b))
-> (Maybe b -> Key a -> a -> m (Int, b))
-> PDFTree a
-> m (Int, b)
PT.fold2 (forall a. a -> Maybe a
Just PDFReference PDFPages
pRef) Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
nodePage Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages)
leafPage PDFTree PDFPage
r
    let len :: Int
len = Int
sl forall a. Num a => a -> a -> a
+ Int
sr
    case (forall a. PDFTree a -> Bool
PT.isLeaf PDFTree PDFPage
l,forall a. PDFTree a -> Bool
PT.isLeaf PDFTree PDFPage
r) of
        (Bool
False,Bool
False) -> forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [forall a b. a -> Either a b
Left PDFReference PDFPages
lr,forall a b. a -> Either a b
Left PDFReference PDFPages
rr]
        (Bool
True,Bool
False) -> forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [forall a b. b -> Either a b
Right (forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
l),forall a b. a -> Either a b
Left PDFReference PDFPages
rr]
        (Bool
False,Bool
True) -> forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [forall a b. a -> Either a b
Left PDFReference PDFPages
lr,forall a b. b -> Either a b
Right (forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
r)]
        (Bool
True,Bool
True) -> forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [forall a b. b -> Either a b
Right (forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
l),forall a b. b -> Either a b
Right (forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
r)]
    forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len,PDFReference PDFPages
pRef)
        
  
-- | Add a page to the PDG object dictionary
leafPage :: Maybe (PDFReference PDFPages) -- ^ Page parent if any
         -> Key PDFPage -- ^ Page reference
         -> PDFPage -- ^ Page data
         -> PDF (Int,PDFReference PDFPages)  -- ^ Reference to a PDFPages objects
leafPage :: Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages)
leafPage (Just PDFReference PDFPages
ref) (PDFReference Int
objectnb) (PDFPage Maybe (PDFReference PDFPages)
_ PDFRect
a PDFReference PDFStream
b Maybe (PDFReference PDFResource)
c Maybe PDFFloat
d Maybe PDFTransition
e [AnyPdfObject]
f) = do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {objects :: IntMap AnyPdfObject
objects = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
objectnb (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ Maybe (PDFReference PDFPages)
-> PDFRect
-> PDFReference PDFStream
-> Maybe (PDFReference PDFResource)
-> Maybe PDFFloat
-> Maybe PDFTransition
-> [AnyPdfObject]
-> PDFPage
PDFPage (forall a. a -> Maybe a
Just PDFReference PDFPages
ref) PDFRect
a PDFReference PDFStream
b Maybe (PDFReference PDFResource)
c Maybe PDFFloat
d Maybe PDFTransition
e [AnyPdfObject]
f) (PdfState -> IntMap AnyPdfObject
objects PdfState
s) }
      forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1,PDFReference PDFPages
ref)
      
leafPage Maybe (PDFReference PDFPages)
Nothing p :: PDFReference PDFPage
p@(PDFReference Int
objectnb) (PDFPage Maybe (PDFReference PDFPages)
_ PDFRect
a PDFReference PDFStream
b Maybe (PDFReference PDFResource)
c Maybe PDFFloat
d Maybe PDFTransition
e [AnyPdfObject]
f) = do
     Int
n <- PDF Int
supply
     -- Reserve an identifier for the root page object
     let pRef :: PDFReference PDFPages
pRef = (forall s. Int -> PDFReference s
PDFReference Int
n) :: PDFReference PDFPages
     forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
1 forall a. Maybe a
Nothing [forall a b. b -> Either a b
Right PDFReference PDFPage
p]
     forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {objects :: IntMap AnyPdfObject
objects = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
objectnb (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ Maybe (PDFReference PDFPages)
-> PDFRect
-> PDFReference PDFStream
-> Maybe (PDFReference PDFResource)
-> Maybe PDFFloat
-> Maybe PDFTransition
-> [AnyPdfObject]
-> PDFPage
PDFPage (forall a. a -> Maybe a
Just PDFReference PDFPages
pRef) PDFRect
a PDFReference PDFStream
b Maybe (PDFReference PDFResource)
c Maybe PDFFloat
d Maybe PDFTransition
e [AnyPdfObject]
f) (PdfState -> IntMap AnyPdfObject
objects PdfState
s) }
     forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1,PDFReference PDFPages
pRef)   
                  
-- | Add all pages to the PDF object dictionary
addPages :: PDF (PDFReference PDFPages)
addPages :: PDF (PDFReference PDFPages)
addPages = do
    Pages PDFTree PDFPage
lPages <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
    (Int
_,PDFReference PDFPages
r) <- forall (m :: * -> *) b a.
Monad m =>
Maybe b
-> (Maybe b -> PDFTree a -> PDFTree a -> m (Int, b))
-> (Maybe b -> Key a -> a -> m (Int, b))
-> PDFTree a
-> m (Int, b)
PT.fold2 forall a. Maybe a
Nothing Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
nodePage Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages)
leafPage PDFTree PDFPage
lPages
    forall (m :: * -> *) a. Monad m => a -> m a
return PDFReference PDFPages
r
    
-- | Empty page catalog
noPages :: Pages
noPages :: Pages
noPages = PDFTree PDFPage -> Pages
Pages (forall a. PDFTree a
PT.empty)
      

-- insert a subtree to the right of the current node
insertRight :: a -> OutlineLoc a -> OutlineLoc a
insertRight :: forall a. a -> OutlineLoc a -> OutlineLoc a
insertRight a
_ (OutlineLoc Tree a
_ OutlineCtx a
Top) = forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot insert right of the top node"
insertRight a
t' (OutlineLoc Tree a
t OutlineCtx a
c  ) = let c' :: OutlineCtx a
c' = Child { value :: a
value = forall a. OutlineCtx a -> a
value OutlineCtx a
c
                                                   , parent :: OutlineCtx a
parent = forall a. OutlineCtx a -> OutlineCtx a
parent OutlineCtx a
c
                                                   , rights :: [Tree a]
rights = forall a. OutlineCtx a -> [Tree a]
rights OutlineCtx a
c
                                                   , lefts :: [Tree a]
lefts  = forall a. OutlineCtx a -> [Tree a]
lefts OutlineCtx a
c forall a. [a] -> [a] -> [a]
++ [Tree a
t] }
                               in forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc (forall a. a -> [Tree a] -> Tree a
Node a
t' []) OutlineCtx a
c'
                              
insertDown :: a -> OutlineLoc a -> OutlineLoc a
insertDown :: forall a. a -> OutlineLoc a -> OutlineLoc a
insertDown a
t' (OutlineLoc (Node a
v [Tree a]
cs) OutlineCtx a
c) = let c' :: OutlineCtx a
c' = Child { value :: a
value = a
v
                                                          , parent :: OutlineCtx a
parent = OutlineCtx a
c
                                                          , rights :: [Tree a]
rights = []
                                                          , lefts :: [Tree a]
lefts  = [Tree a]
cs 
                                                          }
                                in  forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc (forall a. a -> [Tree a] -> Tree a
Node a
t' []) OutlineCtx a
c'
                                
-- move up
up :: OutlineLoc a -> OutlineLoc a
up :: forall a. OutlineLoc a -> OutlineLoc a
up (OutlineLoc Tree a
_ OutlineCtx a
Top            ) = forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot go up from the top node"
up (OutlineLoc Tree a
t (Child a
v OutlineCtx a
c [Tree a]
ls [Tree a]
rs)) = let t' :: Tree a
t' = forall a. a -> [Tree a] -> Tree a
Node a
v  ([Tree a]
ls forall a. [a] -> [a] -> [a]
++ [Tree a
t] forall a. [a] -> [a] -> [a]
++ [Tree a]
rs)
                                  in forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc Tree a
t' OutlineCtx a
c
                              

addOutlines :: Maybe Outline -> PDF (Maybe (PDFReference PDFOutline))
addOutlines :: Maybe Outline -> PDF (Maybe (PDFReference PDFOutline))
addOutlines Maybe Outline
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
addOutlines (Just Outline
r) = do
  let (Node OutlineData
_ [Tree OutlineData]
l) = forall a. OutlineLoc a -> Tree a
toTree Outline
r
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree OutlineData]
l
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else do
      Int
rootRef <- PDF Int
supply
      (PDFReference PDFOutlineEntry
first,PDFReference PDFOutlineEntry
end) <- PDFReference PDFOutlineEntry
-> [Tree OutlineData]
-> PDF (PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
createOutline (forall s. Int -> PDFReference s
PDFReference Int
rootRef) [Tree OutlineData]
l
      let outlineCatalog :: PDFOutline
outlineCatalog = PDFReference PDFOutlineEntry
-> PDFReference PDFOutlineEntry -> PDFOutline
PDFOutline PDFReference PDFOutlineEntry
first PDFReference PDFOutlineEntry
end
      forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (forall s. Int -> PDFReference s
PDFReference Int
rootRef) PDFOutline
outlineCatalog
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall s. Int -> PDFReference s
PDFReference Int
rootRef))
      
 
createOutline :: PDFReference PDFOutlineEntry -> [Tree OutlineData] -> PDF (PDFReference PDFOutlineEntry,PDFReference PDFOutlineEntry)
createOutline :: PDFReference PDFOutlineEntry
-> [Tree OutlineData]
-> PDF (PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
createOutline PDFReference PDFOutlineEntry
r [Tree OutlineData]
children = do
    -- Get references for all these outlines
    [Maybe (PDFReference PDFOutlineEntry)]
refs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const (PDF Int
supply forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Int -> PDFReference s
PDFReference)) [Tree OutlineData]
children
    -- (previousRef, currentRef, currentNode, nextRef)
    let refs :: [(Maybe (PDFReference PDFOutlineEntry),
  Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
  Maybe (PDFReference PDFOutlineEntry))]
refs = forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 (forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
init [Maybe (PDFReference PDFOutlineEntry)]
refs') [Maybe (PDFReference PDFOutlineEntry)]
refs' [Tree OutlineData]
children (forall a. [a] -> [a]
tail [Maybe (PDFReference PDFOutlineEntry)]
refs' forall a. [a] -> [a] -> [a]
++ [forall a. Maybe a
Nothing])
        current :: (a, b, c, d) -> b
current (a
_,b
c,c
_,d
_) = b
c
        Just PDFReference PDFOutlineEntry
first = forall {a} {b} {c} {d}. (a, b, c, d) -> b
current (forall a. [a] -> a
head [(Maybe (PDFReference PDFOutlineEntry),
  Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
  Maybe (PDFReference PDFOutlineEntry))]
refs)
        Just PDFReference PDFOutlineEntry
end = forall {a} {b} {c} {d}. (a, b, c, d) -> b
current (forall a. [a] -> a
last [(Maybe (PDFReference PDFOutlineEntry),
  Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
  Maybe (PDFReference PDFOutlineEntry))]
refs)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {p} {p}.
p
-> p
-> (Maybe (PDFReference PDFOutlineEntry),
    Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
    Maybe (PDFReference PDFOutlineEntry))
-> PDF ()
addEntry PDFReference PDFOutlineEntry
first PDFReference PDFOutlineEntry
end) [(Maybe (PDFReference PDFOutlineEntry),
  Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
  Maybe (PDFReference PDFOutlineEntry))]
refs
    forall (m :: * -> *) a. Monad m => a -> m a
return (PDFReference PDFOutlineEntry
first,PDFReference PDFOutlineEntry
end)
 where
    addEntry :: p
-> p
-> (Maybe (PDFReference PDFOutlineEntry),
    Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
    Maybe (PDFReference PDFOutlineEntry))
-> PDF ()
addEntry p
_ p
_ (Maybe (PDFReference PDFOutlineEntry)
_,Maybe (PDFReference PDFOutlineEntry)
Nothing,Tree OutlineData
_,Maybe (PDFReference PDFOutlineEntry)
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"This pattern match in addEntry should never occur !"
    addEntry p
_ p
_ (Maybe (PDFReference PDFOutlineEntry)
prev,Just PDFReference PDFOutlineEntry
current,Node (PDFString
title,Maybe Color
col,Maybe OutlineStyle
style,Destination
dest) [Tree OutlineData]
c,Maybe (PDFReference PDFOutlineEntry)
next) = do
        (Maybe (PDFReference PDFOutlineEntry)
f,Maybe (PDFReference PDFOutlineEntry)
e) <- if (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree OutlineData]
c) 
            then 
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing) 
            else
                PDFReference PDFOutlineEntry
-> [Tree OutlineData]
-> PDF (PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
createOutline PDFReference PDFOutlineEntry
current [Tree OutlineData]
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(PDFReference PDFOutlineEntry
x,PDFReference PDFOutlineEntry
y) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just PDFReference PDFOutlineEntry
x,forall a. a -> Maybe a
Just PDFReference PDFOutlineEntry
y)
        let o :: PDFOutlineEntry
o = PDFString
-> PDFReference PDFOutlineEntry
-> Maybe (PDFReference PDFOutlineEntry)
-> Maybe (PDFReference PDFOutlineEntry)
-> Maybe (PDFReference PDFOutlineEntry)
-> Maybe (PDFReference PDFOutlineEntry)
-> Int
-> Destination
-> Color
-> OutlineStyle
-> PDFOutlineEntry
PDFOutlineEntry PDFString
title
                                PDFReference PDFOutlineEntry
r -- Parent
                                Maybe (PDFReference PDFOutlineEntry)
prev -- Prev
                                Maybe (PDFReference PDFOutlineEntry)
next
                                Maybe (PDFReference PDFOutlineEntry)
f
                                Maybe (PDFReference PDFOutlineEntry)
e
                                (-(forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tree OutlineData]
c))
                                Destination
dest
                                (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PDFFloat -> PDFFloat -> PDFFloat -> Color
Rgb PDFFloat
0 PDFFloat
0 PDFFloat
0) forall a. a -> a
id Maybe Color
col)
                                (forall b a. b -> (a -> b) -> Maybe a -> b
maybe OutlineStyle
NormalOutline forall a. a -> a
id Maybe OutlineStyle
style)
        forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFOutlineEntry
current PDFOutlineEntry
o
    

toTree :: OutlineLoc a -> Tree a
toTree :: forall a. OutlineLoc a -> Tree a
toTree (OutlineLoc Tree a
a OutlineCtx a
Top) = Tree a
a
toTree OutlineLoc a
a = forall a. OutlineLoc a -> Tree a
toTree (forall a. OutlineLoc a -> OutlineLoc a
up OutlineLoc a
a)


-- | Reference to the last created page
getCurrentPage :: PDF (Maybe (PDFReference PDFPage))
getCurrentPage :: PDF (Maybe (PDFReference PDFPage))
getCurrentPage = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe (PDFReference PDFPage)
currentPage

-- | Record bound of an xobject
recordBound :: Int -- ^ Reference
            -> PDFFloat -- ^ Width
            -> PDFFloat -- ^ Height
            -> PDF ()
recordBound :: Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
ref PDFFloat
width PDFFloat
height = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {xobjectBound :: IntMap (PDFFloat, PDFFloat)
xobjectBound = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
ref (PDFFloat
width,PDFFloat
height) (PdfState -> IntMap (PDFFloat, PDFFloat)
xobjectBound PdfState
s)}


-- | Create an embedded font
createEmbeddedFont :: FontData -> PDF (PDFReference EmbeddedFont)
createEmbeddedFont :: FontData -> PDF (PDFReference EmbeddedFont)
createEmbeddedFont (Type1Data ByteString
d) = do 
    PDFReference Int
s <-  forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent (forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
d) forall a. Maybe a
Nothing 
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
s)

-- | Create a type 1 font 
readType1Font :: FilePath 
              -> FilePath 
              -> IO (Either ParseError Type1FontStructure)
readType1Font :: [Char] -> [Char] -> IO (Either ParseError Type1FontStructure)
readType1Font [Char]
pfb [Char]
afmPath  = do 
  FontData
fd <- [Char] -> IO FontData
readFontData [Char]
pfb 
  Either ParseError AFMData
result <- [Char] -> IO (Either ParseError AFMData)
readAfmData [Char]
afmPath
  case Either ParseError AFMData
result of
    Left ParseError
pe -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ParseError
pe
    Right AFMData
afm -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontData -> AFMData -> IO Type1FontStructure
mkType1FontStructure FontData
fd AFMData
afm 

mkType1Font :: Type1FontStructure -> PDF AnyFont 
mkType1Font :: Type1FontStructure -> PDF AnyFont
mkType1Font (Type1FontStructure FontData
fd FontStructure
fs) = do 
   PDFReference EmbeddedFont
ref <- FontData -> PDF (PDFReference EmbeddedFont)
createEmbeddedFont FontData
fd 
   forall (m :: * -> *) a. Monad m => a -> m a
return (forall f. (IsFont f, PdfResourceObject f, Show f) => f -> AnyFont
AnyFont forall a b. (a -> b) -> a -> b
$ FontStructure -> PDFReference EmbeddedFont -> Type1Font
Type1Font FontStructure
fs PDFReference EmbeddedFont
ref)