{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
---------------------------------------------------------
-- |
-- 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
 , registerResource
 , 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(..)
 , ColorSpace(..)
 , colorSpaceName
 , calculator1
 , calculator2
 , ColorFunction1(..)
 , ColorFunction2(..)
 , Function1(..)
 , Function2(..)
 , Global
 , Local
 , linearStitched
 , FunctionObject(FunctionObject, FunctionStream)
 , rsrcFromCalculator
 , rsrcFromInterpolated
 , rsrcFromSampled
 , rsrcFromStitched
 , ColorTuple
 , domain1Dict
 , domain2Dict
 , SoftMask(..)
 , getRgbColor
 , emptyDrawState
 , Matrix(..)
 , identity
 , applyMatrix
 , currentMatrix
 , multiplyCurrentMatrixWith
 , PDFGlobals(..)
 ) where

#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 qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.Array as Array
import Data.Array (Array)

import Control.Monad.ST
import Data.STRef

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

import qualified Graphics.PDF.Expression as Expr
import Graphics.PDF.Expression (PDFExpression)
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(..))

import Text.Printf (printf)

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 a. 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 a. a -> PDF a
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
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: 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
$ccompare :: Color -> Color -> Ordering
compare :: Color -> Color -> Ordering
$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
>= :: Color -> Color -> Bool
$cmax :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
min :: Color -> Color -> 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 -> Map SoftMask String
softMasks :: M.Map SoftMask 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 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 {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 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 a. a -> ST s a
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 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) -> forall s. 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 -> forall s. 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 a. a -> ST s a
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 >>= :: forall a b. 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 -> forall s. 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 -> forall s. 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 :: forall a. 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 a. 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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DrawTuple s -> DrawEnvironment
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 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 = drawenv' }
                               in Draw a -> forall s. 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 :: forall a. 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 -> forall s. 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 a. a -> ST s a
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 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)
-> forall s. 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 a. a -> ST s a
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; b -> Draw b
forall a. a -> Draw a
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 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 a. (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 a.
(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
        !(Either (PDFReference MaybeLength) PDFLength)
        !PDFDictionary

instance PdfObject PDFStream where
  toPDF :: PDFStream -> Builder
toPDF (PDFStream Builder
s Bool
c Either (PDFReference MaybeLength) PDFLength
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, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Filter" [String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"FlateDecode"]] else []
      lenDict :: PDFDictionary
lenDict = [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [(PDFReference MaybeLength -> (PDFName, AnyPdfObject))
-> (PDFLength -> (PDFName, AnyPdfObject))
-> Either (PDFReference MaybeLength) PDFLength
-> (PDFName, AnyPdfObject)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> PDFReference MaybeLength -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Length") (String -> PDFLength -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Length") Either (PDFReference MaybeLength) PDFLength
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 (PDFLength, PDFReference MaybeLength)
pdfLengthInfo (PDFStream Builder
s Bool
_ Either (PDFReference MaybeLength) PDFLength
el PDFDictionary
_) =
      (PDFReference MaybeLength
 -> Maybe (PDFLength, PDFReference MaybeLength))
-> (PDFLength -> Maybe (PDFLength, PDFReference MaybeLength))
-> Either (PDFReference MaybeLength) PDFLength
-> Maybe (PDFLength, PDFReference MaybeLength)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (\PDFReference MaybeLength
ref -> (PDFLength, PDFReference MaybeLength)
-> Maybe (PDFLength, PDFReference MaybeLength)
forall a. a -> Maybe a
Just (Int64 -> PDFLength
PDFLength (Int64 -> PDFLength) -> (Builder -> Int64) -> Builder -> PDFLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> PDFLength) -> Builder -> PDFLength
forall a b. (a -> b) -> a -> b
$ Builder
s, PDFReference MaybeLength
ref))
        (Maybe (PDFLength, PDFReference MaybeLength)
-> PDFLength -> Maybe (PDFLength, PDFReference MaybeLength)
forall a b. a -> b -> a
const Maybe (PDFLength, PDFReference MaybeLength)
forall a. Maybe a
Nothing)
        Either (PDFReference MaybeLength) PDFLength
el

-- | An empty drawing
emptyDrawing :: Draw ()
emptyDrawing :: Draw ()
emptyDrawing = () -> Draw ()
forall a. a -> Draw a
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 = tail xs}
    String -> Draw String
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall a. HasCallStack => [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 a b. [a] -> (a -> [b]) -> [b]
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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
-> Map SoftMask 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 Map SoftMask 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 :: forall a.
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 { 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 -> forall s. 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 a. a -> ST s a
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 = m : matrix 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 = tail (matrix 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 = let (m:l) = matrix s in (m' * m ):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 a b. Draw a -> (a -> Draw b) -> Draw b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Matrix -> Draw Matrix
forall a. a -> Draw a
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. HasCallStack => [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
    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 a. 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 :: 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 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 = addResource (PDFName dict) (PDFName newName) (toRsrc values) (rsrc s)}
             (String, Map a String) -> Draw (String, Map a String)
forall a. a -> Draw a
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 a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n,Map a String
oldCache)

-- ToDo: setter and getter could be replaced by an Accessor or a Lens
registerResource ::
    (Ord a, PdfResourceObject a) =>
    String ->
    (DrawState -> M.Map a String) ->
    (M.Map a String -> DrawState -> DrawState) ->
    a -> Draw String
registerResource :: forall a.
(Ord a, PdfResourceObject a) =>
String
-> (DrawState -> Map a String)
-> (Map a String -> DrawState -> DrawState)
-> a
-> Draw String
registerResource String
dict DrawState -> Map a String
getMap Map a String -> DrawState -> DrawState
setMap a
resource = do
    Map a String
oldMap <- (DrawState -> Map a String) -> Draw (Map a String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map a String
getMap
    (String
newName,Map a String
newMap) <- String -> a -> Map a String -> Draw (String, Map a String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
dict a
resource Map a String
oldMap
    (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
$ Map a String -> DrawState -> DrawState
setMap Map a String
newMap
    String -> Draw String
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return String
newName


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
        String
newName <-
            String
-> (DrawState -> Map (PDFReference AnyPdfXForm) String)
-> (Map (PDFReference AnyPdfXForm) String
    -> DrawState -> DrawState)
-> PDFReference AnyPdfXForm
-> Draw String
forall a.
(Ord a, PdfResourceObject a) =>
String
-> (DrawState -> Map a String)
-> (Map a String -> DrawState -> DrawState)
-> a
-> Draw String
registerResource String
"XObject"
                DrawState -> Map (PDFReference AnyPdfXForm) String
xobjects (\Map (PDFReference AnyPdfXForm) String
newMap DrawState
s -> DrawState
s { xobjects = newMap })
                (Int -> PDFReference AnyPdfXForm
forall s. Int -> PDFReference s
PDFReference Int
r)
        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 a. a -> Draw a
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 a. a -> PDF a
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
$c== :: PDFTransition -> PDFTransition -> Bool
== :: PDFTransition -> PDFTransition -> Bool
$c/= :: PDFTransition -> PDFTransition -> Bool
/= :: 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
$c== :: PDFTransDimension -> PDFTransDimension -> Bool
== :: PDFTransDimension -> PDFTransDimension -> Bool
$c/= :: PDFTransDimension -> PDFTransDimension -> Bool
/= :: 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
$c== :: PDFTransDirection -> PDFTransDirection -> Bool
== :: PDFTransDirection -> PDFTransDirection -> Bool
$c/= :: PDFTransDirection -> PDFTransDirection -> Bool
/= :: 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
$c== :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
== :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
$c/= :: PDFTransDirection2 -> PDFTransDirection2 -> Bool
/= :: 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 -> 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
$cfmap :: forall a b. (a -> b) -> PDF a -> PDF b
fmap :: forall a b. (a -> b) -> PDF a -> PDF b
$c<$ :: forall a b. a -> PDF b -> PDF a
<$ :: forall a b. a -> PDF b -> PDF a
Functor, Functor PDF
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
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
$cpure :: forall a. a -> PDF a
pure :: forall a. a -> PDF a
$c<*> :: forall a b. PDF (a -> b) -> PDF a -> PDF b
<*> :: forall a b. PDF (a -> b) -> PDF a -> PDF b
$cliftA2 :: forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c
liftA2 :: forall a b c. (a -> b -> c) -> PDF a -> PDF b -> PDF c
$c*> :: forall a b. PDF a -> PDF b -> PDF b
*> :: forall a b. PDF a -> PDF b -> PDF b
$c<* :: forall a b. PDF a -> PDF b -> PDF a
<* :: forall a b. PDF a -> PDF b -> PDF a
Applicative, Applicative PDF
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
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
$c>>= :: forall a b. PDF a -> (a -> PDF b) -> PDF b
>>= :: forall a b. PDF a -> (a -> PDF b) -> PDF b
$c>> :: forall a b. PDF a -> PDF b -> PDF b
>> :: forall a b. PDF a -> PDF b -> PDF b
$creturn :: forall a. a -> PDF a
return :: forall a. a -> PDF a
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
$c== :: PDFTransStyle -> PDFTransStyle -> Bool
== :: PDFTransStyle -> PDFTransStyle -> Bool
$c/= :: PDFTransStyle -> PDFTransStyle -> Bool
/= :: 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
$c== :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
== :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
$c/= :: PDFDocumentPageMode -> PDFDocumentPageMode -> Bool
/= :: 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
$cshowsPrec :: Int -> PDFDocumentPageMode -> String -> String
showsPrec :: Int -> PDFDocumentPageMode -> String -> String
$cshow :: PDFDocumentPageMode -> String
show :: PDFDocumentPageMode -> String
$cshowList :: [PDFDocumentPageMode] -> String -> String
showList :: [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
$c== :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
== :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
$c/= :: PDFDocumentPageLayout -> PDFDocumentPageLayout -> Bool
/= :: 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
$cshowsPrec :: Int -> PDFDocumentPageLayout -> String -> String
showsPrec :: Int -> PDFDocumentPageLayout -> String -> String
$cshow :: PDFDocumentPageLayout -> String
show :: PDFDocumentPageLayout -> String
$cshowList :: [PDFDocumentPageLayout] -> String -> String
showList :: [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
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [
    String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"Outlines")
  , String -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"First" PDFReference PDFOutlineEntry
first
  , String -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Last" 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
$c== :: OutlineStyle -> OutlineStyle -> Bool
== :: OutlineStyle -> OutlineStyle -> Bool
$c/= :: OutlineStyle -> OutlineStyle -> Bool
/= :: 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
$c== :: Destination -> Destination -> Bool
== :: Destination -> Destination -> Bool
$c/= :: Destination -> Destination -> Bool
/= :: 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
$cshowsPrec :: Int -> Destination -> String -> String
showsPrec :: Int -> Destination -> String -> String
$cshow :: Destination -> String
show :: Destination -> String
$cshowList :: [Destination] -> String -> String
showList :: [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 ) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
   [ String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"HideToolbar" Bool
ht
   , String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"HideMenubar" Bool
hm
   , String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"HideWindowUI" Bool
hwui
   , String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FitWindow" Bool
fw
   , String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"CenterWindow" Bool
cw
   , String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"DisplayDocTitle" Bool
ddt
   , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"NonFullScreenPageMode" (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 -> PDFName) -> PDFDocumentPageMode -> PDFName
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
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
   [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Trans")
   , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"S" (String -> PDFName
PDFName (PDFTransStyle -> String
forall a. Show a => a -> String
show PDFTransStyle
t))
   , String -> PDFFloat -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"D" 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, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Dm" (String -> PDFName
PDFName (PDFTransDimension -> String
forall a. Show a => a -> String
show PDFTransDimension
a))]
    optionalDm (Blinds PDFTransDimension
a) = [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Dm" (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, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"M" (String -> PDFName
PDFName (PDFTransDirection -> String
forall a. Show a => a -> String
show PDFTransDirection
a))]
    optionalM (Box PDFTransDirection
a) = [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"M" (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 -> PDFFloat -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Di" (PDFTransDirection2 -> PDFFloat
floatDirection PDFTransDirection2
a)]
    optionalDi (Glitter PDFTransDirection2
a)  = [ String -> PDFFloat -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Di" (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
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
  [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Pages")
  , String
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Kids" [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l
  , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Count" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
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
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
  [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Pages")
  , String -> PDFReference PDFPages -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Parent" PDFReference PDFPages
theParent
  , String
-> [Either (PDFReference PDFPages) (PDFReference PDFPage)]
-> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Kids" [Either (PDFReference PDFPages) (PDFReference PDFPage)]
l
  , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Count" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> 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) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder) -> PDFDictionary -> Builder
forall a b. (a -> b) -> a -> b
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
  [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Page")
  , String -> PDFReference PDFPages -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Parent" PDFReference PDFPages
theParent
  , String -> PDFRect -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"MediaBox" PDFRect
box
  , String -> PDFReference PDFStream -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Contents" PDFReference PDFStream
content
  , case Maybe (PDFReference PDFResource)
theRsrc of
      Just PDFReference PDFResource
res -> String -> PDFReference PDFResource -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Resources" PDFReference PDFResource
res
      Maybe (PDFReference PDFResource)
Nothing -> String -> PDFDictionary -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Resources" 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 -> PDFFloat -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Dur" 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 -> PDFTransition -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Trans" PDFTransition
x]) Maybe PDFTransition
t)
  [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ ((\[AnyPdfObject]
x -> if [AnyPdfObject] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnyPdfObject]
x then [] else [String -> [AnyPdfObject] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Annots" [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
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
   [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Catalog")
   , String -> PDFReference PDFPages -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Pages" PDFReference PDFPages
lPages
   , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"PageMode" (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 -> PDFName) -> PDFDocumentPageMode -> PDFName
forall a b. (a -> b) -> a -> b
$ PDFDocumentPageMode
pgMode)
   , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"PageLayout" (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 -> PDFName)
-> PDFDocumentPageLayout -> PDFName
forall a b. (a -> b) -> a -> b
$ PDFDocumentPageLayout
pgLayout)
   , String -> PDFViewerPreferences -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"ViewerPreferences" 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 -> PDFReference PDFOutline -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Outlines" 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
$ [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ [
        String -> PDFString -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Title" PDFString
title
        , String -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Parent" 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 -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Prev" 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 -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Next" 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 -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"First" 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 -> PDFReference PDFOutlineEntry -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Last" PDFReference PDFOutlineEntry
x]) Maybe (PDFReference PDFOutlineEntry)
theLast
      [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++
      [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Count" (Int -> PDFInteger
PDFInteger Int
count)
      , String -> Destination -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Dest" Destination
dest
      , String -> Color -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"C" Color
color
      , String -> OutlineStyle -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"F" 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) = [PDFFloat] -> Builder
forall a. PdfObject a => a -> Builder
toPDF [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 [PDFFloat] -> Builder
forall a. PdfObject a => a -> Builder
toPDF [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 b. Integral b => PDFFloat -> b
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)  

type FloatRGB  = (PDFFloat, PDFFloat, PDFFloat)
type FloatCMYK = (PDFFloat, PDFFloat, PDFFloat, PDFFloat)

class ColorTuple a where
    rgbHex :: a -> String
    colorComponents :: a -> [PDFFloat]
    colorDimensions :: f a e -> Int

instance ColorTuple PDFFloat where
    rgbHex :: PDFFloat -> String
rgbHex PDFFloat
c = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X" (PDFFloat -> Int
byteFromFloat PDFFloat
c)
    colorComponents :: PDFFloat -> [PDFFloat]
colorComponents PDFFloat
c = [PDFFloat
c]
    colorDimensions :: forall (f :: * -> * -> *) e. f PDFFloat e -> Int
colorDimensions f PDFFloat e
_ = Int
1

instance (a ~ PDFFloat, b ~ PDFFloat, c ~ PDFFloat) => ColorTuple (a,b,c) where
    rgbHex :: (a, b, c) -> String
rgbHex (a
r,b
g,c
b) =
        String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X%02X%02X"
            (PDFFloat -> Int
byteFromFloat a
PDFFloat
r) (PDFFloat -> Int
byteFromFloat b
PDFFloat
g) (PDFFloat -> Int
byteFromFloat c
PDFFloat
b)
    colorComponents :: (a, b, c) -> [PDFFloat]
colorComponents (a
r,b
g,c
b) = [a
PDFFloat
r,b
PDFFloat
g,c
PDFFloat
b]
    colorDimensions :: forall (f :: * -> * -> *) e. f (a, b, c) e -> Int
colorDimensions f (a, b, c) e
_ = Int
3

instance
    (a ~ PDFFloat, b ~ PDFFloat, c ~ PDFFloat, d ~ PDFFloat) =>
        ColorTuple (a,b,c,d) where
    rgbHex :: (a, b, c, d) -> String
rgbHex (a
c,b
m,c
y,d
k) =
        String -> Int -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X%02X%02X%02X"
            (PDFFloat -> Int
byteFromFloat a
PDFFloat
c) (PDFFloat -> Int
byteFromFloat b
PDFFloat
m)
            (PDFFloat -> Int
byteFromFloat c
PDFFloat
y) (PDFFloat -> Int
byteFromFloat d
PDFFloat
k)
    colorComponents :: (a, b, c, d) -> [PDFFloat]
colorComponents (a
c,b
m,c
y,d
k) = [a
PDFFloat
c,b
PDFFloat
m,c
PDFFloat
y,d
PDFFloat
k]
    colorDimensions :: forall (f :: * -> * -> *) e. f (a, b, c, d) e -> Int
colorDimensions f (a, b, c, d) e
_ = Int
4

byteFromFloat :: PDFFloat -> Int
byteFromFloat :: PDFFloat -> Int
byteFromFloat PDFFloat
x = PDFFloat -> Int
forall b. Integral b => PDFFloat -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (PDFFloat -> Int) -> PDFFloat -> Int
forall a b. (a -> b) -> a -> b
$ PDFFloat -> PDFFloat -> PDFFloat
forall a. Ord a => a -> a -> a
min PDFFloat
255 (PDFFloat -> PDFFloat) -> PDFFloat -> PDFFloat
forall a b. (a -> b) -> a -> b
$ PDFFloat -> PDFFloat -> PDFFloat
forall a. Ord a => a -> a -> a
max PDFFloat
0 (PDFFloat -> PDFFloat) -> PDFFloat -> PDFFloat
forall a b. (a -> b) -> a -> b
$ PDFFloat
xPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
255

pdfStreamFromLazyByteString :: C.ByteString -> PDFDictionary -> PDFStream
pdfStreamFromLazyByteString :: ByteString -> PDFDictionary -> PDFStream
pdfStreamFromLazyByteString ByteString
stream PDFDictionary
dict =
    Builder
-> Bool
-> Either (PDFReference MaybeLength) PDFLength
-> PDFDictionary
-> PDFStream
PDFStream
        (ByteString -> Builder
BU.fromLazyByteString ByteString
stream)
        Bool
False
        (PDFLength -> Either (PDFReference MaybeLength) PDFLength
forall a b. b -> Either a b
Right (PDFLength -> Either (PDFReference MaybeLength) PDFLength)
-> (ByteString -> PDFLength)
-> ByteString
-> Either (PDFReference MaybeLength) PDFLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> PDFLength
PDFLength (Int64 -> PDFLength)
-> (ByteString -> Int64) -> ByteString -> PDFLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
B.length (ByteString -> Either (PDFReference MaybeLength) PDFLength)
-> ByteString -> Either (PDFReference MaybeLength) PDFLength
forall a b. (a -> b) -> a -> b
$ ByteString
stream)
        PDFDictionary
dict

data FunctionObject a e =
      FunctionObject (PDFReference PDFDictionary)
    | FunctionStream (PDFReference PDFStream)
    deriving (FunctionObject a e -> FunctionObject a e -> Bool
(FunctionObject a e -> FunctionObject a e -> Bool)
-> (FunctionObject a e -> FunctionObject a e -> Bool)
-> Eq (FunctionObject a e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a e. FunctionObject a e -> FunctionObject a e -> Bool
$c== :: forall a e. FunctionObject a e -> FunctionObject a e -> Bool
== :: FunctionObject a e -> FunctionObject a e -> Bool
$c/= :: forall a e. FunctionObject a e -> FunctionObject a e -> Bool
/= :: FunctionObject a e -> FunctionObject a e -> Bool
Eq, Eq (FunctionObject a e)
Eq (FunctionObject a e) =>
(FunctionObject a e -> FunctionObject a e -> Ordering)
-> (FunctionObject a e -> FunctionObject a e -> Bool)
-> (FunctionObject a e -> FunctionObject a e -> Bool)
-> (FunctionObject a e -> FunctionObject a e -> Bool)
-> (FunctionObject a e -> FunctionObject a e -> Bool)
-> (FunctionObject a e -> FunctionObject a e -> FunctionObject a e)
-> (FunctionObject a e -> FunctionObject a e -> FunctionObject a e)
-> Ord (FunctionObject a e)
FunctionObject a e -> FunctionObject a e -> Bool
FunctionObject a e -> FunctionObject a e -> Ordering
FunctionObject a e -> FunctionObject a e -> FunctionObject a e
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
forall a e. Eq (FunctionObject a e)
forall a e. FunctionObject a e -> FunctionObject a e -> Bool
forall a e. FunctionObject a e -> FunctionObject a e -> Ordering
forall a e.
FunctionObject a e -> FunctionObject a e -> FunctionObject a e
$ccompare :: forall a e. FunctionObject a e -> FunctionObject a e -> Ordering
compare :: FunctionObject a e -> FunctionObject a e -> Ordering
$c< :: forall a e. FunctionObject a e -> FunctionObject a e -> Bool
< :: FunctionObject a e -> FunctionObject a e -> Bool
$c<= :: forall a e. FunctionObject a e -> FunctionObject a e -> Bool
<= :: FunctionObject a e -> FunctionObject a e -> Bool
$c> :: forall a e. FunctionObject a e -> FunctionObject a e -> Bool
> :: FunctionObject a e -> FunctionObject a e -> Bool
$c>= :: forall a e. FunctionObject a e -> FunctionObject a e -> Bool
>= :: FunctionObject a e -> FunctionObject a e -> Bool
$cmax :: forall a e.
FunctionObject a e -> FunctionObject a e -> FunctionObject a e
max :: FunctionObject a e -> FunctionObject a e -> FunctionObject a e
$cmin :: forall a e.
FunctionObject a e -> FunctionObject a e -> FunctionObject a e
min :: FunctionObject a e -> FunctionObject a e -> FunctionObject a e
Ord)

rsrcFromSampled ::
    (ColorTuple a) =>
    PDFDictionary ->
    ((i, i) -> [Int]) -> Array i a -> PDFStream
rsrcFromSampled :: forall a i.
ColorTuple a =>
PDFDictionary -> ((i, i) -> [Int]) -> Array i a -> PDFStream
rsrcFromSampled PDFDictionary
domain (i, i) -> [Int]
computeSizes Array i a
arr =
    ByteString -> PDFDictionary -> PDFStream
pdfStreamFromLazyByteString
        ((String -> ByteString
C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> String
forall a. ColorTuple a => a -> String
rgbHex ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ Array i a -> [a]
forall i e. Array i e -> [e]
Array.elems Array i a
arr)
            ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
            String -> ByteString
C.pack String
" >")
        (PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion PDFDictionary
domain (PDFDictionary -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
           [String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FunctionType" (Int -> PDFInteger
PDFInteger Int
0),
            String -> [Int] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Size" ((i, i) -> [Int]
computeSizes ((i, i) -> [Int]) -> (i, i) -> [Int]
forall a b. (a -> b) -> a -> b
$ Array i a -> (i, i)
forall i e. Array i e -> (i, i)
Array.bounds Array i a
arr),
            String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"BitsPerSample" (Int -> PDFInteger
PDFInteger Int
8),
            String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Filter" (String -> PDFName
PDFName String
"ASCIIHexDecode")
            ])

-- | Interpolation function
rsrcFromInterpolated ::
    (ColorTuple a) =>
    PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
rsrcFromInterpolated :: forall a.
ColorTuple a =>
PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
rsrcFromInterpolated PDFDictionary
domain PDFFloat
n a
a a
b =
    PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion PDFDictionary
domain (PDFDictionary -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
                            [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FunctionType" (Int -> PDFInteger
PDFInteger Int
2)
                            , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"C0" (a -> [PDFFloat]
forall a. ColorTuple a => a -> [PDFFloat]
colorComponents a
a)
                            , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"C1" (a -> [PDFFloat]
forall a. ColorTuple a => a -> [PDFFloat]
colorComponents a
b)
                            , String -> PDFFloat -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"N" PDFFloat
n
                            ]

rsrcFromStitched ::
    (ColorTuple a, Expr.Result e) =>
    PDFDictionary ->
    Function1 Local a e -> [(PDFFloat, Function1 Local a e)] -> PDFDictionary
rsrcFromStitched :: forall a e.
(ColorTuple a, Result e) =>
PDFDictionary
-> Function1 Local a e
-> [(PDFFloat, Function1 Local a e)]
-> PDFDictionary
rsrcFromStitched PDFDictionary
domain Function1 Local a e
part [(PDFFloat, Function1 Local a e)]
parts =
    let funcs :: [Function1 Local a e]
funcs = Function1 Local a e
part Function1 Local a e
-> [Function1 Local a e] -> [Function1 Local a e]
forall a. a -> [a] -> [a]
: ((PDFFloat, Function1 Local a e) -> Function1 Local a e)
-> [(PDFFloat, Function1 Local a e)] -> [Function1 Local a e]
forall a b. (a -> b) -> [a] -> [b]
map (PDFFloat, Function1 Local a e) -> Function1 Local a e
forall a b. (a, b) -> b
snd [(PDFFloat, Function1 Local a e)]
parts in
    PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion PDFDictionary
domain (PDFDictionary -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
        [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FunctionType" (Int -> PDFInteger
PDFInteger Int
3)
        , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Bounds" (((PDFFloat, Function1 Local a e) -> PDFFloat)
-> [(PDFFloat, Function1 Local a e)] -> [PDFFloat]
forall a b. (a -> b) -> [a] -> [b]
map (PDFFloat, Function1 Local a e) -> PDFFloat
forall a b. (a, b) -> a
fst [(PDFFloat, Function1 Local a e)]
parts)
        , String -> [Int] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Encode" ((Function1 Local a e -> [Int]) -> [Function1 Local a e] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int] -> Function1 Local a e -> [Int]
forall a b. a -> b -> a
const [Int
0,Int
1::Int]) [Function1 Local a e]
funcs)
        , String -> [AnyPdfObject] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Functions" ((Function1 Local a e -> AnyPdfObject)
-> [Function1 Local a e] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map Function1 Local a e -> AnyPdfObject
forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc [Function1 Local a e]
funcs)
        ]

rsrcFromCalculator ::
    (Expr.Function f) => PDFDictionary -> f -> PDFStream
rsrcFromCalculator :: forall f. Function f => PDFDictionary -> f -> PDFStream
rsrcFromCalculator PDFDictionary
domain f
f =
    ByteString -> PDFDictionary -> PDFStream
pdfStreamFromLazyByteString
        (Char -> ByteString -> ByteString
C.cons Char
'{' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Char -> ByteString
C.snoc (f -> ByteString
forall f. Function f => f -> ByteString
Expr.serialize f
f) Char
'}')
        (PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion PDFDictionary
domain (PDFDictionary -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
            [String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FunctionType" (Int -> PDFInteger
PDFInteger Int
4)])


type ExprFloat = PDFExpression PDFFloat
type ExprRGB = (ExprFloat, ExprFloat, ExprFloat)
type ExprCMYK = (ExprFloat, ExprFloat, ExprFloat, ExprFloat)


data ColorSpace a e where
    GraySpace :: ColorSpace PDFFloat ExprFloat
    RGBSpace :: ColorSpace FloatRGB ExprRGB
    CMYKSpace :: ColorSpace FloatCMYK ExprCMYK

deriving instance Eq (ColorSpace a e)
deriving instance Ord (ColorSpace a e)

colorSpaceName :: ColorSpace a e -> PDFName
colorSpaceName :: forall a e. ColorSpace a e -> PDFName
colorSpaceName ColorSpace a e
space =
    case ColorSpace a e
space of
        ColorSpace a e
GraySpace -> String -> PDFName
PDFName String
"DeviceGray"
        ColorSpace a e
RGBSpace -> String -> PDFName
PDFName String
"DeviceRGB"
        ColorSpace a e
CMYKSpace -> String -> PDFName
PDFName String
"DeviceCMYK"

colorSpaceEntry :: ColorSpace a e -> (PDFName, AnyPdfObject)
colorSpaceEntry :: forall a e. ColorSpace a e -> (PDFName, AnyPdfObject)
colorSpaceEntry ColorSpace a e
space = String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"ColorSpace" (PDFName -> (PDFName, AnyPdfObject))
-> PDFName -> (PDFName, AnyPdfObject)
forall a b. (a -> b) -> a -> b
$ ColorSpace a e -> PDFName
forall a e. ColorSpace a e -> PDFName
colorSpaceName ColorSpace a e
space

rangeEntry :: (ColorTuple a) => f a e -> (PDFName, AnyPdfObject)
rangeEntry :: forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> (PDFName, AnyPdfObject)
rangeEntry f a e
func =
    String -> [Int] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Range" ([Int] -> (PDFName, AnyPdfObject))
-> [Int] -> (PDFName, AnyPdfObject)
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [[Int]]
forall a. Int -> a -> [a]
replicate (f a e -> Int
forall a (f :: * -> * -> *) e. ColorTuple a => f a e -> Int
forall (f :: * -> * -> *) e. f a e -> Int
colorDimensions f a e
func) [Int
0,Int
1::Int]


data ColorFunction1 =
    forall a e.
    (ColorTuple a, Expr.Result e) =>
    ColorFunction1 (ColorSpace a e) (Function1 Local a e)

instance Eq ColorFunction1 where
    ColorFunction1 ColorSpace a e
spaceA Function1 Local a e
funcA == :: ColorFunction1 -> ColorFunction1 -> Bool
== ColorFunction1 ColorSpace a e
spaceB Function1 Local a e
funcB  =
        case (ColorSpace a e
spaceA, ColorSpace a e
spaceB) of
            (ColorSpace a e
GraySpace, ColorSpace a e
GraySpace) -> Function1 Local a e
funcA Function1 Local a e -> Function1 Local a e -> Bool
forall a. Eq a => a -> a -> Bool
== Function1 Local a e
Function1 Local a e
funcB
            (ColorSpace a e
RGBSpace, ColorSpace a e
RGBSpace) -> Function1 Local a e
funcA Function1 Local a e -> Function1 Local a e -> Bool
forall a. Eq a => a -> a -> Bool
== Function1 Local a e
Function1 Local a e
funcB
            (ColorSpace a e
CMYKSpace, ColorSpace a e
CMYKSpace) -> Function1 Local a e
funcA Function1 Local a e -> Function1 Local a e -> Bool
forall a. Eq a => a -> a -> Bool
== Function1 Local a e
Function1 Local a e
funcB
            (ColorSpace a e, ColorSpace a e)
_ -> Bool
False

instance Ord ColorFunction1 where
    compare :: ColorFunction1 -> ColorFunction1 -> Ordering
compare (ColorFunction1 ColorSpace a e
spaceA Function1 Local a e
funcA) (ColorFunction1 ColorSpace a e
spaceB Function1 Local a e
funcB) =
        case (ColorSpace a e
spaceA, ColorSpace a e
spaceB) of
            (ColorSpace a e
GraySpace, ColorSpace a e
GraySpace) -> Function1 Local a e -> Function1 Local a e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Function1 Local a e
funcA Function1 Local a e
Function1 Local a e
funcB
            (ColorSpace a e
RGBSpace, ColorSpace a e
RGBSpace) -> Function1 Local a e -> Function1 Local a e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Function1 Local a e
funcA Function1 Local a e
Function1 Local a e
funcB
            (ColorSpace a e
CMYKSpace, ColorSpace a e
CMYKSpace) -> Function1 Local a e -> Function1 Local a e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Function1 Local a e
funcA Function1 Local a e
Function1 Local a e
funcB
            (ColorSpace a e
GraySpace, ColorSpace a e
_) -> Ordering
LT; (ColorSpace a e
_, ColorSpace a e
GraySpace) -> Ordering
GT
            (ColorSpace a e
RGBSpace,  ColorSpace a e
_) -> Ordering
LT; (ColorSpace a e
_, ColorSpace a e
RGBSpace)  -> Ordering
GT


data ColorFunction2 =
    forall a e.
    (ColorTuple a, Expr.Result e) =>
    ColorFunction2 (ColorSpace a e) (Function2 Local a e)

instance Eq ColorFunction2 where
    ColorFunction2 ColorSpace a e
spaceA Function2 Local a e
funcA == :: ColorFunction2 -> ColorFunction2 -> Bool
== ColorFunction2 ColorSpace a e
spaceB Function2 Local a e
funcB  =
        case (ColorSpace a e
spaceA, ColorSpace a e
spaceB) of
            (ColorSpace a e
GraySpace, ColorSpace a e
GraySpace) -> Function2 Local a e
funcA Function2 Local a e -> Function2 Local a e -> Bool
forall a. Eq a => a -> a -> Bool
== Function2 Local a e
Function2 Local a e
funcB
            (ColorSpace a e
RGBSpace, ColorSpace a e
RGBSpace) -> Function2 Local a e
funcA Function2 Local a e -> Function2 Local a e -> Bool
forall a. Eq a => a -> a -> Bool
== Function2 Local a e
Function2 Local a e
funcB
            (ColorSpace a e
CMYKSpace, ColorSpace a e
CMYKSpace) -> Function2 Local a e
funcA Function2 Local a e -> Function2 Local a e -> Bool
forall a. Eq a => a -> a -> Bool
== Function2 Local a e
Function2 Local a e
funcB
            (ColorSpace a e, ColorSpace a e)
_ -> Bool
False

instance Ord ColorFunction2 where
    compare :: ColorFunction2 -> ColorFunction2 -> Ordering
compare (ColorFunction2 ColorSpace a e
spaceA Function2 Local a e
funcA) (ColorFunction2 ColorSpace a e
spaceB Function2 Local a e
funcB) =
        case (ColorSpace a e
spaceA, ColorSpace a e
spaceB) of
            (ColorSpace a e
GraySpace, ColorSpace a e
GraySpace) -> Function2 Local a e -> Function2 Local a e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Function2 Local a e
funcA Function2 Local a e
Function2 Local a e
funcB
            (ColorSpace a e
RGBSpace, ColorSpace a e
RGBSpace) -> Function2 Local a e -> Function2 Local a e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Function2 Local a e
funcA Function2 Local a e
Function2 Local a e
funcB
            (ColorSpace a e
CMYKSpace, ColorSpace a e
CMYKSpace) -> Function2 Local a e -> Function2 Local a e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Function2 Local a e
funcA Function2 Local a e
Function2 Local a e
funcB
            (ColorSpace a e
GraySpace, ColorSpace a e
_) -> Ordering
LT; (ColorSpace a e
_, ColorSpace a e
GraySpace) -> Ordering
GT
            (ColorSpace a e
RGBSpace,  ColorSpace a e
_) -> Ordering
LT; (ColorSpace a e
_, ColorSpace a e
RGBSpace)  -> Ordering
GT


data Global
data Local

data Function1 scope a e where
    GlobalFunction1 ::
        FunctionObject (PDFFloat -> a) (ExprFloat -> e) ->
        Function1 Local a e
    Sampled1 :: Array Int a -> Function1 Global a e
    Interpolated1 :: PDFFloat -> a -> a -> Function1 scope a e
    Stitched1 ::
        Function1 Local a e -> [(PDFFloat, Function1 Local a e)] ->
        Function1 scope a e
    Calculator1 :: (ExprFloat -> e) -> Function1 Global a e

instance
    (Local ~ scope, ColorTuple a, Eq a, Expr.Result e) =>
        Eq (Function1 scope a e) where
    Function1 scope a e
a== :: Function1 scope a e -> Function1 scope a e -> Bool
==Function1 scope a e
b =
        case (Function1 scope a e
a,Function1 scope a e
b) of
            (GlobalFunction1 FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fa, GlobalFunction1 FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fb) -> FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fa FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
-> FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
-> Bool
forall a. Eq a => a -> a -> Bool
== FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fb
            (Interpolated1 PDFFloat
na a
xa a
ya, Interpolated1 PDFFloat
nb a
xb a
yb) ->
                (PDFFloat
na, a
xa, a
ya) (PDFFloat, a, a) -> (PDFFloat, a, a) -> Bool
forall a. Eq a => a -> a -> Bool
== (PDFFloat
nb, a
xb, a
yb)
            (Stitched1 Function1 Local a e
partA [(PDFFloat, Function1 Local a e)]
partsA, Stitched1 Function1 Local a e
partB [(PDFFloat, Function1 Local a e)]
partsB) ->
                (Function1 Local a e
partA, [(PDFFloat, Function1 Local a e)]
partsA) (Function1 Local a e, [(PDFFloat, Function1 Local a e)])
-> (Function1 Local a e, [(PDFFloat, Function1 Local a e)]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Function1 Local a e
partB, [(PDFFloat, Function1 Local a e)]
partsB)
            (Function1 scope a e, Function1 scope a e)
_ -> Bool
False

instance
    (Local ~ scope, ColorTuple a, Ord a, Expr.Result e) =>
        Ord (Function1 scope a e) where
    compare :: Function1 scope a e -> Function1 scope a e -> Ordering
compare Function1 scope a e
a Function1 scope a e
b =
        case (Function1 scope a e
a,Function1 scope a e
b) of
            (GlobalFunction1 FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fa, GlobalFunction1 FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fb) -> FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
-> FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fa FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
fb
            (Interpolated1 PDFFloat
na a
xa a
ya, Interpolated1 PDFFloat
nb a
xb a
yb) ->
                (PDFFloat, a, a) -> (PDFFloat, a, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PDFFloat
na, a
xa, a
ya) (PDFFloat
nb, a
xb, a
yb)
            (Stitched1 Function1 Local a e
partA [(PDFFloat, Function1 Local a e)]
partsA, Stitched1 Function1 Local a e
partB [(PDFFloat, Function1 Local a e)]
partsB) ->
                (Function1 Local a e, [(PDFFloat, Function1 Local a e)])
-> (Function1 Local a e, [(PDFFloat, Function1 Local a e)])
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Function1 Local a e
partA, [(PDFFloat, Function1 Local a e)]
partsA) (Function1 Local a e
partB, [(PDFFloat, Function1 Local a e)]
partsB)
            (GlobalFunction1 FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
_, Function1 scope a e
_) -> Ordering
LT
            (Function1 scope a e
_, GlobalFunction1 FunctionObject (PDFFloat -> a) (PDFExpression PDFFloat -> e)
_) -> Ordering
GT
            (Interpolated1 PDFFloat
_ a
_ a
_, Function1 scope a e
_) -> Ordering
LT
            (Function1 scope a e
_, Interpolated1 PDFFloat
_ a
_ a
_) -> Ordering
GT


-- ToDo: would be more type-safe with non-empty: NonEmpty (NonEmpty [])
mapAdjacent :: (a -> a -> b) -> [a] -> [b]
mapAdjacent :: forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent a -> a -> b
f [a]
xs = (a -> a -> b) -> [a] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> b
f [a]
xs ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs)

linearStitched ::
    (ColorTuple a) => a -> [(PDFFloat, a)] -> a -> Function1 Local a e
linearStitched :: forall a e.
ColorTuple a =>
a -> [(PDFFloat, a)] -> a -> Function1 Local a e
linearStitched a
firstY [(PDFFloat, a)]
nodes a
lastY =
    case (a -> a -> Function1 Local a e) -> [a] -> [Function1 Local a e]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (PDFFloat -> a -> a -> Function1 Local a e
forall a scope e. PDFFloat -> a -> a -> Function1 scope a e
Interpolated1 PDFFloat
1)
            (a
firstY a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((PDFFloat, a) -> a) -> [(PDFFloat, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (PDFFloat, a) -> a
forall a b. (a, b) -> b
snd [(PDFFloat, a)]
nodes [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
lastY a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []) of
        [] -> String -> Function1 Local a e
forall a. HasCallStack => String -> a
error String
"list should be non-empty by construction"
        Function1 Local a e
part:[Function1 Local a e]
parts -> Function1 Local a e
-> [(PDFFloat, Function1 Local a e)] -> Function1 Local a e
forall a e scope.
Function1 Local a e
-> [(PDFFloat, Function1 Local a e)] -> Function1 scope a e
Stitched1 Function1 Local a e
part ([PDFFloat]
-> [Function1 Local a e] -> [(PDFFloat, Function1 Local a e)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((PDFFloat, a) -> PDFFloat) -> [(PDFFloat, a)] -> [PDFFloat]
forall a b. (a -> b) -> [a] -> [b]
map (PDFFloat, a) -> PDFFloat
forall a b. (a, b) -> a
fst [(PDFFloat, a)]
nodes) [Function1 Local a e]
parts)

calculator1 :: (ExprFloat -> e) -> Function1 Global a e
calculator1 :: forall e a. (PDFExpression PDFFloat -> e) -> Function1 Global a e
calculator1 = (PDFExpression PDFFloat -> e) -> Function1 Global a e
forall e a. (PDFExpression PDFFloat -> e) -> Function1 Global a e
Calculator1

domain1Dict :: (ColorTuple a) => f a e -> PDFDictionary
domain1Dict :: forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> PDFDictionary
domain1Dict f a e
func =
    [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList [
        String -> [Int] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Domain" [Int
0,Int
1::Int],
        f a e -> (PDFName, AnyPdfObject)
forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> (PDFName, AnyPdfObject)
rangeEntry f a e
func
    ]

instance
    (Local ~ scope, ColorTuple a, Expr.Result e) =>
        PdfResourceObject (Function1 scope a e) where
    toRsrc :: Function1 scope a e -> AnyPdfObject
toRsrc Function1 scope a e
func =
        let domain :: PDFDictionary
domain = Function1 scope a e -> PDFDictionary
forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> PDFDictionary
domain1Dict Function1 scope a e
func in
        case Function1 scope a e
func of
            GlobalFunction1 (FunctionObject PDFReference PDFDictionary
obj) -> PDFReference PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFDictionary
obj
            GlobalFunction1 (FunctionStream PDFReference PDFStream
obj) -> PDFReference PDFStream -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFStream
obj
            Interpolated1 PDFFloat
n a
x a
y ->
                PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject) -> PDFDictionary -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
forall a.
ColorTuple a =>
PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
rsrcFromInterpolated PDFDictionary
domain PDFFloat
n a
x a
y
            Stitched1 Function1 Local a e
part [(PDFFloat, Function1 Local a e)]
parts ->
                PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject) -> PDFDictionary -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ PDFDictionary
-> Function1 Local a e
-> [(PDFFloat, Function1 Local a e)]
-> PDFDictionary
forall a e.
(ColorTuple a, Result e) =>
PDFDictionary
-> Function1 Local a e
-> [(PDFFloat, Function1 Local a e)]
-> PDFDictionary
rsrcFromStitched PDFDictionary
domain Function1 Local a e
part [(PDFFloat, Function1 Local a e)]
parts


data Function2 scope a e where
    GlobalFunction2 ::
        FunctionObject
            (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e) ->
        Function2 Local a e
    Sampled2 :: (Array (Int,Int) a) -> Function2 Global a e
    Calculator2 :: (ExprFloat -> ExprFloat -> e) -> Function2 Global a e

instance
    (Local ~ scope, ColorTuple a, Eq a, Expr.Result e) =>
        Eq (Function2 scope a e) where
    Function2 scope a e
a== :: Function2 scope a e -> Function2 scope a e -> Bool
==Function2 scope a e
b =
        case (Function2 scope a e
a,Function2 scope a e
b) of
            (GlobalFunction2 FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fa, GlobalFunction2 FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fb) -> FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fa FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> FunctionObject
     (PDFFloat -> PDFFloat -> a)
     (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> Bool
forall a. Eq a => a -> a -> Bool
== FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fb

instance
    (Local ~ scope, ColorTuple a, Ord a, Expr.Result e) =>
        Ord (Function2 scope a e) where
    compare :: Function2 scope a e -> Function2 scope a e -> Ordering
compare Function2 scope a e
a Function2 scope a e
b =
        case (Function2 scope a e
a,Function2 scope a e
b) of
            (GlobalFunction2 FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fa, GlobalFunction2 FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fb) -> FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> FunctionObject
     (PDFFloat -> PDFFloat -> a)
     (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> Ordering
forall a. Ord a => a -> a -> Ordering
compare FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fa FunctionObject
  (PDFFloat -> PDFFloat -> a)
  (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
fb

calculator2 :: (ExprFloat -> ExprFloat -> e) -> Function2 Global a e
calculator2 :: forall e a.
(PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> Function2 Global a e
calculator2 = (PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> Function2 Global a e
forall e a.
(PDFExpression PDFFloat -> PDFExpression PDFFloat -> e)
-> Function2 Global a e
Calculator2

domain2Dict :: (ColorTuple a) => f a e -> PDFDictionary
domain2Dict :: forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> PDFDictionary
domain2Dict f a e
func =
    [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList [
        String -> [Int] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Domain" [Int
0,Int
1, Int
0,Int
1::Int],
        f a e -> (PDFName, AnyPdfObject)
forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> (PDFName, AnyPdfObject)
rangeEntry f a e
func
    ]

instance
    (Local ~ scope, ColorTuple a, Expr.Result e) =>
        PdfResourceObject (Function2 scope a e) where
    toRsrc :: Function2 scope a e -> AnyPdfObject
toRsrc Function2 scope a e
func =
        case Function2 scope a e
func of
            GlobalFunction2 (FunctionObject PDFReference PDFDictionary
obj) -> PDFReference PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFDictionary
obj
            GlobalFunction2 (FunctionStream PDFReference PDFStream
obj) -> PDFReference PDFStream -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFStream
obj


-- | A shading
data PDFShading =
      FunctionalShading Matrix ColorFunction2
    | AxialShading PDFFloat PDFFloat PDFFloat PDFFloat ColorFunction1
    | RadialShading PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat ColorFunction1
                deriving(PDFShading -> PDFShading -> Bool
(PDFShading -> PDFShading -> Bool)
-> (PDFShading -> PDFShading -> Bool) -> Eq PDFShading
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PDFShading -> PDFShading -> Bool
== :: PDFShading -> PDFShading -> Bool
$c/= :: PDFShading -> PDFShading -> Bool
/= :: 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
$ccompare :: PDFShading -> PDFShading -> Ordering
compare :: PDFShading -> PDFShading -> Ordering
$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
>= :: PDFShading -> PDFShading -> Bool
$cmax :: PDFShading -> PDFShading -> PDFShading
max :: PDFShading -> PDFShading -> PDFShading
$cmin :: PDFShading -> PDFShading -> PDFShading
min :: PDFShading -> PDFShading -> PDFShading
Ord)

matrixCoefficients :: Matrix -> [PDFFloat]
matrixCoefficients :: Matrix -> [PDFFloat]
matrixCoefficients (Matrix PDFFloat
a PDFFloat
b PDFFloat
c PDFFloat
d PDFFloat
e PDFFloat
f) = [PDFFloat
a,PDFFloat
b,PDFFloat
c,PDFFloat
d,PDFFloat
e,PDFFloat
f]

instance PdfResourceObject PDFShading where
      toRsrc :: PDFShading -> AnyPdfObject
toRsrc (FunctionalShading Matrix
mat (ColorFunction2 ColorSpace a e
cs Function2 Local a e
func)) =
          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
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                                 [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"ShadingType" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
forall a b. (a -> b) -> a -> b
$ Int
1)
                                 , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Matrix" (Matrix -> [PDFFloat]
matrixCoefficients (Matrix -> [PDFFloat]) -> Matrix -> [PDFFloat]
forall a b. (a -> b) -> a -> b
$ Matrix
mat)
                                 , ColorSpace a e -> (PDFName, AnyPdfObject)
forall a e. ColorSpace a e -> (PDFName, AnyPdfObject)
colorSpaceEntry ColorSpace a e
cs
                                 , String -> AnyPdfObject -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Function" (Function2 Local a e -> AnyPdfObject
forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc Function2 Local a e
func)
                                 ]
      toRsrc (AxialShading PDFFloat
x0 PDFFloat
y0 PDFFloat
x1 PDFFloat
y1 (ColorFunction1 ColorSpace a e
cs Function1 Local a e
func)) =
          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
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                                 [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"ShadingType" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
forall a b. (a -> b) -> a -> b
$ Int
2)
                                 , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Coords" [PDFFloat
x0,PDFFloat
y0,PDFFloat
x1,PDFFloat
y1]
                                 , String -> [Bool] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Extend" [Bool
True, Bool
True]
                                 , ColorSpace a e -> (PDFName, AnyPdfObject)
forall a e. ColorSpace a e -> (PDFName, AnyPdfObject)
colorSpaceEntry ColorSpace a e
cs
                                 , String -> AnyPdfObject -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Function" (Function1 Local a e -> AnyPdfObject
forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc Function1 Local a e
func)
                                 ]
      toRsrc (RadialShading PDFFloat
x0 PDFFloat
y0 PDFFloat
r0 PDFFloat
x1 PDFFloat
y1 PDFFloat
r1 (ColorFunction1 ColorSpace a e
cs Function1 Local a e
func)) =
          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
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                                 [ String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"ShadingType" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
forall a b. (a -> b) -> a -> b
$ Int
3)
                                 , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Coords" [PDFFloat
x0,PDFFloat
y0,PDFFloat
r0,PDFFloat
x1,PDFFloat
y1,PDFFloat
r1]
                                 , String -> [Bool] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Extend" [Bool
True, Bool
True]
                                 , ColorSpace a e -> (PDFName, AnyPdfObject)
forall a e. ColorSpace a e -> (PDFName, AnyPdfObject)
colorSpaceEntry ColorSpace a e
cs
                                 , String -> AnyPdfObject -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Function" (Function1 Local a e -> AnyPdfObject
forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc Function1 Local a e
func)
                                 ]


newtype SoftMask = SoftMask (PDFReference PDFXForm)
    deriving (SoftMask -> SoftMask -> Bool
(SoftMask -> SoftMask -> Bool)
-> (SoftMask -> SoftMask -> Bool) -> Eq SoftMask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SoftMask -> SoftMask -> Bool
== :: SoftMask -> SoftMask -> Bool
$c/= :: SoftMask -> SoftMask -> Bool
/= :: SoftMask -> SoftMask -> Bool
Eq, Eq SoftMask
Eq SoftMask =>
(SoftMask -> SoftMask -> Ordering)
-> (SoftMask -> SoftMask -> Bool)
-> (SoftMask -> SoftMask -> Bool)
-> (SoftMask -> SoftMask -> Bool)
-> (SoftMask -> SoftMask -> Bool)
-> (SoftMask -> SoftMask -> SoftMask)
-> (SoftMask -> SoftMask -> SoftMask)
-> Ord SoftMask
SoftMask -> SoftMask -> Bool
SoftMask -> SoftMask -> Ordering
SoftMask -> SoftMask -> SoftMask
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
$ccompare :: SoftMask -> SoftMask -> Ordering
compare :: SoftMask -> SoftMask -> Ordering
$c< :: SoftMask -> SoftMask -> Bool
< :: SoftMask -> SoftMask -> Bool
$c<= :: SoftMask -> SoftMask -> Bool
<= :: SoftMask -> SoftMask -> Bool
$c> :: SoftMask -> SoftMask -> Bool
> :: SoftMask -> SoftMask -> Bool
$c>= :: SoftMask -> SoftMask -> Bool
>= :: SoftMask -> SoftMask -> Bool
$cmax :: SoftMask -> SoftMask -> SoftMask
max :: SoftMask -> SoftMask -> SoftMask
$cmin :: SoftMask -> SoftMask -> SoftMask
min :: SoftMask -> SoftMask -> SoftMask
Ord)

instance PdfResourceObject SoftMask where
    toRsrc :: SoftMask -> AnyPdfObject
toRsrc (SoftMask PDFReference PDFXForm
ref) =
        PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject) -> PDFDictionary -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
        [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
            String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"ExtGState") (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
            String -> PDFDictionary -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"SMask"
                ([(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
                    String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Mask") (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                    String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"S" (String -> PDFName
PDFName String
"Luminosity") (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                    String -> PDFReference PDFXForm -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"G" PDFReference PDFXForm
ref (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                    []) (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
            []


-- | 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"
                    ]