{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- PDF API for Haskell
---------------------------------------------------------
-- #hide
module Graphics.PDF.Draw(
 -- * Draw monad
   Draw
 , PDFStream(..)
 , withNewContext
 , DrawState(..)
 , DrawEnvironment(..)
 , readDrawST 
 , writeDrawST 
 , modifyDrawST 
 , DrawTuple()
 , penPosition
 , supplyName
 , emptyDrawing
-- , writeCmd
 , runDrawing
 , setResource
 , emptyEnvironment
 , PDFXForm
 , PDFXObject(..)
 , AnyPdfXForm
 , pdfDictMember
 -- PDF types
 , PDF(..)
 , PDFPage(..)
 , PDFPages(..)
 , PdfState(..)
 , PDFCatalog(..)
 , Pages(..)
 , PDFDocumentPageMode(..)
 , PDFDocumentPageLayout(..)
 , PDFViewerPreferences(..)
 , PDFDocumentInfo(..)
 -- ** Page transitions
 , PDFTransition(..)
 , PDFTransStyle(..)
 , PDFTransDirection(..)
 , PDFTransDimension(..)
 , PDFTransDirection2(..)
 -- ** Outlines
 , PDFOutline(..)
 , OutlineStyle(..)
 , PDFOutlineEntry(..)
 , Destination(..)
 , Outline
 , OutlineLoc(..)
 , Tree(..)
 , OutlineCtx(..)
 , AnnotationObject(..)
 , Color(..)
 , hsvToRgb
 , OutlineData
 , AnyAnnotation(..)
 , AnnotationStyle(..)
 , PDFShading(..)
 , getRgbColor
 , emptyDrawState
 , Matrix(..)
 , identity
 , applyMatrix
 , currentMatrix
 , multiplyCurrentMatrixWith
 , PDFGlobals(..)
 ) where
 
import Data.Maybe
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif

import qualified Data.Map.Strict as M
import qualified Data.IntMap as IM
import qualified Data.Binary.Builder as BU
import qualified Data.ByteString.Lazy as B

import Control.Monad.ST
import Data.STRef

import Control.Monad.Writer.Class
import Control.Monad.Reader.Class
import Control.Monad.State

import Graphics.PDF.Coordinates
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.LowLevel.Serializer
import Graphics.PDF.Resources
import Graphics.PDF.Data.PDFTree(PDFTree)
import qualified Data.Text as T
import Graphics.PDF.Fonts.Font(PDFFont(..))

data AnnotationStyle = AnnotationStyle !(Maybe Color)

class AnnotationObject a where
    addAnnotation :: a -> PDF (PDFReference a)
    annotationType :: a -> PDFName
    annotationContent :: a -> AnyPdfObject
    annotationRect :: a -> [PDFFloat]
    annotationToGlobalCoordinates :: a -> Draw a
    annotationToGlobalCoordinates = a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return
    
data AnyAnnotation = forall a.(PdfObject a,AnnotationObject a) => AnyAnnotation a

instance PdfObject AnyAnnotation where
    toPDF :: AnyAnnotation -> Builder
toPDF (AnyAnnotation a
a) = a -> Builder
forall a. PdfObject a => a -> Builder
toPDF a
a
instance PdfLengthInfo AnyAnnotation where

instance AnnotationObject AnyAnnotation where
    addAnnotation :: AnyAnnotation -> PDF (PDFReference AnyAnnotation)
addAnnotation (AnyAnnotation a
a) = do
        PDFReference Int
r <- a -> PDF (PDFReference a)
forall a. AnnotationObject a => a -> PDF (PDFReference a)
addAnnotation a
a
        PDFReference AnyAnnotation -> PDF (PDFReference AnyAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PDFReference AnyAnnotation
forall s. Int -> PDFReference s
PDFReference Int
r)
    annotationType :: AnyAnnotation -> PDFName
annotationType (AnyAnnotation a
a) = a -> PDFName
forall a. AnnotationObject a => a -> PDFName
annotationType a
a
    annotationContent :: AnyAnnotation -> AnyPdfObject
annotationContent (AnyAnnotation a
a) = a -> AnyPdfObject
forall a. AnnotationObject a => a -> AnyPdfObject
annotationContent a
a
    annotationRect :: AnyAnnotation -> [PDFFloat]
annotationRect (AnyAnnotation a
a) = a -> [PDFFloat]
forall a. AnnotationObject a => a -> [PDFFloat]
annotationRect a
a
    

-- | A PDF color
data Color = Rgb !Double !Double !Double
           | Hsv !Double !Double !Double
           deriving(Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq,Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord)

data DrawState = DrawState {
                   DrawState -> [String]
supplyNames :: [String]
                ,  DrawState -> PDFResource
rsrc :: PDFResource
                ,  DrawState -> Map StrokeAlpha String
strokeAlphas :: M.Map StrokeAlpha String
                ,  DrawState -> Map FillAlpha String
fillAlphas :: M.Map FillAlpha String
                ,  DrawState -> Map PDFFont String
theFonts :: M.Map PDFFont String
                ,  DrawState -> Map (PDFReference AnyPdfXForm) String
xobjects :: M.Map (PDFReference AnyPdfXForm) String
                ,  DrawState -> PDFDictionary
otherRsrcs :: PDFDictionary
                ,  DrawState -> [AnyAnnotation]
annots :: [AnyAnnotation]
                ,  DrawState -> Map (PDFReference AnyPdfPattern) String
patterns :: M.Map (PDFReference AnyPdfPattern) String
                ,  DrawState -> Map PDFColorSpace String
colorSpaces :: M.Map PDFColorSpace String
                ,  DrawState -> Map PDFShading String
shadings :: M.Map PDFShading String
                ,  DrawState -> [Matrix]
matrix :: [Matrix]
                }
data DrawEnvironment = DrawEnvironment {
                        DrawEnvironment -> Int
streamId :: Int
                     ,  DrawEnvironment -> IntMap (PDFFloat, PDFFloat)
xobjectBoundD :: IM.IntMap (PDFFloat,PDFFloat)
                     }   

data DrawTuple s
   = DrawTuple {  DrawTuple s -> DrawEnvironment
drawEnvironment    :: DrawEnvironment
               ,  DrawTuple s -> STRef s DrawState
drawStateRef  :: STRef s DrawState
               ,  DrawTuple s -> STRef s Builder
builderRef :: STRef s BU.Builder
               ,  DrawTuple s -> STRef s Point
penPosition :: STRef s Point
               }
    
emptyEnvironment :: DrawEnvironment
emptyEnvironment :: DrawEnvironment
emptyEnvironment = Int -> IntMap (PDFFloat, PDFFloat) -> DrawEnvironment
DrawEnvironment Int
0 IntMap (PDFFloat, PDFFloat)
forall a. IntMap a
IM.empty

class PDFGlobals m where
    bounds :: PDFXObject a => PDFReference a -> m (PDFFloat,PDFFloat)
    
-- | The drawing monad
newtype Draw a = Draw {Draw a -> forall s. DrawTuple s -> ST s a
unDraw :: forall s. DrawTuple s -> ST s a }

instance Applicative Draw where
    pure :: a -> Draw a
pure a
x = (forall s. DrawTuple s -> ST s a) -> Draw a
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s a) -> Draw a)
-> (forall s. DrawTuple s -> ST s a) -> Draw a
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
_env -> a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Draw (a -> b)
df <*> :: Draw (a -> b) -> Draw a -> Draw b
<*> Draw a
af = (forall s. DrawTuple s -> ST s b) -> Draw b
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s b) -> Draw b)
-> (forall s. DrawTuple s -> ST s b) -> Draw b
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> do
       a -> b
f <- Draw (a -> b) -> DrawTuple s -> ST s (a -> b)
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw (a -> b)
df DrawTuple s
env
       a
a <- Draw a -> DrawTuple s -> ST s a
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
af DrawTuple s
env
       b -> ST s b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ST s b) -> b -> ST s b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a


instance Monad Draw where
    Draw a
m >>= :: Draw a -> (a -> Draw b) -> Draw b
>>= a -> Draw b
f  = (forall s. DrawTuple s -> ST s b) -> Draw b
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s b) -> Draw b)
-> (forall s. DrawTuple s -> ST s b) -> Draw b
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> do
                          a
a <- Draw a -> DrawTuple s -> ST s a
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
m DrawTuple s
env
                          Draw b -> DrawTuple s -> ST s b
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw (a -> Draw b
f a
a) DrawTuple s
env
    return :: a -> Draw a
return a
x = (forall s. DrawTuple s -> ST s a) -> Draw a
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s a) -> Draw a)
-> (forall s. DrawTuple s -> ST s a) -> Draw a
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
_env -> a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

instance MonadReader DrawEnvironment Draw where
   ask :: Draw DrawEnvironment
ask       = (forall s. DrawTuple s -> ST s DrawEnvironment)
-> Draw DrawEnvironment
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s DrawEnvironment)
 -> Draw DrawEnvironment)
-> (forall s. DrawTuple s -> ST s DrawEnvironment)
-> Draw DrawEnvironment
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> DrawEnvironment -> ST s DrawEnvironment
forall (m :: * -> *) a. Monad m => a -> m a
return (DrawTuple s -> DrawEnvironment
forall s. DrawTuple s -> DrawEnvironment
drawEnvironment DrawTuple s
env)
   local :: (DrawEnvironment -> DrawEnvironment) -> Draw a -> Draw a
local DrawEnvironment -> DrawEnvironment
f Draw a
m = (forall s. DrawTuple s -> ST s a) -> Draw a
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s a) -> Draw a)
-> (forall s. DrawTuple s -> ST s a) -> Draw a
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> let drawenv' :: DrawEnvironment
drawenv' = DrawEnvironment -> DrawEnvironment
f (DrawTuple s -> DrawEnvironment
forall s. DrawTuple s -> DrawEnvironment
drawEnvironment DrawTuple s
env)
                                  env' :: DrawTuple s
env' = DrawTuple s
env { drawEnvironment :: DrawEnvironment
drawEnvironment = DrawEnvironment
drawenv' }
                               in Draw a -> DrawTuple s -> ST s a
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
m DrawTuple s
env' 

instance MonadState DrawState Draw where
    get :: Draw DrawState
get    = (forall s. DrawTuple s -> ST s DrawState) -> Draw DrawState
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s DrawState) -> Draw DrawState)
-> (forall s. DrawTuple s -> ST s DrawState) -> Draw DrawState
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> STRef s DrawState -> ST s DrawState
forall s a. STRef s a -> ST s a
readSTRef  (DrawTuple s -> STRef s DrawState
forall s. DrawTuple s -> STRef s DrawState
drawStateRef DrawTuple s
env)
    put :: DrawState -> Draw ()
put DrawState
st = (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s ()) -> Draw ())
-> (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> STRef s DrawState -> DrawState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (DrawTuple s -> STRef s DrawState
forall s. DrawTuple s -> STRef s DrawState
drawStateRef DrawTuple s
env) DrawState
st

instance MonadWriter BU.Builder Draw where
    tell :: Builder -> Draw ()
tell Builder
bu  = (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s ()) -> Draw ())
-> (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> STRef s Builder -> (Builder -> Builder) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (DrawTuple s -> STRef s Builder
forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
env) (Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
bu)
    listen :: Draw a -> Draw (a, Builder)
listen Draw a
m = (forall s. DrawTuple s -> ST s (a, Builder)) -> Draw (a, Builder)
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s (a, Builder)) -> Draw (a, Builder))
-> (forall s. DrawTuple s -> ST s (a, Builder))
-> Draw (a, Builder)
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> do
                 a
a <- Draw a -> DrawTuple s -> ST s a
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
m DrawTuple s
env
                 Builder
w <- STRef s Builder -> ST s Builder
forall s a. STRef s a -> ST s a
readSTRef (DrawTuple s -> STRef s Builder
forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
env)
                 (a, Builder) -> ST s (a, Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Builder
w)
    pass :: Draw (a, Builder -> Builder) -> Draw a
pass   Draw (a, Builder -> Builder)
m = (forall s. DrawTuple s -> ST s a) -> Draw a
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s a) -> Draw a)
-> (forall s. DrawTuple s -> ST s a) -> Draw a
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> do
                 (a
a, Builder -> Builder
f) <- Draw (a, Builder -> Builder)
-> DrawTuple s -> ST s (a, Builder -> Builder)
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw (a, Builder -> Builder)
m DrawTuple s
env
                 STRef s Builder -> (Builder -> Builder) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (DrawTuple s -> STRef s Builder
forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
env) Builder -> Builder
f
                 a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

instance Functor Draw where
     fmap :: (a -> b) -> Draw a -> Draw b
fmap a -> b
f = \Draw a
m -> do { a
a <- Draw a
m; b -> Draw b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a) }

instance MonadPath Draw

readDrawST :: (forall s. DrawTuple s -> STRef s a) -> Draw a
readDrawST :: (forall s. DrawTuple s -> STRef s a) -> Draw a
readDrawST   forall s. DrawTuple s -> STRef s a
f   = (forall s. DrawTuple s -> ST s a) -> Draw a
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s a) -> Draw a)
-> (forall s. DrawTuple s -> ST s a) -> Draw a
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef   (DrawTuple s -> STRef s a
forall s. DrawTuple s -> STRef s a
f DrawTuple s
env) 

writeDrawST :: (forall s. DrawTuple s -> STRef s a) -> a -> Draw ()
writeDrawST :: (forall s. DrawTuple s -> STRef s a) -> a -> Draw ()
writeDrawST  forall s. DrawTuple s -> STRef s a
f a
x = (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s ()) -> Draw ())
-> (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef  (DrawTuple s -> STRef s a
forall s. DrawTuple s -> STRef s a
f DrawTuple s
env) a
x 

modifyDrawST :: (forall s. DrawTuple s -> STRef s a) -> (a -> a) -> Draw ()
modifyDrawST :: (forall s. DrawTuple s -> STRef s a) -> (a -> a) -> Draw ()
modifyDrawST forall s. DrawTuple s -> STRef s a
f a -> a
g = (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw ((forall s. DrawTuple s -> ST s ()) -> Draw ())
-> (forall s. DrawTuple s -> ST s ()) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> STRef s a -> (a -> a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (DrawTuple s -> STRef s a
forall s. DrawTuple s -> STRef s a
f DrawTuple s
env) a -> a
g

-- | A PDF stream object
data PDFStream = PDFStream !BU.Builder !Bool !(PDFReference MaybeLength) !PDFDictionary
                                   
instance PdfObject PDFStream where
  toPDF :: PDFStream -> Builder
toPDF (PDFStream Builder
s Bool
c PDFReference MaybeLength
l PDFDictionary
d) = 
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat   ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [ PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFDictionary
dict
                  , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\nstream"
                  , Builder
forall s. SerializeValue s Char => s
newline
                  , Builder
s
                  , Builder
forall s. SerializeValue s Char => s
newline
                  , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"endstream"]
   where
      compressedStream :: Bool -> [(PDFName, AnyPdfObject)]
compressedStream Bool
False = []
      compressedStream Bool
True = if Bool -> Bool
not (PDFName -> PDFDictionary -> Bool
pdfDictMember (String -> PDFName
PDFName String
"Filter") PDFDictionary
d) then [(String -> PDFName
PDFName String
"Filter",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject) -> [AnyPdfObject] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"FlateDecode"])] else []
      lenDict :: PDFDictionary
lenDict = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [ (String -> PDFName
PDFName String
"Length",PDFReference MaybeLength -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference MaybeLength
l)] [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ Bool -> [(PDFName, AnyPdfObject)]
compressedStream Bool
c
      dict :: PDFDictionary
dict = PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion PDFDictionary
lenDict PDFDictionary
d

instance PdfLengthInfo PDFStream where 
  pdfLengthInfo :: PDFStream -> Maybe (Int64, PDFReference MaybeLength)
pdfLengthInfo (PDFStream Builder
s Bool
_ PDFReference MaybeLength
l PDFDictionary
_) = (Int64, PDFReference MaybeLength)
-> Maybe (Int64, PDFReference MaybeLength)
forall a. a -> Maybe a
Just (ByteString -> Int64
B.length (ByteString -> Int64)
-> (Builder -> ByteString) -> Builder -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString (Builder -> Int64) -> Builder -> Int64
forall a b. (a -> b) -> a -> b
$ Builder
s,PDFReference MaybeLength
l)
    
-- | An empty drawing
emptyDrawing :: Draw ()
emptyDrawing :: Draw ()
emptyDrawing = () -> Draw ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
-- | is member of the dictionary
pdfDictMember :: PDFName -> PDFDictionary -> Bool
pdfDictMember :: PDFName -> PDFDictionary -> Bool
pdfDictMember PDFName
k (PDFDictionary Map PDFName AnyPdfObject
d)  = PDFName -> Map PDFName AnyPdfObject -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member PDFName
k Map PDFName AnyPdfObject
d

-- | Get a new resource name
supplyName :: Draw String
supplyName :: Draw String
supplyName = do
    [String]
xs <- (DrawState -> [String]) -> Draw [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> [String]
supplyNames -- infinite list
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {supplyNames :: [String]
supplyNames = [String] -> [String]
forall a. [a] -> [a]
tail [String]
xs}
    String -> Draw String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall a. [a] -> a
head [String]
xs)
    
emptyDrawState :: Int -> DrawState
emptyDrawState :: Int -> DrawState
emptyDrawState Int
ref = 
    let names :: [String]
names = ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"O" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
ref)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
k [Char
'a'..Char
'z'] | Int
k <- [Int
1..]] [[String]] -> ([String] -> [String]) -> [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence) in
    [String]
-> PDFResource
-> Map StrokeAlpha String
-> Map FillAlpha String
-> Map PDFFont String
-> Map (PDFReference AnyPdfXForm) String
-> PDFDictionary
-> [AnyAnnotation]
-> Map (PDFReference AnyPdfPattern) String
-> Map PDFColorSpace String
-> Map PDFShading String
-> [Matrix]
-> DrawState
DrawState [String]
names PDFResource
emptyRsrc Map StrokeAlpha String
forall k a. Map k a
M.empty Map FillAlpha String
forall k a. Map k a
M.empty Map PDFFont String
forall k a. Map k a
M.empty Map (PDFReference AnyPdfXForm) String
forall k a. Map k a
M.empty PDFDictionary
emptyDictionary []  Map (PDFReference AnyPdfPattern) String
forall k a. Map k a
M.empty Map PDFColorSpace String
forall k a. Map k a
M.empty Map PDFShading String
forall k a. Map k a
M.empty [Matrix
identity]
  
-- | Execute the drawing commands to get a new state and an uncompressed PDF stream
runDrawing :: Draw a -> DrawEnvironment -> DrawState -> (a,DrawState,BU.Builder)
runDrawing :: Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
runDrawing Draw a
drawing DrawEnvironment
environment DrawState
drawState 
    = (forall s. ST s (a, DrawState, Builder)) -> (a, DrawState, Builder)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a, DrawState, Builder))
 -> (a, DrawState, Builder))
-> (forall s. ST s (a, DrawState, Builder))
-> (a, DrawState, Builder)
forall a b. (a -> b) -> a -> b
$ do
        STRef s DrawState
dRef <- DrawState -> ST s (STRef s DrawState)
forall a s. a -> ST s (STRef s a)
newSTRef DrawState
drawState
        STRef s Builder
bRef <- Builder -> ST s (STRef s Builder)
forall a s. a -> ST s (STRef s a)
newSTRef Builder
forall a. Monoid a => a
mempty
        STRef s Point
posRef <- Point -> ST s (STRef s Point)
forall a s. a -> ST s (STRef s a)
newSTRef Point
0
        let tuple :: DrawTuple s
tuple = DrawTuple :: forall s.
DrawEnvironment
-> STRef s DrawState
-> STRef s Builder
-> STRef s Point
-> DrawTuple s
DrawTuple { drawEnvironment :: DrawEnvironment
drawEnvironment = DrawEnvironment
environment
                              , drawStateRef :: STRef s DrawState
drawStateRef    = STRef s DrawState
dRef
                              , builderRef :: STRef s Builder
builderRef      = STRef s Builder
bRef
                              , penPosition :: STRef s Point
penPosition     = STRef s Point
posRef
                              } 
        a
a <- Draw a -> DrawTuple s -> ST s a
forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
drawing DrawTuple s
tuple
        DrawState
drawSt <- STRef s DrawState -> ST s DrawState
forall s a. STRef s a -> ST s a
readSTRef (DrawTuple s -> STRef s DrawState
forall s. DrawTuple s -> STRef s DrawState
drawStateRef DrawTuple s
tuple)
        Builder
builder <- STRef s Builder -> ST s Builder
forall s a. STRef s a -> ST s a
readSTRef (DrawTuple s -> STRef s Builder
forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
tuple)
        (a, DrawState, Builder) -> ST s (a, DrawState, Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DrawState
drawSt, Builder
builder)
     
pushMatrixStack :: Matrix -> Draw ()
pushMatrixStack :: Matrix -> Draw ()
pushMatrixStack Matrix
m = do
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {matrix :: [Matrix]
matrix = Matrix
m Matrix -> [Matrix] -> [Matrix]
forall a. a -> [a] -> [a]
: DrawState -> [Matrix]
matrix DrawState
s}
    
popMatrixStack :: Draw ()
popMatrixStack :: Draw ()
popMatrixStack = do
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {matrix :: [Matrix]
matrix = [Matrix] -> [Matrix]
forall a. [a] -> [a]
tail (DrawState -> [Matrix]
matrix DrawState
s)}
    

multiplyCurrentMatrixWith :: Matrix -> Draw ()
multiplyCurrentMatrixWith :: Matrix -> Draw ()
multiplyCurrentMatrixWith Matrix
m' = (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {matrix :: [Matrix]
matrix = let (Matrix
m:[Matrix]
l) = DrawState -> [Matrix]
matrix DrawState
s in (Matrix
m' Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* Matrix
m )Matrix -> [Matrix] -> [Matrix]
forall a. a -> [a] -> [a]
:[Matrix]
l}

    
currentMatrix :: Draw Matrix
currentMatrix :: Draw Matrix
currentMatrix = (DrawState -> [Matrix]) -> Draw [Matrix]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> [Matrix]
matrix Draw [Matrix] -> ([Matrix] -> Draw Matrix) -> Draw Matrix
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Matrix -> Draw Matrix
forall (m :: * -> *) a. Monad m => a -> m a
return (Matrix -> Draw Matrix)
-> ([Matrix] -> Matrix) -> [Matrix] -> Draw Matrix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Matrix] -> Matrix
forall a. [a] -> a
head
      
-- | Draw in a new drawing context without perturbing the previous context
-- that is restored after the draw       
withNewContext :: Draw a -> Draw a
withNewContext :: Draw a -> Draw a
withNewContext Draw a
m = do
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ()) -> (String -> Builder) -> String -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Draw ()) -> String -> Draw ()
forall a b. (a -> b) -> a -> b
$ String
"\nq"
    Matrix -> Draw ()
pushMatrixStack Matrix
identity
    a
a <- Draw a
m
    Draw ()
popMatrixStack
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ()) -> (String -> Builder) -> String -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Draw ()) -> String -> Draw ()
forall a b. (a -> b) -> a -> b
$ String
"\nQ"
    a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    
-- | Set a resource in the resource dictionary
setResource :: (Ord a, PdfResourceObject a) => String -- ^ Dict name
            -> a -- ^ Resource value
            -> M.Map a String -- ^ Old cache value
            -> Draw (String,M.Map a String) -- ^ New cache value
setResource :: String -> a -> Map a String -> Draw (String, Map a String)
setResource String
dict a
values Map a String
oldCache = do
    case a -> Map a String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
values Map a String
oldCache of
        Maybe String
Nothing -> do
             String
newName <- Draw String
supplyName
             (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { rsrc :: PDFResource
rsrc = PDFName -> PDFName -> AnyPdfObject -> PDFResource -> PDFResource
addResource (String -> PDFName
PDFName String
dict) (String -> PDFName
PDFName String
newName) (a -> AnyPdfObject
forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc a
values) (DrawState -> PDFResource
rsrc DrawState
s)}
             (String, Map a String) -> Draw (String, Map a String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
newName,a -> String -> Map a String -> Map a String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
values String
newName Map a String
oldCache)
        Just String
n -> (String, Map a String) -> Draw (String, Map a String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n,Map a String
oldCache)

instance PDFGlobals Draw where
    bounds :: PDFReference a -> Draw (PDFFloat, PDFFloat)
bounds (PDFReference Int
r) = Int -> Draw (PDFFloat, PDFFloat)
getBoundInDraw Int
r
    
instance PDFGlobals PDF where
    bounds :: PDFReference a -> PDF (PDFFloat, PDFFloat)
bounds (PDFReference Int
r) = Int -> PDF (PDFFloat, PDFFloat)
getBoundInPDF Int
r
    
-- | A PDF Xobject which can be drawn
class PDFXObject a where
    drawXObject :: PDFReference a -> Draw ()
    
    privateDrawXObject :: PDFReference a -> Draw ()
    privateDrawXObject (PDFReference Int
r) = do
        Map (PDFReference AnyPdfXForm) String
xobjectMap <- (DrawState -> Map (PDFReference AnyPdfXForm) String)
-> Draw (Map (PDFReference AnyPdfXForm) String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map (PDFReference AnyPdfXForm) String
xobjects
        (String
newName,Map (PDFReference AnyPdfXForm) String
newMap) <- String
-> PDFReference AnyPdfXForm
-> Map (PDFReference AnyPdfXForm) String
-> Draw (String, Map (PDFReference AnyPdfXForm) String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"XObject" (Int -> PDFReference AnyPdfXForm
forall s. Int -> PDFReference s
PDFReference Int
r) Map (PDFReference AnyPdfXForm) String
xobjectMap
        (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { xobjects :: Map (PDFReference AnyPdfXForm) String
xobjects = Map (PDFReference AnyPdfXForm) String
newMap }
        Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat  ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$ [ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                          , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                          , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" Do"
                          ]
    drawXObject = PDFReference a -> Draw ()
forall a. PDFXObject a => PDFReference a -> Draw ()
privateDrawXObject
    
-- | An XObject
data AnyPdfXForm = forall a. (PDFXObject a,PdfObject a) => AnyPdfXForm a
instance PdfObject AnyPdfXForm where
    toPDF :: AnyPdfXForm -> Builder
toPDF (AnyPdfXForm a
a) = a -> Builder
forall a. PdfObject a => a -> Builder
toPDF a
a
instance PdfLengthInfo AnyPdfXForm where

instance PDFXObject AnyPdfXForm

data PDFXForm
instance PDFXObject PDFXForm
instance PdfObject PDFXForm where
    toPDF :: PDFXForm -> Builder
toPDF PDFXForm
_ = Builder
forall a. Monoid a => a
noPdfObject
instance PdfLengthInfo PDFXForm where

instance PdfResourceObject (PDFReference PDFXForm) where
    toRsrc :: PDFReference PDFXForm -> AnyPdfObject
toRsrc = PDFReference PDFXForm -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject
    
instance PdfResourceObject (PDFReference AnyPdfXForm) where
    toRsrc :: PDFReference AnyPdfXForm -> AnyPdfObject
toRsrc = PDFReference AnyPdfXForm -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject
    

-- | Get the bounds for an xobject
getBoundInDraw :: Int -- ^ Reference
         -> Draw (PDFFloat,PDFFloat)  
getBoundInDraw :: Int -> Draw (PDFFloat, PDFFloat)
getBoundInDraw Int
ref = do
    IntMap (PDFFloat, PDFFloat)
theBounds <- (DrawEnvironment -> IntMap (PDFFloat, PDFFloat))
-> Draw (IntMap (PDFFloat, PDFFloat))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawEnvironment -> IntMap (PDFFloat, PDFFloat)
xobjectBoundD
    (PDFFloat, PDFFloat) -> Draw (PDFFloat, PDFFloat)
forall (m :: * -> *) a. Monad m => a -> m a
return ((PDFFloat, PDFFloat) -> Draw (PDFFloat, PDFFloat))
-> (PDFFloat, PDFFloat) -> Draw (PDFFloat, PDFFloat)
forall a b. (a -> b) -> a -> b
$ (PDFFloat, PDFFloat)
-> Int -> IntMap (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault (PDFFloat
0.0,PDFFloat
0.0) Int
ref IntMap (PDFFloat, PDFFloat)
theBounds
 
-- | Get the bounds for an xobject
getBoundInPDF :: Int -- ^ Reference
              -> PDF (PDFFloat,PDFFloat)  
getBoundInPDF :: Int -> PDF (PDFFloat, PDFFloat)
getBoundInPDF Int
ref = do
    IntMap (PDFFloat, PDFFloat)
theBounds <- (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
    (PDFFloat, PDFFloat) -> PDF (PDFFloat, PDFFloat)
forall (m :: * -> *) a. Monad m => a -> m a
return ((PDFFloat, PDFFloat) -> PDF (PDFFloat, PDFFloat))
-> (PDFFloat, PDFFloat) -> PDF (PDFFloat, PDFFloat)
forall a b. (a -> b) -> a -> b
$ (PDFFloat, PDFFloat)
-> Int -> IntMap (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault (PDFFloat
0.0,PDFFloat
0.0) Int
ref IntMap (PDFFloat, PDFFloat)
theBounds
   
-----------
--
-- PDF types
--
------------

-- | The PDF Catalog
data PDFCatalog = PDFCatalog 
                   !(Maybe (PDFReference PDFOutline))
                   !(PDFReference PDFPages)
                   !PDFDocumentPageMode
                   !PDFDocumentPageLayout
                   !PDFViewerPreferences

-- | The PDF state
data PdfState = PdfState { PdfState -> Int
supplySrc :: !Int -- ^ Supply of unique identifiers
                         , PdfState -> IntMap AnyPdfObject
objects :: !(IM.IntMap AnyPdfObject) -- ^ Dictionary of PDF objects
                         , PdfState -> Pages
pages :: !Pages -- ^ Pages
                         , PdfState
-> IntMap (Maybe (PDFReference PDFPage), (DrawState, Builder))
streams :: !(IM.IntMap ((Maybe (PDFReference PDFPage)),(DrawState,BU.Builder))) -- ^ Draw commands
                         , PdfState -> PDFReference PDFCatalog
catalog :: !(PDFReference PDFCatalog) -- ^ Reference to the PDF catalog
                         , PdfState -> PDFRect
defaultRect :: !PDFRect -- ^ Default page size
                         , PdfState -> PDFDocumentInfo
docInfo :: !PDFDocumentInfo -- ^ Document infos
                         , PdfState -> Maybe Outline
outline :: Maybe Outline -- ^ Root outline
                         , PdfState -> Maybe (PDFReference PDFPage)
currentPage :: Maybe (PDFReference PDFPage) -- ^ Reference to the current page used to create outlines
                         , PdfState -> IntMap (PDFFloat, PDFFloat)
xobjectBound :: !(IM.IntMap (PDFFloat,PDFFloat)) -- ^ Width and height of xobjects
                         , PdfState -> [Bool]
firstOutline :: [Bool] -- ^ Used to improve the outline API
                         }
                         
-- | A PDF Page object
#ifndef __HADDOCK__
data PDFPage = PDFPage 
          !(Maybe (PDFReference PDFPages)) --  Reference to parent
          !(PDFRect) -- Media box
          !(PDFReference PDFStream) -- Reference to content
          !(Maybe (PDFReference PDFResource)) -- Reference to resources
          !(Maybe PDFFloat) -- Optional duration
          !(Maybe PDFTransition) -- Optional transition
          ![AnyPdfObject] -- Annotation array
#else
data PDFPage
#endif

instance Show PDFPage where
    show :: PDFPage -> String
show PDFPage
_ = String
"PDFPage"
    
-- | List of all pages
newtype Pages = Pages (PDFTree PDFPage)

-- | PDF Pages
#ifndef __HADDOCK__
data PDFPages = PDFPages 
              !Int
              !(Maybe (PDFReference PDFPages)) -- Reference to parent 
              [Either (PDFReference PDFPages) (PDFReference PDFPage)]
#else
data PDFPages
#endif

-- | A PDF Transition
data PDFTransition = PDFTransition !PDFFloat !PDFTransStyle  
  deriving(PDFTransition -> PDFTransition -> Bool
(PDFTransition -> PDFTransition -> Bool)
-> (PDFTransition -> PDFTransition -> Bool) -> Eq PDFTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFTransition -> PDFTransition -> Bool
$c/= :: PDFTransition -> PDFTransition -> Bool
== :: PDFTransition -> PDFTransition -> Bool
$c== :: PDFTransition -> PDFTransition -> Bool
Eq)


-- | Dimension of a transition
data PDFTransDimension = Horizontal | Vertical 
 deriving(PDFTransDimension -> PDFTransDimension -> Bool
(PDFTransDimension -> PDFTransDimension -> Bool)
-> (PDFTransDimension -> PDFTransDimension -> Bool)
-> Eq PDFTransDimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFTransDimension -> PDFTransDimension -> Bool
$c/= :: PDFTransDimension -> PDFTransDimension -> Bool
== :: PDFTransDimension -> PDFTransDimension -> Bool
$c== :: PDFTransDimension -> PDFTransDimension -> Bool
Eq)


instance Show PDFTransDimension where
    show :: PDFTransDimension -> String
show PDFTransDimension
Horizontal = String
"H"
    show PDFTransDimension
Vertical = String
"V"

-- | Direction of a transition
data PDFTransDirection = Inward | Outward deriving(PDFTransDirection -> PDFTransDirection -> Bool
(PDFTransDirection -> PDFTransDirection -> Bool)
-> (PDFTransDirection -> PDFTransDirection -> Bool)
-> Eq PDFTransDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFTransDirection -> PDFTransDirection -> Bool
$c/= :: PDFTransDirection -> PDFTransDirection -> Bool
== :: PDFTransDirection -> PDFTransDirection -> Bool
$c== :: PDFTransDirection -> PDFTransDirection -> Bool
Eq)

instance Show PDFTransDirection where
    show :: PDFTransDirection -> String
show PDFTransDirection
Inward = String
"I"
    show PDFTransDirection
Outward = String
"O"

-- | Direction of a transition
data PDFTransDirection2 = LeftToRight
                        | BottomToTop -- ^ Wipe only
                        | RightToLeft -- ^ Wipe only
                        | TopToBottom
                        | TopLeftToBottomRight -- ^ Glitter only
                        deriving(PDFTransDirection2 -> PDFTransDirection2 -> Bool
(PDFTransDirection2 -> PDFTransDirection2 -> Bool)
-> (PDFTransDirection2 -> PDFTransDirection2 -> Bool)
-> Eq PDFTransDirection2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
$c/= :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
== :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
$c== :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
Eq)

-- | The PDF Monad
newtype PDF a = PDF {PDF a -> State PdfState a
unPDF :: State PdfState a}
#ifndef __HADDOCK__
  deriving (a -> PDF b -> PDF a
(a -> b) -> PDF a -> PDF b
(forall a b. (a -> b) -> PDF a -> PDF b)
-> (forall a b. a -> PDF b -> PDF a) -> Functor PDF
forall a b. a -> PDF b -> PDF a
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PDF b -> PDF a
$c<$ :: forall a b. a -> PDF b -> PDF a
fmap :: (a -> b) -> PDF a -> PDF b
$cfmap :: forall a b. (a -> b) -> PDF a -> PDF b
Functor, Functor PDF
a -> PDF a
Functor PDF
-> (forall a. a -> PDF a)
-> (forall a b. PDF (a -> b) -> PDF a -> PDF b)
-> (forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c)
-> (forall a b. PDF a -> PDF b -> PDF b)
-> (forall a b. PDF a -> PDF b -> PDF a)
-> Applicative PDF
PDF a -> PDF b -> PDF b
PDF a -> PDF b -> PDF a
PDF (a -> b) -> PDF a -> PDF b
(a -> b -> c) -> PDF a -> PDF b -> PDF c
forall a. a -> PDF a
forall a b. PDF a -> PDF b -> PDF a
forall a b. PDF a -> PDF b -> PDF b
forall a b. PDF (a -> b) -> PDF a -> PDF b
forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PDF a -> PDF b -> PDF a
$c<* :: forall a b. PDF a -> PDF b -> PDF a
*> :: PDF a -> PDF b -> PDF b
$c*> :: forall a b. PDF a -> PDF b -> PDF b
liftA2 :: (a -> b -> c) -> PDF a -> PDF b -> PDF c
$cliftA2 :: forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c
<*> :: PDF (a -> b) -> PDF a -> PDF b
$c<*> :: forall a b. PDF (a -> b) -> PDF a -> PDF b
pure :: a -> PDF a
$cpure :: forall a. a -> PDF a
$cp1Applicative :: Functor PDF
Applicative, Applicative PDF
a -> PDF a
Applicative PDF
-> (forall a b. PDF a -> (a -> PDF b) -> PDF b)
-> (forall a b. PDF a -> PDF b -> PDF b)
-> (forall a. a -> PDF a)
-> Monad PDF
PDF a -> (a -> PDF b) -> PDF b
PDF a -> PDF b -> PDF b
forall a. a -> PDF a
forall a b. PDF a -> PDF b -> PDF b
forall a b. PDF a -> (a -> PDF b) -> PDF b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PDF a
$creturn :: forall a. a -> PDF a
>> :: PDF a -> PDF b -> PDF b
$c>> :: forall a b. PDF a -> PDF b -> PDF b
>>= :: PDF a -> (a -> PDF b) -> PDF b
$c>>= :: forall a b. PDF a -> (a -> PDF b) -> PDF b
$cp1Monad :: Applicative PDF
Monad, MonadState PdfState)
#else
instance Functor PDF
instance Monad PDF
instance MonadState PdfState PDF
#endif

-- | Transition style
data PDFTransStyle = Split PDFTransDimension PDFTransDirection
                   | Blinds PDFTransDimension 
                   | Box  PDFTransDirection
                   | Wipe PDFTransDirection2
                   | Dissolve 
                   | Glitter PDFTransDirection2
                   deriving(PDFTransStyle -> PDFTransStyle -> Bool
(PDFTransStyle -> PDFTransStyle -> Bool)
-> (PDFTransStyle -> PDFTransStyle -> Bool) -> Eq PDFTransStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFTransStyle -> PDFTransStyle -> Bool
$c/= :: PDFTransStyle -> PDFTransStyle -> Bool
== :: PDFTransStyle -> PDFTransStyle -> Bool
$c== :: PDFTransStyle -> PDFTransStyle -> Bool
Eq)

-- | Document metadata
data PDFDocumentInfo = PDFDocumentInfo {
                     PDFDocumentInfo -> Text
author :: T.Text
                   , PDFDocumentInfo -> Text
subject :: T.Text
                   , PDFDocumentInfo -> PDFDocumentPageMode
pageMode :: PDFDocumentPageMode
                   , PDFDocumentInfo -> PDFDocumentPageLayout
pageLayout :: PDFDocumentPageLayout
                   , PDFDocumentInfo -> PDFViewerPreferences
viewerPreferences :: PDFViewerPreferences
                   , PDFDocumentInfo -> Bool
compressed :: Bool
                   }


-- | Document page mode
data PDFDocumentPageMode = UseNone
                       | UseOutlines
                       | UseThumbs
                       | FullScreen
                       deriving(PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
(PDFDocumentPageMode -> PDFDocumentPageMode -> Bool)
-> (PDFDocumentPageMode -> PDFDocumentPageMode -> Bool)
-> Eq PDFDocumentPageMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
$c/= :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
== :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
$c== :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
Eq,Int -> PDFDocumentPageMode -> String -> String
[PDFDocumentPageMode] -> String -> String
PDFDocumentPageMode -> String
(Int -> PDFDocumentPageMode -> String -> String)
-> (PDFDocumentPageMode -> String)
-> ([PDFDocumentPageMode] -> String -> String)
-> Show PDFDocumentPageMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PDFDocumentPageMode] -> String -> String
$cshowList :: [PDFDocumentPageMode] -> String -> String
show :: PDFDocumentPageMode -> String
$cshow :: PDFDocumentPageMode -> String
showsPrec :: Int -> PDFDocumentPageMode -> String -> String
$cshowsPrec :: Int -> PDFDocumentPageMode -> String -> String
Show)

-- | Document page layout
data PDFDocumentPageLayout = SinglePage
                           | OneColumn
                           | TwoColumnLeft
                           | TwoColumnRight
                           | TwoPageLeft
                           | TwoPageRight
                           deriving(PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
(PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool)
-> (PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool)
-> Eq PDFDocumentPageLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
$c/= :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
== :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
$c== :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
Eq,Int -> PDFDocumentPageLayout -> String -> String
[PDFDocumentPageLayout] -> String -> String
PDFDocumentPageLayout -> String
(Int -> PDFDocumentPageLayout -> String -> String)
-> (PDFDocumentPageLayout -> String)
-> ([PDFDocumentPageLayout] -> String -> String)
-> Show PDFDocumentPageLayout
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PDFDocumentPageLayout] -> String -> String
$cshowList :: [PDFDocumentPageLayout] -> String -> String
show :: PDFDocumentPageLayout -> String
$cshow :: PDFDocumentPageLayout -> String
showsPrec :: Int -> PDFDocumentPageLayout -> String -> String
$cshowsPrec :: Int -> PDFDocumentPageLayout -> String -> String
Show)

-- | Viewer preferences
data PDFViewerPreferences = PDFViewerPreferences { PDFViewerPreferences -> Bool
hideToolbar :: Bool -- ^ To hide the toolbar
                          , PDFViewerPreferences -> Bool
hideMenuBar :: Bool -- ^ To hide the menubar
                          , PDFViewerPreferences -> Bool
hideWindowUI :: Bool -- ^ To hide the window
                          , PDFViewerPreferences -> Bool
fitWindow :: Bool -- ^ Fit window to screen
                          , PDFViewerPreferences -> Bool
centerWindow :: Bool -- ^ Center window on screen
                          , PDFViewerPreferences -> Bool
displayDoctitle :: Bool -- ^ Display the docu,ent title
                          , PDFViewerPreferences -> PDFDocumentPageMode
nonFullScreenPageMode :: PDFDocumentPageMode -- ^ Display mode when exiting the full screen mode
                          }

data PDFOutline = PDFOutline !(PDFReference PDFOutlineEntry) !(PDFReference PDFOutlineEntry)

instance PdfObject PDFOutline where
 toPDF :: PDFOutline -> Builder
toPDF (PDFOutline PDFReference PDFOutlineEntry
first PDFReference PDFOutlineEntry
lasto) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [
    (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Outlines")
  , (String -> PDFName
PDFName String
"First",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
first)
  , (String -> PDFName
PDFName String
"Last",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
lasto)
  ]

instance PdfLengthInfo PDFOutline where

data OutlineStyle = NormalOutline
                  | ItalicOutline
                  | BoldOutline
                  deriving(OutlineStyle -> OutlineStyle -> Bool
(OutlineStyle -> OutlineStyle -> Bool)
-> (OutlineStyle -> OutlineStyle -> Bool) -> Eq OutlineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutlineStyle -> OutlineStyle -> Bool
$c/= :: OutlineStyle -> OutlineStyle -> Bool
== :: OutlineStyle -> OutlineStyle -> Bool
$c== :: OutlineStyle -> OutlineStyle -> Bool
Eq)

data PDFOutlineEntry = PDFOutlineEntry !PDFString 
                              !(PDFReference PDFOutlineEntry) -- Parent
                              !(Maybe (PDFReference PDFOutlineEntry)) -- Prev
                              !(Maybe (PDFReference PDFOutlineEntry)) -- Next
                              !(Maybe (PDFReference PDFOutlineEntry)) -- First
                              !(Maybe (PDFReference PDFOutlineEntry)) -- Last
                              Int -- Count of descendent (negative)
                              Destination
                              Color --
                              OutlineStyle 

data Destination = Destination !(PDFReference PDFPage) deriving(Destination -> Destination -> Bool
(Destination -> Destination -> Bool)
-> (Destination -> Destination -> Bool) -> Eq Destination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Destination -> Destination -> Bool
$c/= :: Destination -> Destination -> Bool
== :: Destination -> Destination -> Bool
$c== :: Destination -> Destination -> Bool
Eq,Int -> Destination -> String -> String
[Destination] -> String -> String
Destination -> String
(Int -> Destination -> String -> String)
-> (Destination -> String)
-> ([Destination] -> String -> String)
-> Show Destination
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Destination] -> String -> String
$cshowList :: [Destination] -> String -> String
show :: Destination -> String
$cshow :: Destination -> String
showsPrec :: Int -> Destination -> String -> String
$cshowsPrec :: Int -> Destination -> String -> String
Show)

-- Outline types without a position pointer. The true outline is the derivative
type OutlineData = (PDFString,Maybe Color, Maybe OutlineStyle,Destination)
type Outline = OutlineLoc OutlineData

data Tree a = Node a [Tree a]

data OutlineCtx a = Top | Child { OutlineCtx a -> a
value :: a
                                , OutlineCtx a -> OutlineCtx a
parent :: OutlineCtx a 
                                , OutlineCtx a -> [Tree a]
lefts :: [Tree a]
                                , OutlineCtx a -> [Tree a]
rights :: [Tree a]
                                }
                                

data OutlineLoc  a = OutlineLoc (Tree a) (OutlineCtx a)

instance PdfObject PDFViewerPreferences where
  toPDF :: PDFViewerPreferences -> Builder
toPDF (PDFViewerPreferences Bool
ht Bool
hm Bool
hwui Bool
fw Bool
cw Bool
ddt PDFDocumentPageMode
nfspm ) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
   [ (String -> PDFName
PDFName String
"HideToolbar",Bool -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
ht)
   , (String -> PDFName
PDFName String
"HideMenubar",Bool -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
hm)
   , (String -> PDFName
PDFName String
"HideWindowUI",Bool -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
hwui)
   , (String -> PDFName
PDFName String
"FitWindow",Bool -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
fw)
   , (String -> PDFName
PDFName String
"CenterWindow",Bool -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
cw)
   , (String -> PDFName
PDFName String
"DisplayDocTitle",Bool -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
ddt)
   , (String -> PDFName
PDFName String
"NonFullScreenPageMode",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject  (PDFName -> AnyPdfObject)
-> (PDFDocumentPageMode -> PDFName)
-> PDFDocumentPageMode
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> PDFName)
-> (PDFDocumentPageMode -> String)
-> PDFDocumentPageMode
-> PDFName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentPageMode -> String
forall a. Show a => a -> String
show (PDFDocumentPageMode -> AnyPdfObject)
-> PDFDocumentPageMode -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ PDFDocumentPageMode
nfspm)
   ]

instance PdfLengthInfo PDFViewerPreferences where


instance Show PDFTransStyle where
   show :: PDFTransStyle -> String
show (Split PDFTransDimension
_ PDFTransDirection
_) = String
"Split"
   show (Blinds PDFTransDimension
_) = String
"Blinds"
   show (Box PDFTransDirection
_) = String
"Box"
   show (Wipe PDFTransDirection2
_) = String
"Wipe"
   show (PDFTransStyle
Dissolve) = String
"Dissolve"
   show (Glitter PDFTransDirection2
_) = String
"Glitter"

instance PdfObject PDFTransition where
 toPDF :: PDFTransition -> Builder
toPDF (PDFTransition PDFFloat
d PDFTransStyle
t) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
   [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Trans"))
   , (String -> PDFName
PDFName String
"S",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (PDFTransStyle -> String
forall a. Show a => a -> String
show PDFTransStyle
t)))
   , (String -> PDFName
PDFName String
"D",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
d)
   ] [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalDm PDFTransStyle
t [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalM PDFTransStyle
t [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalDi PDFTransStyle
t
  where
    optionalDm :: PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalDm (Split PDFTransDimension
a PDFTransDirection
_) = [ (String -> PDFName
PDFName String
"Dm",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (PDFTransDimension -> String
forall a. Show a => a -> String
show PDFTransDimension
a)))]
    optionalDm (Blinds PDFTransDimension
a) = [ (String -> PDFName
PDFName String
"Dm",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (PDFTransDimension -> String
forall a. Show a => a -> String
show PDFTransDimension
a)))]
    optionalDm PDFTransStyle
_ = []
    optionalM :: PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalM (Split PDFTransDimension
_ PDFTransDirection
a) = [ (String -> PDFName
PDFName String
"M",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (PDFTransDirection -> String
forall a. Show a => a -> String
show PDFTransDirection
a)))]
    optionalM (Box PDFTransDirection
a) = [ (String -> PDFName
PDFName String
"M",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (PDFTransDirection -> String
forall a. Show a => a -> String
show PDFTransDirection
a)))]
    optionalM PDFTransStyle
_ = []    
    optionalDi :: PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalDi (Wipe PDFTransDirection2
a) = [ (String -> PDFName
PDFName String
"Di",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFTransDirection2 -> PDFFloat
floatDirection PDFTransDirection2
a))]
    optionalDi (Glitter PDFTransDirection2
a)  = [ (String -> PDFName
PDFName String
"Di",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFTransDirection2 -> PDFFloat
floatDirection PDFTransDirection2
a))]
    optionalDi PDFTransStyle
_ = []  

instance PdfLengthInfo PDFTransition where

-- PDF Pages

instance PdfObject PDFPages where
 toPDF :: PDFPages -> Builder
toPDF (PDFPages Int
c Maybe (PDFReference PDFPages)
Nothing [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
  [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Pages"))
  , (String -> PDFName
PDFName String
"Kids",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject) -> [AnyPdfObject] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ (Either (PDFReference PDFPages) (PDFReference PDFPage)
 -> AnyPdfObject)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map Either (PDFReference PDFPages) (PDFReference PDFPage)
-> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l)
  , (String -> PDFName
PDFName String
"Count",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Int
c)
  ] 
 toPDF (PDFPages Int
c (Just PDFReference PDFPages
theParent) [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
  [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Pages"))
  , (String -> PDFName
PDFName String
"Parent",PDFReference PDFPages -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPages
theParent)
  , (String -> PDFName
PDFName String
"Kids",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject) -> [AnyPdfObject] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ (Either (PDFReference PDFPages) (PDFReference PDFPage)
 -> AnyPdfObject)
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map Either (PDFReference PDFPages) (PDFReference PDFPage)
-> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l)
  , (String -> PDFName
PDFName String
"Count",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Int
c)
  ] 

instance PdfLengthInfo PDFPages where


instance PdfObject PDFPage where
 toPDF :: PDFPage -> Builder
toPDF (PDFPage (Just PDFReference PDFPages
theParent) PDFRect
box PDFReference PDFStream
content Maybe (PDFReference PDFResource)
theRsrc Maybe PDFFloat
d Maybe PDFTransition
t [AnyPdfObject]
theAnnots) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
  [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Page"))
  , (String -> PDFName
PDFName String
"Parent",PDFReference PDFPages -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPages
theParent)
  , (String -> PDFName
PDFName String
"MediaBox",PDFRect -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFRect
box)
  , (String -> PDFName
PDFName String
"Contents",PDFReference PDFStream -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFStream
content)
  , if Maybe (PDFReference PDFResource) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (PDFReference PDFResource)
theRsrc 
      then
       (String -> PDFName
PDFName String
"Resources",PDFReference PDFResource -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFReference PDFResource -> AnyPdfObject)
-> (Maybe (PDFReference PDFResource) -> PDFReference PDFResource)
-> Maybe (PDFReference PDFResource)
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (PDFReference PDFResource) -> PDFReference PDFResource
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (PDFReference PDFResource) -> AnyPdfObject)
-> Maybe (PDFReference PDFResource) -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Maybe (PDFReference PDFResource)
theRsrc) 
      else 
       (String -> PDFName
PDFName String
"Resources",PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFDictionary
emptyDictionary)
  ] [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ ([(PDFName, AnyPdfObject)]
-> (PDFFloat -> [(PDFName, AnyPdfObject)])
-> Maybe PDFFloat
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFFloat
x -> [(String -> PDFName
PDFName String
"Dur",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
x)]) Maybe PDFFloat
d)
  [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ ([(PDFName, AnyPdfObject)]
-> (PDFTransition -> [(PDFName, AnyPdfObject)])
-> Maybe PDFTransition
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFTransition
x -> [(String -> PDFName
PDFName String
"Trans",PDFTransition -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFTransition
x)]) Maybe PDFTransition
t)
  [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ ((\[AnyPdfObject]
x -> if [AnyPdfObject] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnyPdfObject]
x then [] else [(String -> PDFName
PDFName String
"Annots",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject [AnyPdfObject]
x)]) [AnyPdfObject]
theAnnots)
 toPDF (PDFPage Maybe (PDFReference PDFPages)
Nothing PDFRect
_ PDFReference PDFStream
_ Maybe (PDFReference PDFResource)
_ Maybe PDFFloat
_ Maybe PDFTransition
_ [AnyPdfObject]
_) = Builder
forall a. Monoid a => a
noPdfObject

instance PdfLengthInfo PDFPage where

-- Main objects in a PDF document

instance PdfObject PDFCatalog where
 toPDF :: PDFCatalog -> Builder
toPDF (PDFCatalog Maybe (PDFReference PDFOutline)
outlines PDFReference PDFPages
lPages PDFDocumentPageMode
pgMode PDFDocumentPageLayout
pgLayout PDFViewerPreferences
viewerPrefs) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
   [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Catalog"))
   , (String -> PDFName
PDFName String
"Pages",PDFReference PDFPages -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPages
lPages)
   , (String -> PDFName
PDFName String
"PageMode", PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (PDFDocumentPageMode -> PDFName)
-> PDFDocumentPageMode
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> PDFName)
-> (PDFDocumentPageMode -> String)
-> PDFDocumentPageMode
-> PDFName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentPageMode -> String
forall a. Show a => a -> String
show (PDFDocumentPageMode -> AnyPdfObject)
-> PDFDocumentPageMode -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ PDFDocumentPageMode
pgMode)
   , (String -> PDFName
PDFName String
"PageLayout", PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (PDFDocumentPageLayout -> PDFName)
-> PDFDocumentPageLayout
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> PDFName)
-> (PDFDocumentPageLayout -> String)
-> PDFDocumentPageLayout
-> PDFName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDFDocumentPageLayout -> String
forall a. Show a => a -> String
show (PDFDocumentPageLayout -> AnyPdfObject)
-> PDFDocumentPageLayout -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ PDFDocumentPageLayout
pgLayout)
   , (String -> PDFName
PDFName String
"ViewerPreferences", PDFViewerPreferences -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFViewerPreferences
viewerPrefs)
   ] [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ ([(PDFName, AnyPdfObject)]
-> (PDFReference PDFOutline -> [(PDFName, AnyPdfObject)])
-> Maybe (PDFReference PDFOutline)
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutline
x -> [(String -> PDFName
PDFName String
"Outlines",PDFReference PDFOutline -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutline
x)]) Maybe (PDFReference PDFOutline)
outlines)

instance PdfLengthInfo PDFCatalog where

instance PdfObject OutlineStyle where
   toPDF :: OutlineStyle -> Builder
toPDF OutlineStyle
NormalOutline = PDFInteger -> Builder
forall a. PdfObject a => a -> Builder
toPDF (Int -> PDFInteger
PDFInteger Int
0)
   toPDF OutlineStyle
ItalicOutline = PDFInteger -> Builder
forall a. PdfObject a => a -> Builder
toPDF (Int -> PDFInteger
PDFInteger Int
1)
   toPDF OutlineStyle
BoldOutline = PDFInteger -> Builder
forall a. PdfObject a => a -> Builder
toPDF (Int -> PDFInteger
PDFInteger Int
2)

instance PdfLengthInfo OutlineStyle where

instance PdfObject PDFOutlineEntry where
 toPDF :: PDFOutlineEntry -> Builder
toPDF (PDFOutlineEntry PDFString
title PDFReference PDFOutlineEntry
theParent Maybe (PDFReference PDFOutlineEntry)
prev Maybe (PDFReference PDFOutlineEntry)
next Maybe (PDFReference PDFOutlineEntry)
first Maybe (PDFReference PDFOutlineEntry)
theLast Int
count Destination
dest Color
color OutlineStyle
style) = 
     PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [
        (String -> PDFName
PDFName String
"Title",PDFString -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFString
title)
        , (String -> PDFName
PDFName String
"Parent",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
theParent)
        ]
      [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++
      [(PDFName, AnyPdfObject)]
-> (PDFReference PDFOutlineEntry -> [(PDFName, AnyPdfObject)])
-> Maybe (PDFReference PDFOutlineEntry)
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"Prev",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
prev
      [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++
      [(PDFName, AnyPdfObject)]
-> (PDFReference PDFOutlineEntry -> [(PDFName, AnyPdfObject)])
-> Maybe (PDFReference PDFOutlineEntry)
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"Next",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
next
      [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++
      [(PDFName, AnyPdfObject)]
-> (PDFReference PDFOutlineEntry -> [(PDFName, AnyPdfObject)])
-> Maybe (PDFReference PDFOutlineEntry)
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"First",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
first
      [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++
      [(PDFName, AnyPdfObject)]
-> (PDFReference PDFOutlineEntry -> [(PDFName, AnyPdfObject)])
-> Maybe (PDFReference PDFOutlineEntry)
-> [(PDFName, AnyPdfObject)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"Last",PDFReference PDFOutlineEntry -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
theLast
      [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++
      [ (String -> PDFName
PDFName String
"Count",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (Int -> PDFInteger
PDFInteger Int
count))
      , (String -> PDFName
PDFName String
"Dest",Destination -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Destination
dest)
      , (String -> PDFName
PDFName String
"C",Color -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Color
color)
      , (String -> PDFName
PDFName String
"F",OutlineStyle -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject OutlineStyle
style)
      ]

instance PdfLengthInfo PDFOutlineEntry where


instance PdfObject Destination where
  toPDF :: Destination -> Builder
toPDF (Destination PDFReference PDFPage
r) = [AnyPdfObject] -> Builder
forall a. PdfObject a => a -> Builder
toPDF                [ PDFReference PDFPage -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPage
r
                                               , PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Fit"
                                               ]

instance PdfLengthInfo Destination where

                                              
instance PdfObject Color where
   toPDF :: Color -> Builder
toPDF (Rgb PDFFloat
r PDFFloat
g PDFFloat
b) = [AnyPdfObject] -> Builder
forall a. PdfObject a => a -> Builder
toPDF ([AnyPdfObject] -> Builder)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> Builder) -> [PDFFloat] -> Builder
forall a b. (a -> b) -> a -> b
$ [PDFFloat
r,PDFFloat
g,PDFFloat
b]  
   toPDF (Hsv PDFFloat
h PDFFloat
s PDFFloat
v) = let (PDFFloat
r,PDFFloat
g,PDFFloat
b) = (PDFFloat, PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat, PDFFloat)
hsvToRgb (PDFFloat
h,PDFFloat
s,PDFFloat
v)
    in [AnyPdfObject] -> Builder
forall a. PdfObject a => a -> Builder
toPDF ([AnyPdfObject] -> Builder)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> Builder) -> [PDFFloat] -> Builder
forall a b. (a -> b) -> a -> b
$ [PDFFloat
r,PDFFloat
g,PDFFloat
b]

instance PdfLengthInfo Color where

-- Degree for a transition direction
floatDirection :: PDFTransDirection2 -> PDFFloat
floatDirection :: PDFTransDirection2 -> PDFFloat
floatDirection PDFTransDirection2
LeftToRight = PDFFloat
0
floatDirection PDFTransDirection2
BottomToTop = PDFFloat
90
floatDirection PDFTransDirection2
RightToLeft = PDFFloat
180 
floatDirection PDFTransDirection2
TopToBottom = PDFFloat
270
floatDirection PDFTransDirection2
TopLeftToBottomRight = PDFFloat
315


hsvToRgb :: (Double,Double,Double) -> (Double,Double,Double)
hsvToRgb :: (PDFFloat, PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat, PDFFloat)
hsvToRgb (PDFFloat
h,PDFFloat
s,PDFFloat
v) =
  let hi :: PDFFloat
hi = Int -> PDFFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PDFFloat -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (PDFFloat
h PDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/ PDFFloat
60) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
6 :: Int) :: Double
      f :: PDFFloat
f = PDFFloat
hPDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/PDFFloat
60 PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
hi
      p :: PDFFloat
p = PDFFloat
v PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
* (PDFFloat
1PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
s)
      q :: PDFFloat
q = PDFFloat
v PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
* (PDFFloat
1 PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
fPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
s)
      t :: PDFFloat
t = PDFFloat
v PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
* (PDFFloat
1 PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- (PDFFloat
1PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
f)PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
s) in
 case PDFFloat
hi of
      PDFFloat
0 -> (PDFFloat
v,PDFFloat
t,PDFFloat
p)
      PDFFloat
1 -> (PDFFloat
q,PDFFloat
v,PDFFloat
p)
      PDFFloat
2 -> (PDFFloat
p,PDFFloat
v,PDFFloat
t)
      PDFFloat
3 -> (PDFFloat
p,PDFFloat
q,PDFFloat
v)
      PDFFloat
4 -> (PDFFloat
t,PDFFloat
p,PDFFloat
v)
      PDFFloat
5 -> (PDFFloat
v,PDFFloat
p,PDFFloat
q)
      PDFFloat
_ -> String -> (PDFFloat, PDFFloat, PDFFloat)
forall a. HasCallStack => String -> a
error String
"Hue value incorrect"

getRgbColor :: Color -> (PDFFloat,PDFFloat,PDFFloat) 
getRgbColor :: Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor (Rgb PDFFloat
r PDFFloat
g PDFFloat
b) = (PDFFloat
r, PDFFloat
g, PDFFloat
b)  
getRgbColor (Hsv PDFFloat
h PDFFloat
s PDFFloat
v) = let (PDFFloat
r,PDFFloat
g,PDFFloat
b) = (PDFFloat, PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat, PDFFloat)
hsvToRgb (PDFFloat
h,PDFFloat
s,PDFFloat
v) in (PDFFloat
r, PDFFloat
g, PDFFloat
b)  

-- | Interpolation function
interpole :: Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole :: Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
n PDFFloat
x PDFFloat
y = PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ 
                            [ (String -> PDFName
PDFName String
"FunctionType", PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Int
2)
                            , (String -> PDFName
PDFName String
"Domain", [AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> AnyPdfObject) -> [PDFFloat] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ ([PDFFloat
0,PDFFloat
1] :: [PDFFloat]))
                            , (String -> PDFName
PDFName String
"C0", [AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> AnyPdfObject) -> [PDFFloat] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFFloat
x])
                            , (String -> PDFName
PDFName String
"C1", [AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> AnyPdfObject) -> [PDFFloat] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFFloat
y])
                            , (String -> PDFName
PDFName String
"N", PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$  Int
n)
                            ]

-- | A shading                             
data PDFShading = AxialShading PDFFloat PDFFloat PDFFloat PDFFloat Color Color
                | RadialShading PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat Color Color
                deriving(PDFShading -> PDFShading -> Bool
(PDFShading -> PDFShading -> Bool)
-> (PDFShading -> PDFShading -> Bool) -> Eq PDFShading
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFShading -> PDFShading -> Bool
$c/= :: PDFShading -> PDFShading -> Bool
== :: PDFShading -> PDFShading -> Bool
$c== :: PDFShading -> PDFShading -> Bool
Eq,Eq PDFShading
Eq PDFShading
-> (PDFShading -> PDFShading -> Ordering)
-> (PDFShading -> PDFShading -> Bool)
-> (PDFShading -> PDFShading -> Bool)
-> (PDFShading -> PDFShading -> Bool)
-> (PDFShading -> PDFShading -> Bool)
-> (PDFShading -> PDFShading -> PDFShading)
-> (PDFShading -> PDFShading -> PDFShading)
-> Ord PDFShading
PDFShading -> PDFShading -> Bool
PDFShading -> PDFShading -> Ordering
PDFShading -> PDFShading -> PDFShading
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDFShading -> PDFShading -> PDFShading
$cmin :: PDFShading -> PDFShading -> PDFShading
max :: PDFShading -> PDFShading -> PDFShading
$cmax :: PDFShading -> PDFShading -> PDFShading
>= :: PDFShading -> PDFShading -> Bool
$c>= :: PDFShading -> PDFShading -> Bool
> :: PDFShading -> PDFShading -> Bool
$c> :: PDFShading -> PDFShading -> Bool
<= :: PDFShading -> PDFShading -> Bool
$c<= :: PDFShading -> PDFShading -> Bool
< :: PDFShading -> PDFShading -> Bool
$c< :: PDFShading -> PDFShading -> Bool
compare :: PDFShading -> PDFShading -> Ordering
$ccompare :: PDFShading -> PDFShading -> Ordering
$cp1Ord :: Eq PDFShading
Ord)

instance PdfResourceObject PDFShading where
      toRsrc :: PDFShading -> AnyPdfObject
toRsrc (AxialShading PDFFloat
x0 PDFFloat
y0 PDFFloat
x1 PDFFloat
y1 Color
ca Color
cb) = PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                                 [ (String -> PDFName
PDFName String
"ShadingType",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Int
2)
                                 , (String -> PDFName
PDFName String
"Coords",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> AnyPdfObject) -> [PDFFloat] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFFloat
x0,PDFFloat
y0,PDFFloat
x1,PDFFloat
y1])
                                 , (String -> PDFName
PDFName String
"ColorSpace",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"DeviceRGB")
                                 , (String -> PDFName
PDFName String
"Function",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject) -> [AnyPdfObject] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
1 PDFFloat
ra PDFFloat
rb,Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
1 PDFFloat
ga PDFFloat
gb,Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
1 PDFFloat
ba PDFFloat
bb])
                                 ]
        where
            (PDFFloat
ra,PDFFloat
ga,PDFFloat
ba) = Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor Color
ca
            (PDFFloat
rb,PDFFloat
gb,PDFFloat
bb) = Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor Color
cb
      toRsrc (RadialShading PDFFloat
x0 PDFFloat
y0 PDFFloat
r0 PDFFloat
x1 PDFFloat
y1 PDFFloat
r1 Color
ca Color
cb) = PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                                         [ (String -> PDFName
PDFName String
"ShadingType",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Int
3)
                                         , (String -> PDFName
PDFName String
"Coords",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> AnyPdfObject) -> [PDFFloat] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFFloat
x0,PDFFloat
y0,PDFFloat
r0,PDFFloat
x1,PDFFloat
y1,PDFFloat
r1])
                                         , (String -> PDFName
PDFName String
"ColorSpace",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"DeviceRGB")
                                         , (String -> PDFName
PDFName String
"Function",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject) -> [AnyPdfObject] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
1 PDFFloat
ra PDFFloat
rb,Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
1 PDFFloat
ga PDFFloat
gb,Int -> PDFFloat -> PDFFloat -> AnyPdfObject
interpole Int
1 PDFFloat
ba PDFFloat
bb])
                                         ]
        where
           (PDFFloat
ra,PDFFloat
ga,PDFFloat
ba) = Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor Color
ca
           (PDFFloat
rb,PDFFloat
gb,PDFFloat
bb) = Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor Color
cb


-- | Apply a transformation matrix to the current coordinate frame
applyMatrix :: Matrix -> Draw ()
applyMatrix :: Matrix -> Draw ()
applyMatrix m :: Matrix
m@(Matrix PDFFloat
a PDFFloat
b PDFFloat
c PDFFloat
d PDFFloat
e PDFFloat
f)  = do
    Matrix -> Draw ()
multiplyCurrentMatrixWith Matrix
m
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
'\n'
                    , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
a
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
b
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
c
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
d
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
e
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
f
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" cm"
                    ]