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 <- (PdfState -> Pages) -> PDF Pages
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 -> () -> PDF ()
forall a. a -> PDF a
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 <- (AnyAnnotation -> PDF AnyPdfObject)
-> [AnyAnnotation] -> PDF [AnyPdfObject]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\AnyAnnotation
x -> AnyAnnotation -> PDF (PDFReference AnyAnnotation)
forall a. AnnotationObject a => a -> PDF (PDFReference a)
addAnnotation AnyAnnotation
x PDF (PDFReference AnyAnnotation)
-> (PDFReference AnyAnnotation -> PDF AnyPdfObject)
-> PDF AnyPdfObject
forall a b. PDF a -> (a -> PDF b) -> PDF b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnyPdfObject -> PDF AnyPdfObject
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyPdfObject -> PDF AnyPdfObject)
-> (PDFReference AnyAnnotation -> AnyPdfObject)
-> PDFReference AnyAnnotation
-> PDF AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFReference AnyAnnotation -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject) [AnyAnnotation]
an
(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 page (PDFPage a b c d e f refs) lPages}
setPageResource :: PDFReference PDFResource -> PDFReference PDFPage -> PDF ()
PDFReference PDFResource
newr PDFReference PDFPage
page = do
Pages
lPages <- (PdfState -> Pages) -> PDF Pages
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 -> () -> PDF ()
forall a. a -> PDF a
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) -> (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 page (PDFPage a b c (Just newr) e f g) 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 <- (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
_,DrawState
state',Builder
w') = Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
forall a.
Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
runDrawing Draw a
d (DrawEnvironment
emptyEnvironment {streamId = streamref, xobjectBoundD = myBounds}) (Int -> DrawState
emptyDrawState Int
streamref)
(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 (page,(state',w')) (streams s)}
PDFReference PDFStream -> PDF (PDFReference PDFStream)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PDFReference PDFStream
forall s. Int -> PDFReference s
PDFReference Int
streamref)
supply :: PDF Int
supply :: PDF Int
supply = do
Int
r <- (PdfState -> Int) -> PDF Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Int
supplySrc
(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 {supplySrc = r+1}
Int -> PDF Int
forall a. a -> PDF a
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
(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 {objects = IM.insert r (AnyPdfObject a) (objects s)}
PDFReference a -> PDF (PDFReference a)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PDFReference a
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
(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 {objects = IM.insert i (AnyPdfObject obj) (objects 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 (PDFReference PDFPage
-> PDFPage -> PDFTree PDFPage -> PDFTree PDFPage
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) = PDFReference PDFPage -> PDFTree PDFPage -> Maybe PDFPage
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 = (Int -> PDFReference PDFPages
forall s. Int -> PDFReference s
PDFReference Int
n) :: PDFReference PDFPages
(Int
sl,PDFReference PDFPages
lr) <- Maybe (PDFReference PDFPages)
-> (Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages))
-> (Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages))
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
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 (PDFReference PDFPages -> Maybe (PDFReference PDFPages)
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) <- Maybe (PDFReference PDFPages)
-> (Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages))
-> (Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages))
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
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 (PDFReference PDFPages -> Maybe (PDFReference PDFPages)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sr
case (PDFTree PDFPage -> Bool
forall a. PDFTree a -> Bool
PT.isLeaf PDFTree PDFPage
l,PDFTree PDFPage -> Bool
forall a. PDFTree a -> Bool
PT.isLeaf PDFTree PDFPage
r) of
(Bool
False,Bool
False) -> PDFReference PDFPages -> PDFPages -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef (PDFPages -> PDF ()) -> PDFPages -> PDF ()
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [PDFReference PDFPages
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. a -> Either a b
Left PDFReference PDFPages
lr,PDFReference PDFPages
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. a -> Either a b
Left PDFReference PDFPages
rr]
(Bool
True,Bool
False) -> PDFReference PDFPages -> PDFPages -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef (PDFPages -> PDF ()) -> PDFPages -> PDF ()
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [PDFReference PDFPage
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. b -> Either a b
Right (PDFTree PDFPage -> PDFReference PDFPage
forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
l),PDFReference PDFPages
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. a -> Either a b
Left PDFReference PDFPages
rr]
(Bool
False,Bool
True) -> PDFReference PDFPages -> PDFPages -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef (PDFPages -> PDF ()) -> PDFPages -> PDF ()
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [PDFReference PDFPages
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. a -> Either a b
Left PDFReference PDFPages
lr,PDFReference PDFPage
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. b -> Either a b
Right (PDFTree PDFPage -> PDFReference PDFPage
forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
r)]
(Bool
True,Bool
True) -> PDFReference PDFPages -> PDFPages -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef (PDFPages -> PDF ()) -> PDFPages -> PDF ()
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
len Maybe (PDFReference PDFPages)
ref [PDFReference PDFPage
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. b -> Either a b
Right (PDFTree PDFPage -> PDFReference PDFPage
forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
l),PDFReference PDFPage
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. b -> Either a b
Right (PDFTree PDFPage -> PDFReference PDFPage
forall a. PDFTree a -> Key a
PT.keyOf PDFTree PDFPage
r)]
(Int, PDFReference PDFPages) -> PDF (Int, PDFReference PDFPages)
forall a. a -> PDF a
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
(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 {objects = IM.insert objectnb (AnyPdfObject $ PDFPage (Just ref) a b c d e f) (objects s) }
(Int, PDFReference PDFPages) -> PDF (Int, PDFReference PDFPages)
forall a. a -> PDF a
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 = (Int -> PDFReference PDFPages
forall s. Int -> PDFReference s
PDFReference Int
n) :: PDFReference PDFPages
PDFReference PDFPages -> PDFPages -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject PDFReference PDFPages
pRef (PDFPages -> PDF ()) -> PDFPages -> PDF ()
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (PDFReference PDFPages)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> PDFPages
PDFPages Int
1 Maybe (PDFReference PDFPages)
forall a. Maybe a
Nothing [PDFReference PDFPage
-> Either (PDFReference PDFPages) (PDFReference PDFPage)
forall a b. b -> Either a b
Right PDFReference PDFPage
p]
(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 {objects = IM.insert objectnb (AnyPdfObject $ PDFPage (Just pRef) a b c d e f) (objects s) }
(Int, PDFReference PDFPages) -> PDF (Int, PDFReference PDFPages)
forall a. a -> PDF a
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 <- (PdfState -> Pages) -> PDF Pages
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Pages
pages
(Int
_,PDFReference PDFPages
r) <- Maybe (PDFReference PDFPages)
-> (Maybe (PDFReference PDFPages)
-> PDFTree PDFPage
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages))
-> (Maybe (PDFReference PDFPages)
-> PDFReference PDFPage
-> PDFPage
-> PDF (Int, PDFReference PDFPages))
-> PDFTree PDFPage
-> PDF (Int, PDFReference PDFPages)
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 Maybe (PDFReference PDFPages)
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
PDFReference PDFPages -> PDF (PDFReference PDFPages)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return PDFReference PDFPages
r
noPages :: Pages
noPages :: Pages
noPages = PDFTree PDFPage -> Pages
Pages (PDFTree PDFPage
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) = [Char] -> OutlineLoc a
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 = OutlineCtx a -> a
forall a. OutlineCtx a -> a
value OutlineCtx a
c
, parent :: OutlineCtx a
parent = OutlineCtx a -> OutlineCtx a
forall a. OutlineCtx a -> OutlineCtx a
parent OutlineCtx a
c
, rights :: [Tree a]
rights = OutlineCtx a -> [Tree a]
forall a. OutlineCtx a -> [Tree a]
rights OutlineCtx a
c
, lefts :: [Tree a]
lefts = OutlineCtx a -> [Tree a]
forall a. OutlineCtx a -> [Tree a]
lefts OutlineCtx a
c [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ [Tree a
t] }
in Tree a -> OutlineCtx a -> OutlineLoc a
forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc (a -> [Tree a] -> Tree a
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 Tree a -> OutlineCtx a -> OutlineLoc a
forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc (a -> [Tree a] -> Tree a
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 ) = [Char] -> OutlineLoc a
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' = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
v ([Tree a]
ls [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ [Tree a
t] [Tree a] -> [Tree a] -> [Tree a]
forall a. [a] -> [a] -> [a]
++ [Tree a]
rs)
in Tree a -> OutlineCtx a -> OutlineLoc a
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 = Maybe (PDFReference PDFOutline)
-> PDF (Maybe (PDFReference PDFOutline))
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PDFReference PDFOutline)
forall a. Maybe a
Nothing
addOutlines (Just Outline
r) = do
let (Node OutlineData
_ [Tree OutlineData]
l) = Outline -> Tree OutlineData
forall a. OutlineLoc a -> Tree a
toTree Outline
r
if [Tree OutlineData] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree OutlineData]
l
then Maybe (PDFReference PDFOutline)
-> PDF (Maybe (PDFReference PDFOutline))
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PDFReference PDFOutline)
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 (Int -> PDFReference PDFOutlineEntry
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
PDFReference PDFOutline -> PDFOutline -> PDF ()
forall a.
(PdfObject a, PdfLengthInfo a) =>
PDFReference a -> a -> PDF ()
updateObject (Int -> PDFReference PDFOutline
forall s. Int -> PDFReference s
PDFReference Int
rootRef) PDFOutline
outlineCatalog
Maybe (PDFReference PDFOutline)
-> PDF (Maybe (PDFReference PDFOutline))
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFReference PDFOutline -> Maybe (PDFReference PDFOutline)
forall a. a -> Maybe a
Just (Int -> PDFReference PDFOutline
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' <- (Tree OutlineData -> PDF (Maybe (PDFReference PDFOutlineEntry)))
-> [Tree OutlineData] -> PDF [Maybe (PDFReference PDFOutlineEntry)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PDF (Maybe (PDFReference PDFOutlineEntry))
-> Tree OutlineData -> PDF (Maybe (PDFReference PDFOutlineEntry))
forall a b. a -> b -> a
const (PDF Int
supply PDF Int
-> (Int -> PDF (Maybe (PDFReference PDFOutlineEntry)))
-> PDF (Maybe (PDFReference PDFOutlineEntry))
forall a b. PDF a -> (a -> PDF b) -> PDF b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (PDFReference PDFOutlineEntry)
-> PDF (Maybe (PDFReference PDFOutlineEntry))
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (PDFReference PDFOutlineEntry)
-> PDF (Maybe (PDFReference PDFOutlineEntry)))
-> (Int -> Maybe (PDFReference PDFOutlineEntry))
-> Int
-> PDF (Maybe (PDFReference PDFOutlineEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFReference PDFOutlineEntry
-> Maybe (PDFReference PDFOutlineEntry)
forall a. a -> Maybe a
Just (PDFReference PDFOutlineEntry
-> Maybe (PDFReference PDFOutlineEntry))
-> (Int -> PDFReference PDFOutlineEntry)
-> Int
-> Maybe (PDFReference PDFOutlineEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFReference PDFOutlineEntry
forall s. Int -> PDFReference s
PDFReference)) [Tree OutlineData]
children
let refs :: [(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
refs = [Maybe (PDFReference PDFOutlineEntry)]
-> [Maybe (PDFReference PDFOutlineEntry)]
-> [Tree OutlineData]
-> [Maybe (PDFReference PDFOutlineEntry)]
-> [(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 (Maybe (PDFReference PDFOutlineEntry)
forall a. Maybe a
Nothing Maybe (PDFReference PDFOutlineEntry)
-> [Maybe (PDFReference PDFOutlineEntry)]
-> [Maybe (PDFReference PDFOutlineEntry)]
forall a. a -> [a] -> [a]
: [Maybe (PDFReference PDFOutlineEntry)]
-> [Maybe (PDFReference PDFOutlineEntry)]
forall a. HasCallStack => [a] -> [a]
init [Maybe (PDFReference PDFOutlineEntry)]
refs') [Maybe (PDFReference PDFOutlineEntry)]
refs' [Tree OutlineData]
children ([Maybe (PDFReference PDFOutlineEntry)]
-> [Maybe (PDFReference PDFOutlineEntry)]
forall a. HasCallStack => [a] -> [a]
tail [Maybe (PDFReference PDFOutlineEntry)]
refs' [Maybe (PDFReference PDFOutlineEntry)]
-> [Maybe (PDFReference PDFOutlineEntry)]
-> [Maybe (PDFReference PDFOutlineEntry)]
forall a. [a] -> [a] -> [a]
++ [Maybe (PDFReference PDFOutlineEntry)
forall a. Maybe a
Nothing])
current :: (a, b, c, d) -> b
current (a
_,b
c,c
_,d
_) = b
c
Just PDFReference PDFOutlineEntry
first = (Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))
-> Maybe (PDFReference PDFOutlineEntry)
forall {a} {b} {c} {d}. (a, b, c, d) -> b
current ([(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
-> (Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))
forall a. HasCallStack => [a] -> a
head [(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
refs)
Just PDFReference PDFOutlineEntry
end = (Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))
-> Maybe (PDFReference PDFOutlineEntry)
forall {a} {b} {c} {d}. (a, b, c, d) -> b
current ([(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
-> (Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))
forall a. HasCallStack => [a] -> a
last [(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
refs)
((Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))
-> PDF ())
-> [(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))]
-> PDF ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PDFReference PDFOutlineEntry
-> PDFReference PDFOutlineEntry
-> (Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry), Tree OutlineData,
Maybe (PDFReference PDFOutlineEntry))
-> PDF ()
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
(PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
-> PDF (PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
forall a. a -> PDF a
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)
_) = [Char] -> PDF ()
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 ([Tree OutlineData] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree OutlineData]
c)
then
(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry))
-> PDF
(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry))
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (PDFReference PDFOutlineEntry)
forall a. Maybe a
Nothing,Maybe (PDFReference PDFOutlineEntry)
forall a. Maybe a
Nothing)
else
PDFReference PDFOutlineEntry
-> [Tree OutlineData]
-> PDF (PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
createOutline PDFReference PDFOutlineEntry
current [Tree OutlineData]
c PDF (PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
-> ((PDFReference PDFOutlineEntry, PDFReference PDFOutlineEntry)
-> PDF
(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry)))
-> PDF
(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry))
forall a b. PDF a -> (a -> PDF b) -> PDF b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(PDFReference PDFOutlineEntry
x,PDFReference PDFOutlineEntry
y) -> (Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry))
-> PDF
(Maybe (PDFReference PDFOutlineEntry),
Maybe (PDFReference PDFOutlineEntry))
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFReference PDFOutlineEntry
-> Maybe (PDFReference PDFOutlineEntry)
forall a. a -> Maybe a
Just PDFReference PDFOutlineEntry
x,PDFReference PDFOutlineEntry
-> Maybe (PDFReference PDFOutlineEntry)
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
(-([Tree OutlineData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tree OutlineData]
c))
Destination
dest
(Color -> (Color -> Color) -> Maybe Color -> Color
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PDFFloat -> PDFFloat -> PDFFloat -> Color
Rgb PDFFloat
0 PDFFloat
0 PDFFloat
0) Color -> Color
forall a. a -> a
id Maybe Color
col)
(OutlineStyle
-> (OutlineStyle -> OutlineStyle)
-> Maybe OutlineStyle
-> OutlineStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OutlineStyle
NormalOutline OutlineStyle -> OutlineStyle
forall a. a -> a
id Maybe OutlineStyle
style)
PDFReference PDFOutlineEntry -> PDFOutlineEntry -> PDF ()
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 = OutlineLoc a -> Tree a
forall a. OutlineLoc a -> Tree a
toTree (OutlineLoc a -> OutlineLoc a
forall a. OutlineLoc a -> OutlineLoc a
up OutlineLoc a
a)
getCurrentPage :: PDF (Maybe (PDFReference PDFPage))
getCurrentPage :: PDF (Maybe (PDFReference PDFPage))
getCurrentPage = (PdfState -> Maybe (PDFReference PDFPage))
-> PDF (Maybe (PDFReference PDFPage))
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 = (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 {xobjectBound = IM.insert ref (width,height) (xobjectBound s)}
createEmbeddedFont :: FontData -> PDF (PDFReference EmbeddedFont)
createEmbeddedFont :: FontData -> PDF (PDFReference EmbeddedFont)
createEmbeddedFont (Type1Data ByteString
d) = do
PDFReference Int
s <- Draw ()
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent (Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ()) -> Builder -> Draw ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
d) Maybe (PDFReference PDFPage)
forall a. Maybe a
Nothing
PDFReference EmbeddedFont -> PDF (PDFReference EmbeddedFont)
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PDFReference EmbeddedFont
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 -> Either ParseError Type1FontStructure
-> IO (Either ParseError Type1FontStructure)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError Type1FontStructure
-> IO (Either ParseError Type1FontStructure))
-> Either ParseError Type1FontStructure
-> IO (Either ParseError Type1FontStructure)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError Type1FontStructure
forall a b. a -> Either a b
Left ParseError
pe
Right AFMData
afm -> Type1FontStructure -> Either ParseError Type1FontStructure
forall a b. b -> Either a b
Right (Type1FontStructure -> Either ParseError Type1FontStructure)
-> IO Type1FontStructure
-> IO (Either ParseError Type1FontStructure)
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
AnyFont -> PDF AnyFont
forall a. a -> PDF a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type1Font -> AnyFont
forall f. (IsFont f, PdfResourceObject f, Show f) => f -> AnyFont
AnyFont (Type1Font -> AnyFont) -> Type1Font -> AnyFont
forall a b. (a -> b) -> a -> b
$ FontStructure -> PDFReference EmbeddedFont -> Type1Font
Type1Font FontStructure
fs PDFReference EmbeddedFont
ref)