{-# 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 = 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) = 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 <- forall a. AnnotationObject a => a -> PDF (PDFReference a)
addAnnotation a
a
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
r)
    annotationType :: AnyAnnotation -> PDFName
annotationType (AnyAnnotation a
a) = forall a. AnnotationObject a => a -> PDFName
annotationType a
a
    annotationContent :: AnyAnnotation -> AnyPdfObject
annotationContent (AnyAnnotation a
a) = forall a. AnnotationObject a => a -> AnyPdfObject
annotationContent a
a
    annotationRect :: AnyAnnotation -> [PDFFloat]
annotationRect (AnyAnnotation a
a) = 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
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
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
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 {  forall s. DrawTuple s -> DrawEnvironment
drawEnvironment    :: DrawEnvironment
               ,  forall s. DrawTuple s -> STRef s DrawState
drawStateRef  :: STRef s DrawState
               ,  forall s. DrawTuple s -> STRef s Builder
builderRef :: STRef s BU.Builder
               ,  forall s. DrawTuple s -> STRef s Point
penPosition :: STRef s Point
               }
    
emptyEnvironment :: DrawEnvironment
emptyEnvironment :: DrawEnvironment
emptyEnvironment = Int -> IntMap (PDFFloat, PDFFloat) -> DrawEnvironment
DrawEnvironment Int
0 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 {forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw :: forall s. DrawTuple s -> ST s a }

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


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

instance MonadReader DrawEnvironment Draw where
   ask :: Draw DrawEnvironment
ask       = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. DrawTuple s -> DrawEnvironment
drawEnvironment DrawTuple s
env)
   local :: forall a. (DrawEnvironment -> DrawEnvironment) -> Draw a -> Draw a
local DrawEnvironment -> DrawEnvironment
f Draw a
m = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> let drawenv' :: DrawEnvironment
drawenv' = DrawEnvironment -> DrawEnvironment
f (forall s. DrawTuple s -> DrawEnvironment
drawEnvironment DrawTuple s
env)
                                  env' :: DrawTuple s
env' = DrawTuple s
env { drawEnvironment :: DrawEnvironment
drawEnvironment = DrawEnvironment
drawenv' }
                               in 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 a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall s a. STRef s a -> ST s a
readSTRef  (forall s. DrawTuple s -> STRef s DrawState
drawStateRef DrawTuple s
env)
    put :: DrawState -> Draw ()
put DrawState
st = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall s a. STRef s a -> a -> ST s ()
writeSTRef (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 a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
env) (forall a. Monoid a => a -> a -> a
`mappend` Builder
bu)
    listen :: forall a. Draw a -> Draw (a, Builder)
listen Draw a
m = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> do
                 a
a <- forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
m DrawTuple s
env
                 Builder
w <- forall s a. STRef s a -> ST s a
readSTRef (forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
env)
                 forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Builder
w)
    pass :: forall a. Draw (a, Builder -> Builder) -> Draw a
pass   Draw (a, Builder -> Builder)
m = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> do
                 (a
a, Builder -> Builder
f) <- forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw (a, Builder -> Builder)
m DrawTuple s
env
                 forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
env) Builder -> Builder
f
                 forall (m :: * -> *) a. Monad m => a -> m a
return a
a

instance Functor Draw where
     fmap :: forall a b. (a -> b) -> Draw a -> Draw b
fmap a -> b
f = \Draw a
m -> do { a
a <- Draw a
m; 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 a. (forall s. DrawTuple s -> STRef s a) -> Draw a
readDrawST   forall s. DrawTuple s -> STRef s a
f   = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall s a. STRef s a -> ST s a
readSTRef   (forall s. DrawTuple s -> STRef s a
f DrawTuple s
env) 

writeDrawST :: (forall s. DrawTuple s -> STRef s a) -> a -> Draw ()
writeDrawST :: forall a. (forall s. DrawTuple s -> STRef s a) -> a -> Draw ()
writeDrawST  forall s. DrawTuple s -> STRef s a
f a
x = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall s a. STRef s a -> a -> ST s ()
writeSTRef  (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 a.
(forall s. DrawTuple s -> STRef s a) -> (a -> a) -> Draw ()
modifyDrawST forall s. DrawTuple s -> STRef s a
f a -> a
g = forall a. (forall s. DrawTuple s -> ST s a) -> Draw a
Draw forall a b. (a -> b) -> a -> b
$ \DrawTuple s
env -> forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (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) = 
      forall a. Monoid a => [a] -> a
mconcat   forall a b. (a -> b) -> a -> b
$ [ forall a. PdfObject a => a -> Builder
toPDF PDFDictionary
dict
                  , forall s a. SerializeValue s a => a -> s
serialize String
"\nstream"
                  , forall s. SerializeValue s Char => s
newline
                  , Builder
s
                  , forall s. SerializeValue s Char => s
newline
                  , 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",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"FlateDecode"])] else []
      lenDict :: PDFDictionary
lenDict = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [ (String -> PDFName
PDFName String
"Length",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference MaybeLength
l)] 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
_) = forall a. a -> Maybe a
Just (ByteString -> Int64
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString forall a b. (a -> b) -> a -> b
$ Builder
s,PDFReference MaybeLength
l)
    
-- | An empty drawing
emptyDrawing :: Draw ()
emptyDrawing :: Draw ()
emptyDrawing = 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)  = 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> [String]
supplyNames -- infinite list
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {supplyNames :: [String]
supplyNames = forall a. [a] -> [a]
tail [String]
xs}
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> a
head [String]
xs)
    
emptyDrawState :: Int -> DrawState
emptyDrawState :: Int -> DrawState
emptyDrawState Int
ref = 
    let names :: [String]
names = (forall a b. (a -> b) -> [a] -> [b]
map ((String
"O" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show Int
ref)) forall a. [a] -> [a] -> [a]
++ ) forall a b. (a -> b) -> a -> b
$ [forall a. Int -> a -> [a]
replicate Int
k [Char
'a'..Char
'z'] | Int
k <- [Int
1..]] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty PDFDictionary
emptyDictionary []  forall k a. Map k a
M.empty forall k a. Map k a
M.empty 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 :: forall a.
Draw a -> DrawEnvironment -> DrawState -> (a, DrawState, Builder)
runDrawing Draw a
drawing DrawEnvironment
environment DrawState
drawState 
    = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        STRef s DrawState
dRef <- forall a s. a -> ST s (STRef s a)
newSTRef DrawState
drawState
        STRef s Builder
bRef <- forall a s. a -> ST s (STRef s a)
newSTRef forall a. Monoid a => a
mempty
        STRef s Point
posRef <- forall a s. a -> ST s (STRef s a)
newSTRef Point
0
        let tuple :: DrawTuple s
tuple = 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 <- forall a. Draw a -> forall s. DrawTuple s -> ST s a
unDraw Draw a
drawing DrawTuple s
tuple
        DrawState
drawSt <- forall s a. STRef s a -> ST s a
readSTRef (forall s. DrawTuple s -> STRef s DrawState
drawStateRef DrawTuple s
tuple)
        Builder
builder <- forall s a. STRef s a -> ST s a
readSTRef (forall s. DrawTuple s -> STRef s Builder
builderRef DrawTuple s
tuple)
        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
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {matrix :: [Matrix]
matrix = Matrix
m forall a. a -> [a] -> [a]
: DrawState -> [Matrix]
matrix DrawState
s}
    
popMatrixStack :: Draw ()
popMatrixStack :: Draw ()
popMatrixStack = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {matrix :: [Matrix]
matrix = forall a. [a] -> [a]
tail (DrawState -> [Matrix]
matrix DrawState
s)}
    

multiplyCurrentMatrixWith :: Matrix -> Draw ()
multiplyCurrentMatrixWith :: Matrix -> Draw ()
multiplyCurrentMatrixWith Matrix
m' = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict 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' forall a. Num a => a -> a -> a
* Matrix
m )forall a. a -> [a] -> [a]
:[Matrix]
l}

    
currentMatrix :: Draw Matrix
currentMatrix :: Draw Matrix
currentMatrix = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> [Matrix]
matrix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> 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 :: forall a. Draw a -> Draw a
withNewContext Draw a
m = do
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ String
"\nq"
    Matrix -> Draw ()
pushMatrixStack Matrix
identity
    a
a <- Draw a
m
    Draw ()
popMatrixStack
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ String
"\nQ"
    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 :: forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
dict a
values Map a String
oldCache = do
    case 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
             forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict 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) (forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc a
values) (DrawState -> PDFResource
rsrc DrawState
s)}
             forall (m :: * -> *) a. Monad m => a -> m a
return (String
newName,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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
n,Map a String
oldCache)

instance PDFGlobals Draw where
    bounds :: forall a.
PDFXObject a =>
PDFReference a -> Draw (PDFFloat, PDFFloat)
bounds (PDFReference Int
r) = Int -> Draw (PDFFloat, PDFFloat)
getBoundInDraw Int
r
    
instance PDFGlobals PDF where
    bounds :: forall a.
PDFXObject a =>
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 <- 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) <- forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"XObject" (forall s. Int -> PDFReference s
PDFReference Int
r) Map (PDFReference AnyPdfXForm) String
xobjectMap
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { xobjects :: Map (PDFReference AnyPdfXForm) String
xobjects = Map (PDFReference AnyPdfXForm) String
newMap }
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat  forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                          , forall s a. SerializeValue s a => a -> s
serialize String
newName
                          , forall s a. SerializeValue s a => a -> s
serialize String
" Do"
                          ]
    drawXObject = 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) = 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
_ = forall a. Monoid a => a
noPdfObject
instance PdfLengthInfo PDFXForm where

instance PdfResourceObject (PDFReference PDFXForm) where
    toRsrc :: PDFReference PDFXForm -> AnyPdfObject
toRsrc = forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject
    
instance PdfResourceObject (PDFReference AnyPdfXForm) where
    toRsrc :: PDFReference AnyPdfXForm -> AnyPdfObject
toRsrc = 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawEnvironment -> IntMap (PDFFloat, PDFFloat)
xobjectBoundD
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> IntMap (PDFFloat, PDFFloat)
xobjectBound
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
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
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
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
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 {forall a. PDF a -> State PdfState a
unPDF :: State PdfState a}
#ifndef __HADDOCK__
  deriving (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
<$ :: forall a b. a -> PDF b -> PDF a
$c<$ :: forall a b. a -> PDF b -> PDF a
fmap :: forall a b. (a -> b) -> PDF a -> PDF b
$cfmap :: forall a b. (a -> b) -> PDF a -> PDF b
Functor, Functor PDF
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
<* :: forall a b. PDF a -> PDF b -> PDF a
$c<* :: forall a b. PDF a -> PDF b -> PDF a
*> :: forall a b. PDF a -> PDF b -> PDF b
$c*> :: forall a b. PDF a -> PDF b -> PDF b
liftA2 :: forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c
$cliftA2 :: forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c
<*> :: forall a b. PDF (a -> b) -> PDF a -> PDF b
$c<*> :: forall a b. PDF (a -> b) -> PDF a -> PDF b
pure :: forall a. a -> PDF a
$cpure :: forall a. a -> PDF a
Applicative, Applicative PDF
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 :: forall a. a -> PDF a
$creturn :: forall a. a -> PDF a
>> :: forall a b. PDF a -> PDF b -> PDF b
$c>> :: forall a b. PDF a -> PDF b -> PDF b
>>= :: forall a b. PDF a -> (a -> PDF b) -> PDF b
$c>>= :: forall a b. PDF a -> (a -> PDF b) -> PDF b
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
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
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
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
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
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) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [
    (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Outlines")
  , (String -> PDFName
PDFName String
"First",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
first)
  , (String -> PDFName
PDFName String
"Last",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
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
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
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 { forall a. OutlineCtx a -> a
value :: a
                                , forall a. OutlineCtx a -> OutlineCtx a
parent :: OutlineCtx a 
                                , forall a. OutlineCtx a -> [Tree a]
lefts :: [Tree a]
                                , forall 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 ) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
   [ (String -> PDFName
PDFName String
"HideToolbar",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
ht)
   , (String -> PDFName
PDFName String
"HideMenubar",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
hm)
   , (String -> PDFName
PDFName String
"HideWindowUI",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
hwui)
   , (String -> PDFName
PDFName String
"FitWindow",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
fw)
   , (String -> PDFName
PDFName String
"CenterWindow",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
cw)
   , (String -> PDFName
PDFName String
"DisplayDocTitle",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
ddt)
   , (String -> PDFName
PDFName String
"NonFullScreenPageMode",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show 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) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
   [ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Trans"))
   , (String -> PDFName
PDFName String
"S",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (forall a. Show a => a -> String
show PDFTransStyle
t)))
   , (String -> PDFName
PDFName String
"D",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
d)
   ] forall a. [a] -> [a] -> [a]
++ PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalDm PDFTransStyle
t forall a. [a] -> [a] -> [a]
++ PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalM PDFTransStyle
t 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",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (forall a. Show a => a -> String
show PDFTransDimension
a)))]
    optionalDm (Blinds PDFTransDimension
a) = [ (String -> PDFName
PDFName String
"Dm",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (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",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (forall a. Show a => a -> String
show PDFTransDirection
a)))]
    optionalM (Box PDFTransDirection
a) = [ (String -> PDFName
PDFName String
"M",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName (forall a. Show a => a -> String
show PDFTransDirection
a)))]
    optionalM PDFTransStyle
_ = []    
    optionalDi :: PDFTransStyle -> [(PDFName, AnyPdfObject)]
optionalDi (Wipe PDFTransDirection2
a) = [ (String -> PDFName
PDFName String
"Di",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFTransDirection2 -> PDFFloat
floatDirection PDFTransDirection2
a))]
    optionalDi (Glitter PDFTransDirection2
a)  = [ (String -> PDFName
PDFName String
"Di",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) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
  [ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Pages"))
  , (String -> PDFName
PDFName String
"Kids",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l)
  , (String -> PDFName
PDFName String
"Count",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
c)
  ] 
 toPDF (PDFPages Int
c (Just PDFReference PDFPages
theParent) [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
  [ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Pages"))
  , (String -> PDFName
PDFName String
"Parent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPages
theParent)
  , (String -> PDFName
PDFName String
"Kids",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l)
  , (String -> PDFName
PDFName String
"Count",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger 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) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
  [ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Page"))
  , (String -> PDFName
PDFName String
"Parent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPages
theParent)
  , (String -> PDFName
PDFName String
"MediaBox",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFRect
box)
  , (String -> PDFName
PDFName String
"Contents",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFStream
content)
  , if forall a. Maybe a -> Bool
isJust Maybe (PDFReference PDFResource)
theRsrc 
      then
       (String -> PDFName
PDFName String
"Resources",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe (PDFReference PDFResource)
theRsrc) 
      else 
       (String -> PDFName
PDFName String
"Resources",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFDictionary
emptyDictionary)
  ] forall a. [a] -> [a] -> [a]
++ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFFloat
x -> [(String -> PDFName
PDFName String
"Dur",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
x)]) Maybe PDFFloat
d)
  forall a. [a] -> [a] -> [a]
++ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFTransition
x -> [(String -> PDFName
PDFName String
"Trans",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFTransition
x)]) Maybe PDFTransition
t)
  forall a. [a] -> [a] -> [a]
++ ((\[AnyPdfObject]
x -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnyPdfObject]
x then [] else [(String -> PDFName
PDFName String
"Annots",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]
_) = 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) = forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
   [ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"Catalog"))
   , (String -> PDFName
PDFName String
"Pages",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPages
lPages)
   , (String -> PDFName
PDFName String
"PageMode", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PDFDocumentPageMode
pgMode)
   , (String -> PDFName
PDFName String
"PageLayout", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PDFDocumentPageLayout
pgLayout)
   , (String -> PDFName
PDFName String
"ViewerPreferences", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFViewerPreferences
viewerPrefs)
   ] forall a. [a] -> [a] -> [a]
++ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutline
x -> [(String -> PDFName
PDFName String
"Outlines",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 = forall a. PdfObject a => a -> Builder
toPDF (Int -> PDFInteger
PDFInteger Int
0)
   toPDF OutlineStyle
ItalicOutline = forall a. PdfObject a => a -> Builder
toPDF (Int -> PDFInteger
PDFInteger Int
1)
   toPDF OutlineStyle
BoldOutline = 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) = 
     forall a. PdfObject a => a -> Builder
toPDF forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [
        (String -> PDFName
PDFName String
"Title",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFString
title)
        , (String -> PDFName
PDFName String
"Parent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
theParent)
        ]
      forall a. [a] -> [a] -> [a]
++
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"Prev",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
prev
      forall a. [a] -> [a] -> [a]
++
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"Next",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
next
      forall a. [a] -> [a] -> [a]
++
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"First",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
first
      forall a. [a] -> [a] -> [a]
++
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PDFReference PDFOutlineEntry
x -> [(String -> PDFName
PDFName String
"Last",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFOutlineEntry
x)]) Maybe (PDFReference PDFOutlineEntry)
theLast
      forall a. [a] -> [a] -> [a]
++
      [ (String -> PDFName
PDFName String
"Count",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (Int -> PDFInteger
PDFInteger Int
count))
      , (String -> PDFName
PDFName String
"Dest",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Destination
dest)
      , (String -> PDFName
PDFName String
"C",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Color
color)
      , (String -> PDFName
PDFName String
"F",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) = forall a. PdfObject a => a -> Builder
toPDF                [ forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPage
r
                                               , forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName 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) = forall a. PdfObject a => a -> Builder
toPDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject 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 forall a. PdfObject a => a -> Builder
toPDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
floor (PDFFloat
h forall a. Fractional a => a -> a -> a
/ PDFFloat
60) forall a. Integral a => a -> a -> a
`mod` Int
6 :: Int) :: Double
      f :: PDFFloat
f = PDFFloat
hforall a. Fractional a => a -> a -> a
/PDFFloat
60 forall a. Num a => a -> a -> a
- PDFFloat
hi
      p :: PDFFloat
p = PDFFloat
v forall a. Num a => a -> a -> a
* (PDFFloat
1forall a. Num a => a -> a -> a
-PDFFloat
s)
      q :: PDFFloat
q = PDFFloat
v forall a. Num a => a -> a -> a
* (PDFFloat
1 forall a. Num a => a -> a -> a
- PDFFloat
fforall a. Num a => a -> a -> a
*PDFFloat
s)
      t :: PDFFloat
t = PDFFloat
v forall a. Num a => a -> a -> a
* (PDFFloat
1 forall a. Num a => a -> a -> a
- (PDFFloat
1forall a. Num a => a -> a -> a
-PDFFloat
f)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
_ -> 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 = forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ 
                            [ (String -> PDFName
PDFName String
"FunctionType", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
2)
                            , (String -> PDFName
PDFName String
"Domain", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ ([PDFFloat
0,PDFFloat
1] :: [PDFFloat]))
                            , (String -> PDFName
PDFName String
"C0", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [PDFFloat
x])
                            , (String -> PDFName
PDFName String
"C1", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [PDFFloat
y])
                            , (String -> PDFName
PDFName String
"N", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger 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
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
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
Ord)

instance PdfResourceObject PDFShading where
      toRsrc :: PDFShading -> AnyPdfObject
toRsrc (AxialShading PDFFloat
x0 PDFFloat
y0 PDFFloat
x1 PDFFloat
y1 Color
ca Color
cb) = forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
                                 [ (String -> PDFName
PDFName String
"ShadingType",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
2)
                                 , (String -> PDFName
PDFName String
"Coords",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [PDFFloat
x0,PDFFloat
y0,PDFFloat
x1,PDFFloat
y1])
                                 , (String -> PDFName
PDFName String
"ColorSpace",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"DeviceRGB")
                                 , (String -> PDFName
PDFName String
"Function",forall a. (PdfObject a, PdfLengthInfo a) => a -> 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) = forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
                                         [ (String -> PDFName
PDFName String
"ShadingType",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
3)
                                         , (String -> PDFName
PDFName String
"Coords",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
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",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"DeviceRGB")
                                         , (String -> PDFName
PDFName String
"Function",forall a. (PdfObject a, PdfLengthInfo a) => a -> 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
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize Char
'\n'
                     , forall a. PdfObject a => a -> Builder
toPDF PDFFloat
a
                     , forall s a. SerializeValue s a => a -> s
serialize Char
' '
                     , forall a. PdfObject a => a -> Builder
toPDF PDFFloat
b
                     , forall s a. SerializeValue s a => a -> s
serialize Char
' '
                     , forall a. PdfObject a => a -> Builder
toPDF PDFFloat
c
                     , forall s a. SerializeValue s a => a -> s
serialize Char
' '
                     , forall a. PdfObject a => a -> Builder
toPDF PDFFloat
d
                     , forall s a. SerializeValue s a => a -> s
serialize Char
' '
                     , forall a. PdfObject a => a -> Builder
toPDF PDFFloat
e
                     , forall s a. SerializeValue s a => a -> s
serialize Char
' '
                     , forall a. PdfObject a => a -> Builder
toPDF PDFFloat
f
                     , forall s a. SerializeValue s a => a -> s
serialize String
" cm"
                     ]