module Graphics.PDF.Pages(
standardViewerPrefs
, findPage
, recordPage
, noPages
, addPages
, getCurrentPage
, 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)
setPageAnnotations :: [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations :: [AnyAnnotation] -> PDFReference PDFPage -> PDF ()
setPageAnnotations [AnyAnnotation]
an PDFReference PDFPage
page = do
Pages
lPages <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
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 ()
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}
setPageResource :: PDFReference PDFResource -> PDFReference PDFPage -> PDF ()
PDFReference PDFResource
newr PDFReference PDFPage
page = do
Pages
lPages <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
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 ()
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}
createContent :: Draw a
-> Maybe (PDFReference PDFPage)
-> PDF (PDFReference PDFStream)
createContent :: forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw a
d Maybe (PDFReference PDFPage)
page = do
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)
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
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)
updateObject :: (PdfObject a, PdfLengthInfo a) => PDFReference a
-> a
-> 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
recordPage :: PDFReference PDFPage
-> PDFPage
-> Pages
-> 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)
findPage :: PDFReference PDFPage
-> Pages
-> Maybe PDFPage
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
nodePage :: Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int,PDFReference PDFPages)
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
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)
leafPage :: Maybe (PDFReference PDFPages)
-> Key PDFPage
-> PDFPage
-> PDF (Int,PDFReference PDFPages)
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
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)
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
noPages :: Pages
noPages :: Pages
noPages = PDFTree PDFPage -> Pages
Pages (forall a. PDFTree a
PT.empty)
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'
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
[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
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
Maybe (PDFReference PDFOutlineEntry)
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)
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
recordBound :: Int
-> PDFFloat
-> PDFFloat
-> 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)}
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)
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)