{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Low level stuff
---------------------------------------------------------
-- #hide
module Graphics.PDF.LowLevel.Types where

import qualified Data.Map.Strict as M
import Data.List(intersperse)
import Data.Int
import Control.Monad.State
import Control.Monad.Writer
import Data.Binary.Builder(Builder,fromByteString)
import Graphics.PDF.LowLevel.Serializer
import Data.Complex
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy.Internal as L(ByteString(..))
import Data.Text.Encoding
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as C
import Data.Word 
import Data.Char(ord)
import Text.Printf(printf)

{-

Low level typesetting types

-}
data SpecialChar = NormalChar !Char
                 | BreakingHyphen
                 | BiggerSpace
                 | NormalSpace

{-

PDF Specific low level types

-}

-- | PDF Objects
class PdfObject a where
  toPDF :: a -> Builder

class PdfLengthInfo a where 
  pdfLengthInfo :: a -> Maybe (Int64 , PDFReference MaybeLength)
  pdfLengthInfo a
_ = Maybe (Int64, PDFReference MaybeLength)
forall a. Maybe a
Nothing

-- | Anonymous PDF object
data AnyPdfObject = forall a . (PdfObject a, PdfLengthInfo a) => AnyPdfObject !a

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

instance PdfLengthInfo AnyPdfObject where 
  pdfLengthInfo :: AnyPdfObject -> Maybe (Int64, PDFReference MaybeLength)
pdfLengthInfo (AnyPdfObject a
a) = a -> Maybe (Int64, PDFReference MaybeLength)
forall a.
PdfLengthInfo a =>
a -> Maybe (Int64, PDFReference MaybeLength)
pdfLengthInfo a
a
 
-- | An integer in a PDF document
newtype PDFInteger = PDFInteger Int deriving(PDFInteger -> PDFInteger -> Bool
(PDFInteger -> PDFInteger -> Bool)
-> (PDFInteger -> PDFInteger -> Bool) -> Eq PDFInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFInteger -> PDFInteger -> Bool
$c/= :: PDFInteger -> PDFInteger -> Bool
== :: PDFInteger -> PDFInteger -> Bool
$c== :: PDFInteger -> PDFInteger -> Bool
Eq,Int -> PDFInteger -> ShowS
[PDFInteger] -> ShowS
PDFInteger -> String
(Int -> PDFInteger -> ShowS)
-> (PDFInteger -> String)
-> ([PDFInteger] -> ShowS)
-> Show PDFInteger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDFInteger] -> ShowS
$cshowList :: [PDFInteger] -> ShowS
show :: PDFInteger -> String
$cshow :: PDFInteger -> String
showsPrec :: Int -> PDFInteger -> ShowS
$cshowsPrec :: Int -> PDFInteger -> ShowS
Show,Eq PDFInteger
Eq PDFInteger
-> (PDFInteger -> PDFInteger -> Ordering)
-> (PDFInteger -> PDFInteger -> Bool)
-> (PDFInteger -> PDFInteger -> Bool)
-> (PDFInteger -> PDFInteger -> Bool)
-> (PDFInteger -> PDFInteger -> Bool)
-> (PDFInteger -> PDFInteger -> PDFInteger)
-> (PDFInteger -> PDFInteger -> PDFInteger)
-> Ord PDFInteger
PDFInteger -> PDFInteger -> Bool
PDFInteger -> PDFInteger -> Ordering
PDFInteger -> PDFInteger -> PDFInteger
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDFInteger -> PDFInteger -> PDFInteger
$cmin :: PDFInteger -> PDFInteger -> PDFInteger
max :: PDFInteger -> PDFInteger -> PDFInteger
$cmax :: PDFInteger -> PDFInteger -> PDFInteger
>= :: PDFInteger -> PDFInteger -> Bool
$c>= :: PDFInteger -> PDFInteger -> Bool
> :: PDFInteger -> PDFInteger -> Bool
$c> :: PDFInteger -> PDFInteger -> Bool
<= :: PDFInteger -> PDFInteger -> Bool
$c<= :: PDFInteger -> PDFInteger -> Bool
< :: PDFInteger -> PDFInteger -> Bool
$c< :: PDFInteger -> PDFInteger -> Bool
compare :: PDFInteger -> PDFInteger -> Ordering
$ccompare :: PDFInteger -> PDFInteger -> Ordering
$cp1Ord :: Eq PDFInteger
Ord,Integer -> PDFInteger
PDFInteger -> PDFInteger
PDFInteger -> PDFInteger -> PDFInteger
(PDFInteger -> PDFInteger -> PDFInteger)
-> (PDFInteger -> PDFInteger -> PDFInteger)
-> (PDFInteger -> PDFInteger -> PDFInteger)
-> (PDFInteger -> PDFInteger)
-> (PDFInteger -> PDFInteger)
-> (PDFInteger -> PDFInteger)
-> (Integer -> PDFInteger)
-> Num PDFInteger
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PDFInteger
$cfromInteger :: Integer -> PDFInteger
signum :: PDFInteger -> PDFInteger
$csignum :: PDFInteger -> PDFInteger
abs :: PDFInteger -> PDFInteger
$cabs :: PDFInteger -> PDFInteger
negate :: PDFInteger -> PDFInteger
$cnegate :: PDFInteger -> PDFInteger
* :: PDFInteger -> PDFInteger -> PDFInteger
$c* :: PDFInteger -> PDFInteger -> PDFInteger
- :: PDFInteger -> PDFInteger -> PDFInteger
$c- :: PDFInteger -> PDFInteger -> PDFInteger
+ :: PDFInteger -> PDFInteger -> PDFInteger
$c+ :: PDFInteger -> PDFInteger -> PDFInteger
Num)

-- | A length in a PDF document
newtype PDFLength = PDFLength Int64 deriving(PDFLength -> PDFLength -> Bool
(PDFLength -> PDFLength -> Bool)
-> (PDFLength -> PDFLength -> Bool) -> Eq PDFLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFLength -> PDFLength -> Bool
$c/= :: PDFLength -> PDFLength -> Bool
== :: PDFLength -> PDFLength -> Bool
$c== :: PDFLength -> PDFLength -> Bool
Eq,Int -> PDFLength -> ShowS
[PDFLength] -> ShowS
PDFLength -> String
(Int -> PDFLength -> ShowS)
-> (PDFLength -> String)
-> ([PDFLength] -> ShowS)
-> Show PDFLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDFLength] -> ShowS
$cshowList :: [PDFLength] -> ShowS
show :: PDFLength -> String
$cshow :: PDFLength -> String
showsPrec :: Int -> PDFLength -> ShowS
$cshowsPrec :: Int -> PDFLength -> ShowS
Show,Eq PDFLength
Eq PDFLength
-> (PDFLength -> PDFLength -> Ordering)
-> (PDFLength -> PDFLength -> Bool)
-> (PDFLength -> PDFLength -> Bool)
-> (PDFLength -> PDFLength -> Bool)
-> (PDFLength -> PDFLength -> Bool)
-> (PDFLength -> PDFLength -> PDFLength)
-> (PDFLength -> PDFLength -> PDFLength)
-> Ord PDFLength
PDFLength -> PDFLength -> Bool
PDFLength -> PDFLength -> Ordering
PDFLength -> PDFLength -> PDFLength
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDFLength -> PDFLength -> PDFLength
$cmin :: PDFLength -> PDFLength -> PDFLength
max :: PDFLength -> PDFLength -> PDFLength
$cmax :: PDFLength -> PDFLength -> PDFLength
>= :: PDFLength -> PDFLength -> Bool
$c>= :: PDFLength -> PDFLength -> Bool
> :: PDFLength -> PDFLength -> Bool
$c> :: PDFLength -> PDFLength -> Bool
<= :: PDFLength -> PDFLength -> Bool
$c<= :: PDFLength -> PDFLength -> Bool
< :: PDFLength -> PDFLength -> Bool
$c< :: PDFLength -> PDFLength -> Bool
compare :: PDFLength -> PDFLength -> Ordering
$ccompare :: PDFLength -> PDFLength -> Ordering
$cp1Ord :: Eq PDFLength
Ord,Integer -> PDFLength
PDFLength -> PDFLength
PDFLength -> PDFLength -> PDFLength
(PDFLength -> PDFLength -> PDFLength)
-> (PDFLength -> PDFLength -> PDFLength)
-> (PDFLength -> PDFLength -> PDFLength)
-> (PDFLength -> PDFLength)
-> (PDFLength -> PDFLength)
-> (PDFLength -> PDFLength)
-> (Integer -> PDFLength)
-> Num PDFLength
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PDFLength
$cfromInteger :: Integer -> PDFLength
signum :: PDFLength -> PDFLength
$csignum :: PDFLength -> PDFLength
abs :: PDFLength -> PDFLength
$cabs :: PDFLength -> PDFLength
negate :: PDFLength -> PDFLength
$cnegate :: PDFLength -> PDFLength
* :: PDFLength -> PDFLength -> PDFLength
$c* :: PDFLength -> PDFLength -> PDFLength
- :: PDFLength -> PDFLength -> PDFLength
$c- :: PDFLength -> PDFLength -> PDFLength
+ :: PDFLength -> PDFLength -> PDFLength
$c+ :: PDFLength -> PDFLength -> PDFLength
Num)

data MaybeLength = UnknownLength 
                 | KnownLength !PDFLength 

instance PdfObject MaybeLength where 
  toPDF :: MaybeLength -> Builder
toPDF (KnownLength PDFLength
a) = PDFLength -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFLength
a 
  toPDF (MaybeLength
UnknownLength) = String -> Builder
forall a. HasCallStack => String -> a
error String
"Trying to process an unknown length during PDF generation"

instance PdfLengthInfo MaybeLength where

-- | A real number in a PDF document
type PDFFloat = Double 

instance PdfObject PDFInteger where
    toPDF :: PDFInteger -> Builder
toPDF (PDFInteger Int
a) = Int -> Builder
forall s a. SerializeValue s a => a -> s
serialize Int
a

instance PdfLengthInfo PDFInteger where

instance PdfObject Int where
    toPDF :: Int -> Builder
toPDF Int
a = Int -> Builder
forall s a. SerializeValue s a => a -> s
serialize Int
a

instance PdfLengthInfo Int where

          
instance PdfObject PDFLength where
    toPDF :: PDFLength -> Builder
toPDF (PDFLength Int64
a) = String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (Int64 -> String
forall a. Show a => a -> String
show Int64
a)

instance PdfLengthInfo PDFLength where

    
instance PdfObject PDFFloat where
  toPDF :: PDFFloat -> Builder
toPDF PDFFloat
a = PDFFloat -> Builder
forall s a. SerializeValue s a => a -> s
serialize PDFFloat
a

instance PdfLengthInfo PDFFloat where


instance PdfObject (Complex PDFFloat) where
  toPDF :: Complex PDFFloat -> Builder
toPDF (PDFFloat
x :+ PDFFloat
y) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ PDFFloat -> Builder
forall s a. SerializeValue s a => a -> s
serialize PDFFloat
x
                           , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                           , PDFFloat -> Builder
forall s a. SerializeValue s a => a -> s
serialize PDFFloat
y
                           ] 

instance PdfLengthInfo (Complex PDFFloat) where

  
instance PdfObject Bool where
  toPDF :: Bool -> Builder
toPDF (Bool
True) = String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String
"true" :: String)
  toPDF (Bool
False) = String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String
"false" :: String)

instance PdfLengthInfo Bool where


-- | A PDFString containing a strict bytestring (serialied as UTF16BE)
newtype PDFString = PDFString S.ByteString deriving(PDFString -> PDFString -> Bool
(PDFString -> PDFString -> Bool)
-> (PDFString -> PDFString -> Bool) -> Eq PDFString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFString -> PDFString -> Bool
$c/= :: PDFString -> PDFString -> Bool
== :: PDFString -> PDFString -> Bool
$c== :: PDFString -> PDFString -> Bool
Eq,Eq PDFString
Eq PDFString
-> (PDFString -> PDFString -> Ordering)
-> (PDFString -> PDFString -> Bool)
-> (PDFString -> PDFString -> Bool)
-> (PDFString -> PDFString -> Bool)
-> (PDFString -> PDFString -> Bool)
-> (PDFString -> PDFString -> PDFString)
-> (PDFString -> PDFString -> PDFString)
-> Ord PDFString
PDFString -> PDFString -> Bool
PDFString -> PDFString -> Ordering
PDFString -> PDFString -> PDFString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDFString -> PDFString -> PDFString
$cmin :: PDFString -> PDFString -> PDFString
max :: PDFString -> PDFString -> PDFString
$cmax :: PDFString -> PDFString -> PDFString
>= :: PDFString -> PDFString -> Bool
$c>= :: PDFString -> PDFString -> Bool
> :: PDFString -> PDFString -> Bool
$c> :: PDFString -> PDFString -> Bool
<= :: PDFString -> PDFString -> Bool
$c<= :: PDFString -> PDFString -> Bool
< :: PDFString -> PDFString -> Bool
$c< :: PDFString -> PDFString -> Bool
compare :: PDFString -> PDFString -> Ordering
$ccompare :: PDFString -> PDFString -> Ordering
$cp1Ord :: Eq PDFString
Ord,Int -> PDFString -> ShowS
[PDFString] -> ShowS
PDFString -> String
(Int -> PDFString -> ShowS)
-> (PDFString -> String)
-> ([PDFString] -> ShowS)
-> Show PDFString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDFString] -> ShowS
$cshowList :: [PDFString] -> ShowS
show :: PDFString -> String
$cshow :: PDFString -> String
showsPrec :: Int -> PDFString -> ShowS
$cshowsPrec :: Int -> PDFString -> ShowS
Show)

-- | A list of glyph to be used in text operators
newtype PDFGlyph = PDFGlyph S.ByteString deriving(PDFGlyph -> PDFGlyph -> Bool
(PDFGlyph -> PDFGlyph -> Bool)
-> (PDFGlyph -> PDFGlyph -> Bool) -> Eq PDFGlyph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFGlyph -> PDFGlyph -> Bool
$c/= :: PDFGlyph -> PDFGlyph -> Bool
== :: PDFGlyph -> PDFGlyph -> Bool
$c== :: PDFGlyph -> PDFGlyph -> Bool
Eq,Eq PDFGlyph
Eq PDFGlyph
-> (PDFGlyph -> PDFGlyph -> Ordering)
-> (PDFGlyph -> PDFGlyph -> Bool)
-> (PDFGlyph -> PDFGlyph -> Bool)
-> (PDFGlyph -> PDFGlyph -> Bool)
-> (PDFGlyph -> PDFGlyph -> Bool)
-> (PDFGlyph -> PDFGlyph -> PDFGlyph)
-> (PDFGlyph -> PDFGlyph -> PDFGlyph)
-> Ord PDFGlyph
PDFGlyph -> PDFGlyph -> Bool
PDFGlyph -> PDFGlyph -> Ordering
PDFGlyph -> PDFGlyph -> PDFGlyph
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDFGlyph -> PDFGlyph -> PDFGlyph
$cmin :: PDFGlyph -> PDFGlyph -> PDFGlyph
max :: PDFGlyph -> PDFGlyph -> PDFGlyph
$cmax :: PDFGlyph -> PDFGlyph -> PDFGlyph
>= :: PDFGlyph -> PDFGlyph -> Bool
$c>= :: PDFGlyph -> PDFGlyph -> Bool
> :: PDFGlyph -> PDFGlyph -> Bool
$c> :: PDFGlyph -> PDFGlyph -> Bool
<= :: PDFGlyph -> PDFGlyph -> Bool
$c<= :: PDFGlyph -> PDFGlyph -> Bool
< :: PDFGlyph -> PDFGlyph -> Bool
$c< :: PDFGlyph -> PDFGlyph -> Bool
compare :: PDFGlyph -> PDFGlyph -> Ordering
$ccompare :: PDFGlyph -> PDFGlyph -> Ordering
$cp1Ord :: Eq PDFGlyph
Ord,Int -> PDFGlyph -> ShowS
[PDFGlyph] -> ShowS
PDFGlyph -> String
(Int -> PDFGlyph -> ShowS)
-> (PDFGlyph -> String) -> ([PDFGlyph] -> ShowS) -> Show PDFGlyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDFGlyph] -> ShowS
$cshowList :: [PDFGlyph] -> ShowS
show :: PDFGlyph -> String
$cshow :: PDFGlyph -> String
showsPrec :: Int -> PDFGlyph -> ShowS
$cshowsPrec :: Int -> PDFGlyph -> ShowS
Show)

-- | A list of glyph to be used in text operators
newtype EscapedPDFGlyph = EscapedPDFGlyph S.ByteString deriving(EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
(EscapedPDFGlyph -> EscapedPDFGlyph -> Bool)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> Bool)
-> Eq EscapedPDFGlyph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
$c/= :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
== :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
$c== :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
Eq,Eq EscapedPDFGlyph
Eq EscapedPDFGlyph
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> Ordering)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> Bool)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> Bool)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> Bool)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> Bool)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph)
-> (EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph)
-> Ord EscapedPDFGlyph
EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
EscapedPDFGlyph -> EscapedPDFGlyph -> Ordering
EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph
$cmin :: EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph
max :: EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph
$cmax :: EscapedPDFGlyph -> EscapedPDFGlyph -> EscapedPDFGlyph
>= :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
$c>= :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
> :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
$c> :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
<= :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
$c<= :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
< :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
$c< :: EscapedPDFGlyph -> EscapedPDFGlyph -> Bool
compare :: EscapedPDFGlyph -> EscapedPDFGlyph -> Ordering
$ccompare :: EscapedPDFGlyph -> EscapedPDFGlyph -> Ordering
$cp1Ord :: Eq EscapedPDFGlyph
Ord,Int -> EscapedPDFGlyph -> ShowS
[EscapedPDFGlyph] -> ShowS
EscapedPDFGlyph -> String
(Int -> EscapedPDFGlyph -> ShowS)
-> (EscapedPDFGlyph -> String)
-> ([EscapedPDFGlyph] -> ShowS)
-> Show EscapedPDFGlyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapedPDFGlyph] -> ShowS
$cshowList :: [EscapedPDFGlyph] -> ShowS
show :: EscapedPDFGlyph -> String
$cshow :: EscapedPDFGlyph -> String
showsPrec :: Int -> EscapedPDFGlyph -> ShowS
$cshowsPrec :: Int -> EscapedPDFGlyph -> ShowS
Show)

-- | 7 bit encoded ASCII string
newtype AsciiString = AsciiString S.ByteString deriving(AsciiString -> AsciiString -> Bool
(AsciiString -> AsciiString -> Bool)
-> (AsciiString -> AsciiString -> Bool) -> Eq AsciiString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsciiString -> AsciiString -> Bool
$c/= :: AsciiString -> AsciiString -> Bool
== :: AsciiString -> AsciiString -> Bool
$c== :: AsciiString -> AsciiString -> Bool
Eq,Eq AsciiString
Eq AsciiString
-> (AsciiString -> AsciiString -> Ordering)
-> (AsciiString -> AsciiString -> Bool)
-> (AsciiString -> AsciiString -> Bool)
-> (AsciiString -> AsciiString -> Bool)
-> (AsciiString -> AsciiString -> Bool)
-> (AsciiString -> AsciiString -> AsciiString)
-> (AsciiString -> AsciiString -> AsciiString)
-> Ord AsciiString
AsciiString -> AsciiString -> Bool
AsciiString -> AsciiString -> Ordering
AsciiString -> AsciiString -> AsciiString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AsciiString -> AsciiString -> AsciiString
$cmin :: AsciiString -> AsciiString -> AsciiString
max :: AsciiString -> AsciiString -> AsciiString
$cmax :: AsciiString -> AsciiString -> AsciiString
>= :: AsciiString -> AsciiString -> Bool
$c>= :: AsciiString -> AsciiString -> Bool
> :: AsciiString -> AsciiString -> Bool
$c> :: AsciiString -> AsciiString -> Bool
<= :: AsciiString -> AsciiString -> Bool
$c<= :: AsciiString -> AsciiString -> Bool
< :: AsciiString -> AsciiString -> Bool
$c< :: AsciiString -> AsciiString -> Bool
compare :: AsciiString -> AsciiString -> Ordering
$ccompare :: AsciiString -> AsciiString -> Ordering
$cp1Ord :: Eq AsciiString
Ord,Int -> AsciiString -> ShowS
[AsciiString] -> ShowS
AsciiString -> String
(Int -> AsciiString -> ShowS)
-> (AsciiString -> String)
-> ([AsciiString] -> ShowS)
-> Show AsciiString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsciiString] -> ShowS
$cshowList :: [AsciiString] -> ShowS
show :: AsciiString -> String
$cshow :: AsciiString -> String
showsPrec :: Int -> AsciiString -> ShowS
$cshowsPrec :: Int -> AsciiString -> ShowS
Show)

-- | 7 bit encoded ASCII string
newtype EscapedAsciiString = EscapedAsciiString S.ByteString deriving(EscapedAsciiString -> EscapedAsciiString -> Bool
(EscapedAsciiString -> EscapedAsciiString -> Bool)
-> (EscapedAsciiString -> EscapedAsciiString -> Bool)
-> Eq EscapedAsciiString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapedAsciiString -> EscapedAsciiString -> Bool
$c/= :: EscapedAsciiString -> EscapedAsciiString -> Bool
== :: EscapedAsciiString -> EscapedAsciiString -> Bool
$c== :: EscapedAsciiString -> EscapedAsciiString -> Bool
Eq,Eq EscapedAsciiString
Eq EscapedAsciiString
-> (EscapedAsciiString -> EscapedAsciiString -> Ordering)
-> (EscapedAsciiString -> EscapedAsciiString -> Bool)
-> (EscapedAsciiString -> EscapedAsciiString -> Bool)
-> (EscapedAsciiString -> EscapedAsciiString -> Bool)
-> (EscapedAsciiString -> EscapedAsciiString -> Bool)
-> (EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString)
-> (EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString)
-> Ord EscapedAsciiString
EscapedAsciiString -> EscapedAsciiString -> Bool
EscapedAsciiString -> EscapedAsciiString -> Ordering
EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString
$cmin :: EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString
max :: EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString
$cmax :: EscapedAsciiString -> EscapedAsciiString -> EscapedAsciiString
>= :: EscapedAsciiString -> EscapedAsciiString -> Bool
$c>= :: EscapedAsciiString -> EscapedAsciiString -> Bool
> :: EscapedAsciiString -> EscapedAsciiString -> Bool
$c> :: EscapedAsciiString -> EscapedAsciiString -> Bool
<= :: EscapedAsciiString -> EscapedAsciiString -> Bool
$c<= :: EscapedAsciiString -> EscapedAsciiString -> Bool
< :: EscapedAsciiString -> EscapedAsciiString -> Bool
$c< :: EscapedAsciiString -> EscapedAsciiString -> Bool
compare :: EscapedAsciiString -> EscapedAsciiString -> Ordering
$ccompare :: EscapedAsciiString -> EscapedAsciiString -> Ordering
$cp1Ord :: Eq EscapedAsciiString
Ord,Int -> EscapedAsciiString -> ShowS
[EscapedAsciiString] -> ShowS
EscapedAsciiString -> String
(Int -> EscapedAsciiString -> ShowS)
-> (EscapedAsciiString -> String)
-> ([EscapedAsciiString] -> ShowS)
-> Show EscapedAsciiString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapedAsciiString] -> ShowS
$cshowList :: [EscapedAsciiString] -> ShowS
show :: EscapedAsciiString -> String
$cshow :: EscapedAsciiString -> String
showsPrec :: Int -> EscapedAsciiString -> ShowS
$cshowsPrec :: Int -> EscapedAsciiString -> ShowS
Show)

escapeText :: Char -> T.Text
escapeText :: Char -> Text
escapeText Char
'(' = Text
"\\("
escapeText Char
')' = Text
"\\)"
escapeText Char
'\\' = Text
"\\\\"
escapeText Char
a = Char -> Text
T.singleton Char
a

escapeByteString :: Char -> S.ByteString
escapeByteString :: Char -> ByteString
escapeByteString Char
'(' = String -> ByteString
C.pack String
"\\("
escapeByteString Char
')' = String -> ByteString
C.pack String
"\\)"
escapeByteString Char
'\\' = String -> ByteString
C.pack String
"\\\\"
escapeByteString Char
a = Char -> ByteString
C.singleton Char
a

-- | Create a PDF string from an Haskell one
toPDFString :: T.Text -> PDFString
toPDFString :: Text -> PDFString
toPDFString = ByteString -> PDFString
PDFString (ByteString -> PDFString)
-> (Text -> ByteString) -> Text -> PDFString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf16BE

toPDFGlyph :: S.ByteString -> PDFGlyph
toPDFGlyph :: ByteString -> PDFGlyph
toPDFGlyph = ByteString -> PDFGlyph
PDFGlyph 

toAsciiString :: String -> AsciiString 
toAsciiString :: String -> AsciiString
toAsciiString String
s = ByteString -> AsciiString
AsciiString (String -> ByteString
C.pack String
s)

class HasHexaStream a where 
  toHexaStream :: a -> S.ByteString 

instance HasHexaStream S.ByteString where 
    toHexaStream :: ByteString -> ByteString
toHexaStream ByteString
x  = 
        let hexChar :: Char -> ByteString
hexChar Char
c = String -> ByteString
C.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X" (Char -> Int
ord Char
c) :: String)
        in
        Char -> ByteString -> ByteString
C.cons Char
'F' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
C.cons Char
'E' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
C.cons Char
'F' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
C.cons Char
'F' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ByteString) -> ByteString -> ByteString
C.concatMap Char -> ByteString
hexChar (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
x

instance HasHexaStream PDFString where 
  toHexaStream :: PDFString -> ByteString
toHexaStream (PDFString ByteString
x) = ByteString -> ByteString
forall a. HasHexaStream a => a -> ByteString
toHexaStream ByteString
x

instance HasHexaStream PDFGlyph where 
  toHexaStream :: PDFGlyph -> ByteString
toHexaStream (PDFGlyph ByteString
x) = 
    let hexChar :: Char -> ByteString
hexChar Char
c = String -> ByteString
C.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X" (Char -> Int
ord Char
c) :: String)
        in
        (Char -> ByteString) -> ByteString -> ByteString
C.concatMap Char -> ByteString
hexChar (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
x


newtype GlyphCode = GlyphCode Word8 deriving(GlyphCode -> GlyphCode -> Bool
(GlyphCode -> GlyphCode -> Bool)
-> (GlyphCode -> GlyphCode -> Bool) -> Eq GlyphCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphCode -> GlyphCode -> Bool
$c/= :: GlyphCode -> GlyphCode -> Bool
== :: GlyphCode -> GlyphCode -> Bool
$c== :: GlyphCode -> GlyphCode -> Bool
Eq,Eq GlyphCode
Eq GlyphCode
-> (GlyphCode -> GlyphCode -> Ordering)
-> (GlyphCode -> GlyphCode -> Bool)
-> (GlyphCode -> GlyphCode -> Bool)
-> (GlyphCode -> GlyphCode -> Bool)
-> (GlyphCode -> GlyphCode -> Bool)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> Ord GlyphCode
GlyphCode -> GlyphCode -> Bool
GlyphCode -> GlyphCode -> Ordering
GlyphCode -> GlyphCode -> GlyphCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlyphCode -> GlyphCode -> GlyphCode
$cmin :: GlyphCode -> GlyphCode -> GlyphCode
max :: GlyphCode -> GlyphCode -> GlyphCode
$cmax :: GlyphCode -> GlyphCode -> GlyphCode
>= :: GlyphCode -> GlyphCode -> Bool
$c>= :: GlyphCode -> GlyphCode -> Bool
> :: GlyphCode -> GlyphCode -> Bool
$c> :: GlyphCode -> GlyphCode -> Bool
<= :: GlyphCode -> GlyphCode -> Bool
$c<= :: GlyphCode -> GlyphCode -> Bool
< :: GlyphCode -> GlyphCode -> Bool
$c< :: GlyphCode -> GlyphCode -> Bool
compare :: GlyphCode -> GlyphCode -> Ordering
$ccompare :: GlyphCode -> GlyphCode -> Ordering
$cp1Ord :: Eq GlyphCode
Ord,Int -> GlyphCode -> ShowS
[GlyphCode] -> ShowS
GlyphCode -> String
(Int -> GlyphCode -> ShowS)
-> (GlyphCode -> String)
-> ([GlyphCode] -> ShowS)
-> Show GlyphCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphCode] -> ShowS
$cshowList :: [GlyphCode] -> ShowS
show :: GlyphCode -> String
$cshow :: GlyphCode -> String
showsPrec :: Int -> GlyphCode -> ShowS
$cshowsPrec :: Int -> GlyphCode -> ShowS
Show,Enum GlyphCode
Real GlyphCode
Real GlyphCode
-> Enum GlyphCode
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode))
-> (GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode))
-> (GlyphCode -> Integer)
-> Integral GlyphCode
GlyphCode -> Integer
GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode)
GlyphCode -> GlyphCode -> GlyphCode
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: GlyphCode -> Integer
$ctoInteger :: GlyphCode -> Integer
divMod :: GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode)
$cdivMod :: GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode)
quotRem :: GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode)
$cquotRem :: GlyphCode -> GlyphCode -> (GlyphCode, GlyphCode)
mod :: GlyphCode -> GlyphCode -> GlyphCode
$cmod :: GlyphCode -> GlyphCode -> GlyphCode
div :: GlyphCode -> GlyphCode -> GlyphCode
$cdiv :: GlyphCode -> GlyphCode -> GlyphCode
rem :: GlyphCode -> GlyphCode -> GlyphCode
$crem :: GlyphCode -> GlyphCode -> GlyphCode
quot :: GlyphCode -> GlyphCode -> GlyphCode
$cquot :: GlyphCode -> GlyphCode -> GlyphCode
$cp2Integral :: Enum GlyphCode
$cp1Integral :: Real GlyphCode
Integral,GlyphCode
GlyphCode -> GlyphCode -> Bounded GlyphCode
forall a. a -> a -> Bounded a
maxBound :: GlyphCode
$cmaxBound :: GlyphCode
minBound :: GlyphCode
$cminBound :: GlyphCode
Bounded,Int -> GlyphCode
GlyphCode -> Int
GlyphCode -> [GlyphCode]
GlyphCode -> GlyphCode
GlyphCode -> GlyphCode -> [GlyphCode]
GlyphCode -> GlyphCode -> GlyphCode -> [GlyphCode]
(GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode)
-> (Int -> GlyphCode)
-> (GlyphCode -> Int)
-> (GlyphCode -> [GlyphCode])
-> (GlyphCode -> GlyphCode -> [GlyphCode])
-> (GlyphCode -> GlyphCode -> [GlyphCode])
-> (GlyphCode -> GlyphCode -> GlyphCode -> [GlyphCode])
-> Enum GlyphCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GlyphCode -> GlyphCode -> GlyphCode -> [GlyphCode]
$cenumFromThenTo :: GlyphCode -> GlyphCode -> GlyphCode -> [GlyphCode]
enumFromTo :: GlyphCode -> GlyphCode -> [GlyphCode]
$cenumFromTo :: GlyphCode -> GlyphCode -> [GlyphCode]
enumFromThen :: GlyphCode -> GlyphCode -> [GlyphCode]
$cenumFromThen :: GlyphCode -> GlyphCode -> [GlyphCode]
enumFrom :: GlyphCode -> [GlyphCode]
$cenumFrom :: GlyphCode -> [GlyphCode]
fromEnum :: GlyphCode -> Int
$cfromEnum :: GlyphCode -> Int
toEnum :: Int -> GlyphCode
$ctoEnum :: Int -> GlyphCode
pred :: GlyphCode -> GlyphCode
$cpred :: GlyphCode -> GlyphCode
succ :: GlyphCode -> GlyphCode
$csucc :: GlyphCode -> GlyphCode
Enum,Num GlyphCode
Ord GlyphCode
Num GlyphCode
-> Ord GlyphCode -> (GlyphCode -> Rational) -> Real GlyphCode
GlyphCode -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: GlyphCode -> Rational
$ctoRational :: GlyphCode -> Rational
$cp2Real :: Ord GlyphCode
$cp1Real :: Num GlyphCode
Real,Integer -> GlyphCode
GlyphCode -> GlyphCode
GlyphCode -> GlyphCode -> GlyphCode
(GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode)
-> (GlyphCode -> GlyphCode)
-> (Integer -> GlyphCode)
-> Num GlyphCode
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GlyphCode
$cfromInteger :: Integer -> GlyphCode
signum :: GlyphCode -> GlyphCode
$csignum :: GlyphCode -> GlyphCode
abs :: GlyphCode -> GlyphCode
$cabs :: GlyphCode -> GlyphCode
negate :: GlyphCode -> GlyphCode
$cnegate :: GlyphCode -> GlyphCode
* :: GlyphCode -> GlyphCode -> GlyphCode
$c* :: GlyphCode -> GlyphCode -> GlyphCode
- :: GlyphCode -> GlyphCode -> GlyphCode
$c- :: GlyphCode -> GlyphCode -> GlyphCode
+ :: GlyphCode -> GlyphCode -> GlyphCode
$c+ :: GlyphCode -> GlyphCode -> GlyphCode
Num)


instance SerializeValue L.ByteString PDFString where
  serialize :: PDFString -> ByteString
serialize (PDFString ByteString
t) = ByteString -> ByteString -> ByteString
L.Chunk ByteString
t ByteString
L.Empty

instance SerializeValue Builder PDFString where
  serialize :: PDFString -> Builder
serialize (PDFString ByteString
t) = ByteString -> Builder
fromByteString ByteString
t

instance SerializeValue L.ByteString PDFGlyph where
  serialize :: PDFGlyph -> ByteString
serialize (PDFGlyph ByteString
t) = ByteString -> ByteString -> ByteString
L.Chunk ByteString
t ByteString
L.Empty


instance SerializeValue Builder EscapedPDFGlyph where
  serialize :: EscapedPDFGlyph -> Builder
serialize (EscapedPDFGlyph ByteString
t) = ByteString -> Builder
fromByteString ByteString
t

instance SerializeValue L.ByteString AsciiString where
  serialize :: AsciiString -> ByteString
serialize (AsciiString ByteString
t) = ByteString -> ByteString -> ByteString
L.Chunk ByteString
t ByteString
L.Empty

instance SerializeValue Builder EscapedAsciiString where
  serialize :: EscapedAsciiString -> Builder
serialize (EscapedAsciiString ByteString
t) = ByteString -> Builder
fromByteString ByteString
t

-- Misc strings useful to build bytestrings

lparen :: SerializeValue s Char => s
lparen :: s
lparen = Char -> s
forall s a. SerializeValue s a => a -> s
serialize Char
'('

rparen :: SerializeValue s Char => s
rparen :: s
rparen = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
')'

lbracket :: SerializeValue s Char => s
lbracket :: s
lbracket = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
'['

rbracket :: SerializeValue s Char => s
rbracket :: s
rbracket = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
']'

bspace :: SerializeValue s Char => s
bspace :: s
bspace = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
' '

blt :: SerializeValue s Char => s
blt :: s
blt = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
'<'

bgt :: SerializeValue s Char => s
bgt :: s
bgt = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
'>'

newline :: SerializeValue s Char => s
newline :: s
newline = Char -> s
forall s a. SerializeValue s a => a -> s
serialize  Char
'\n'

noPdfObject :: Monoid s => s
noPdfObject :: s
noPdfObject = s
forall a. Monoid a => a
mempty

espacePDFGlyph :: PDFGlyph -> EscapedPDFGlyph 
espacePDFGlyph :: PDFGlyph -> EscapedPDFGlyph
espacePDFGlyph (PDFGlyph ByteString
t) = ByteString -> EscapedPDFGlyph
EscapedPDFGlyph (ByteString -> EscapedPDFGlyph)
-> (ByteString -> ByteString) -> ByteString -> EscapedPDFGlyph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ByteString) -> ByteString -> ByteString
C.concatMap Char -> ByteString
escapeByteString (ByteString -> EscapedPDFGlyph) -> ByteString -> EscapedPDFGlyph
forall a b. (a -> b) -> a -> b
$ ByteString
t

espaceAsciiString :: AsciiString -> EscapedAsciiString 
espaceAsciiString :: AsciiString -> EscapedAsciiString
espaceAsciiString (AsciiString ByteString
t) = ByteString -> EscapedAsciiString
EscapedAsciiString (ByteString -> EscapedAsciiString)
-> (ByteString -> ByteString) -> ByteString -> EscapedAsciiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ByteString) -> ByteString -> ByteString
C.concatMap Char -> ByteString
escapeByteString (ByteString -> EscapedAsciiString)
-> ByteString -> EscapedAsciiString
forall a b. (a -> b) -> a -> b
$ ByteString
t
    
instance PdfObject PDFString where
  toPDF :: PDFString -> Builder
toPDF PDFString
a = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
forall s. SerializeValue s Char => s
blt
                    , ByteString -> Builder
fromByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ PDFString -> ByteString
forall a. HasHexaStream a => a -> ByteString
toHexaStream PDFString
a
                    , Builder
forall s. SerializeValue s Char => s
bgt
                    ]

instance PdfLengthInfo PDFString where

instance PdfObject PDFGlyph where
  toPDF :: PDFGlyph -> Builder
toPDF PDFGlyph
a = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
forall s. SerializeValue s Char => s
blt
                    --, serialize . espacePDFGlyph $ a 
                    , ByteString -> Builder
fromByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ PDFGlyph -> ByteString
forall a. HasHexaStream a => a -> ByteString
toHexaStream PDFGlyph
a
                    , Builder
forall s. SerializeValue s Char => s
bgt
                    ]

instance PdfLengthInfo PDFGlyph where


instance PdfLengthInfo AsciiString where

instance PdfObject AsciiString where
  toPDF :: AsciiString -> Builder
toPDF AsciiString
a = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
forall s. SerializeValue s Char => s
lparen
                    , EscapedAsciiString -> Builder
forall s a. SerializeValue s a => a -> s
serialize (EscapedAsciiString -> Builder)
-> (AsciiString -> EscapedAsciiString) -> AsciiString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsciiString -> EscapedAsciiString
espaceAsciiString (AsciiString -> Builder) -> AsciiString -> Builder
forall a b. (a -> b) -> a -> b
$ AsciiString
a 
                    , Builder
forall s. SerializeValue s Char => s
rparen
                    ]

-- | A PDFName object
newtype PDFName = PDFName String deriving(PDFName -> PDFName -> Bool
(PDFName -> PDFName -> Bool)
-> (PDFName -> PDFName -> Bool) -> Eq PDFName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFName -> PDFName -> Bool
$c/= :: PDFName -> PDFName -> Bool
== :: PDFName -> PDFName -> Bool
$c== :: PDFName -> PDFName -> Bool
Eq,Eq PDFName
Eq PDFName
-> (PDFName -> PDFName -> Ordering)
-> (PDFName -> PDFName -> Bool)
-> (PDFName -> PDFName -> Bool)
-> (PDFName -> PDFName -> Bool)
-> (PDFName -> PDFName -> Bool)
-> (PDFName -> PDFName -> PDFName)
-> (PDFName -> PDFName -> PDFName)
-> Ord PDFName
PDFName -> PDFName -> Bool
PDFName -> PDFName -> Ordering
PDFName -> PDFName -> PDFName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PDFName -> PDFName -> PDFName
$cmin :: PDFName -> PDFName -> PDFName
max :: PDFName -> PDFName -> PDFName
$cmax :: PDFName -> PDFName -> PDFName
>= :: PDFName -> PDFName -> Bool
$c>= :: PDFName -> PDFName -> Bool
> :: PDFName -> PDFName -> Bool
$c> :: PDFName -> PDFName -> Bool
<= :: PDFName -> PDFName -> Bool
$c<= :: PDFName -> PDFName -> Bool
< :: PDFName -> PDFName -> Bool
$c< :: PDFName -> PDFName -> Bool
compare :: PDFName -> PDFName -> Ordering
$ccompare :: PDFName -> PDFName -> Ordering
$cp1Ord :: Eq PDFName
Ord)

instance PdfObject PDFName where
 toPDF :: PDFName -> Builder
toPDF (PDFName String
a) = String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a)

instance PdfLengthInfo PDFName where

 
-- | A PDFArray
type PDFArray = [AnyPdfObject]

instance PdfObject a => PdfObject [a] where
    toPDF :: [a] -> Builder
toPDF [a]
l = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Builder
forall s. SerializeValue s Char => s
lbracketBuilder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
forall s. SerializeValue s Char => s
bspace ((a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall a. PdfObject a => a -> Builder
toPDF [a]
l)) [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [Builder
forall s. SerializeValue s Char => s
bspace] [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [Builder
forall s. SerializeValue s Char => s
rbracket]
       
instance PdfObject a => PdfLengthInfo [a] where

-- | A PDFDictionary

newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject)

instance PdfObject PDFDictionary where
  toPDF :: PDFDictionary -> Builder
toPDF (PDFDictionary Map PDFName AnyPdfObject
a) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder
forall s. SerializeValue s Char => s
blt,Builder
forall s. SerializeValue s Char => s
blt,Builder
forall s. SerializeValue s Char => s
newline]
                                       [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [Map PDFName AnyPdfObject -> Builder
forall p. p -> Builder
convertLevel Map PDFName AnyPdfObject
a]
                                       [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [Builder
forall s. SerializeValue s Char => s
bgt,Builder
forall s. SerializeValue s Char => s
bgt] 
   where
     convertLevel :: p -> Builder
convertLevel p
_ = let convertItem :: a -> a -> Builder -> Builder
convertItem a
key a
value Builder
current = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [ a -> Builder
forall a. PdfObject a => a -> Builder
toPDF a
key
                                                                    , Builder
forall s. SerializeValue s Char => s
bspace
                                                                    , a -> Builder
forall a. PdfObject a => a -> Builder
toPDF a
value
                                                                    , Builder
forall s. SerializeValue s Char => s
newline
                                                                    , Builder
current
                                                                    ]
                                                                       
          in 
           (PDFName -> AnyPdfObject -> Builder -> Builder)
-> Builder -> Map PDFName AnyPdfObject -> Builder
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey PDFName -> AnyPdfObject -> Builder -> Builder
forall a a.
(PdfObject a, PdfObject a) =>
a -> a -> Builder -> Builder
convertItem Builder
forall a. Monoid a => a
mempty Map PDFName AnyPdfObject
a
  
instance PdfLengthInfo PDFDictionary where

-- | Am empty dictionary
emptyDictionary :: PDFDictionary
emptyDictionary :: PDFDictionary
emptyDictionary = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary Map PDFName AnyPdfObject
forall k a. Map k a
M.empty
           
isEmptyDictionary :: PDFDictionary -> Bool
isEmptyDictionary :: PDFDictionary -> Bool
isEmptyDictionary (PDFDictionary Map PDFName AnyPdfObject
d) = Map PDFName AnyPdfObject -> Bool
forall k a. Map k a -> Bool
M.null Map PDFName AnyPdfObject
d

insertInPdfDict :: PDFName -> AnyPdfObject -> PDFDictionary -> PDFDictionary
insertInPdfDict :: PDFName -> AnyPdfObject -> PDFDictionary -> PDFDictionary
insertInPdfDict PDFName
key AnyPdfObject
obj (PDFDictionary Map PDFName AnyPdfObject
d) = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> Map PDFName AnyPdfObject -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ PDFName
-> AnyPdfObject
-> Map PDFName AnyPdfObject
-> Map PDFName AnyPdfObject
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PDFName
key AnyPdfObject
obj Map PDFName AnyPdfObject
d

pdfDictUnion :: PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion :: PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion (PDFDictionary Map PDFName AnyPdfObject
a) (PDFDictionary Map PDFName AnyPdfObject
b) = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> Map PDFName AnyPdfObject -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ Map PDFName AnyPdfObject
-> Map PDFName AnyPdfObject -> Map PDFName AnyPdfObject
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map PDFName AnyPdfObject
a Map PDFName AnyPdfObject
b

  
-- | A PDF rectangle
data PDFRect = PDFRect !Double !Double !Double !Double
  
instance PdfObject PDFRect where
 toPDF :: PDFRect -> Builder
toPDF (PDFRect PDFFloat
a PDFFloat
b PDFFloat
c PDFFloat
d) = [AnyPdfObject] -> Builder
forall a. PdfObject a => a -> Builder
toPDF ([AnyPdfObject] -> Builder)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> Builder) -> [PDFFloat] -> Builder
forall a b. (a -> b) -> a -> b
$ [PDFFloat
a,PDFFloat
b,PDFFloat
c,PDFFloat
d]
 
instance PdfLengthInfo PDFRect where

      
-- | A Referenced objects
data PDFReferencedObject a = PDFReferencedObject !Int !a

instance PdfObject a => PdfObject (PDFReferencedObject a) where
  toPDF :: PDFReferencedObject a -> Builder
toPDF (PDFReferencedObject Int
referenceId a
obj) =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat  ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Builder) -> (Int -> String) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Int
referenceId
               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String
" 0 obj" :: String)
               , Builder
forall s. SerializeValue s Char => s
newline
               , a -> Builder
forall a. PdfObject a => a -> Builder
toPDF a
obj
               , Builder
forall s. SerializeValue s Char => s
newline
               , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String
"endobj" :: String)
               , Builder
forall s. SerializeValue s Char => s
newline , Builder
forall s. SerializeValue s Char => s
newline
               ]

instance PdfObject a => PdfLengthInfo (PDFReferencedObject a) where

               
-- | A reference to a PDF object
data PDFReference s = PDFReference !Int deriving(PDFReference s -> PDFReference s -> Bool
(PDFReference s -> PDFReference s -> Bool)
-> (PDFReference s -> PDFReference s -> Bool)
-> Eq (PDFReference s)
forall s. PDFReference s -> PDFReference s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFReference s -> PDFReference s -> Bool
$c/= :: forall s. PDFReference s -> PDFReference s -> Bool
== :: PDFReference s -> PDFReference s -> Bool
$c== :: forall s. PDFReference s -> PDFReference s -> Bool
Eq,Eq (PDFReference s)
Eq (PDFReference s)
-> (PDFReference s -> PDFReference s -> Ordering)
-> (PDFReference s -> PDFReference s -> Bool)
-> (PDFReference s -> PDFReference s -> Bool)
-> (PDFReference s -> PDFReference s -> Bool)
-> (PDFReference s -> PDFReference s -> Bool)
-> (PDFReference s -> PDFReference s -> PDFReference s)
-> (PDFReference s -> PDFReference s -> PDFReference s)
-> Ord (PDFReference s)
PDFReference s -> PDFReference s -> Bool
PDFReference s -> PDFReference s -> Ordering
PDFReference s -> PDFReference s -> PDFReference s
forall s. Eq (PDFReference s)
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 s. PDFReference s -> PDFReference s -> Bool
forall s. PDFReference s -> PDFReference s -> Ordering
forall s. PDFReference s -> PDFReference s -> PDFReference s
min :: PDFReference s -> PDFReference s -> PDFReference s
$cmin :: forall s. PDFReference s -> PDFReference s -> PDFReference s
max :: PDFReference s -> PDFReference s -> PDFReference s
$cmax :: forall s. PDFReference s -> PDFReference s -> PDFReference s
>= :: PDFReference s -> PDFReference s -> Bool
$c>= :: forall s. PDFReference s -> PDFReference s -> Bool
> :: PDFReference s -> PDFReference s -> Bool
$c> :: forall s. PDFReference s -> PDFReference s -> Bool
<= :: PDFReference s -> PDFReference s -> Bool
$c<= :: forall s. PDFReference s -> PDFReference s -> Bool
< :: PDFReference s -> PDFReference s -> Bool
$c< :: forall s. PDFReference s -> PDFReference s -> Bool
compare :: PDFReference s -> PDFReference s -> Ordering
$ccompare :: forall s. PDFReference s -> PDFReference s -> Ordering
$cp1Ord :: forall s. Eq (PDFReference s)
Ord,Int -> PDFReference s -> ShowS
[PDFReference s] -> ShowS
PDFReference s -> String
(Int -> PDFReference s -> ShowS)
-> (PDFReference s -> String)
-> ([PDFReference s] -> ShowS)
-> Show (PDFReference s)
forall s. Int -> PDFReference s -> ShowS
forall s. [PDFReference s] -> ShowS
forall s. PDFReference s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDFReference s] -> ShowS
$cshowList :: forall s. [PDFReference s] -> ShowS
show :: PDFReference s -> String
$cshow :: forall s. PDFReference s -> String
showsPrec :: Int -> PDFReference s -> ShowS
$cshowsPrec :: forall s. Int -> PDFReference s -> ShowS
Show)

-- | Get the reference value
referenceValue :: PDFReference s -> Int
referenceValue :: PDFReference s -> Int
referenceValue (PDFReference Int
i) = Int
i

instance PdfObject s => Num (PDFReference s) where
  + :: PDFReference s -> PDFReference s -> PDFReference s
(+) (PDFReference Int
a) (PDFReference Int
b) = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b)
  * :: PDFReference s -> PDFReference s -> PDFReference s
(*) (PDFReference Int
a) (PDFReference Int
b) = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
b)
  negate :: PDFReference s -> PDFReference s
negate (PDFReference Int
a) = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference (Int -> Int
forall a. Num a => a -> a
negate Int
a)
  abs :: PDFReference s -> PDFReference s
abs (PDFReference Int
a) = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference (Int -> Int
forall a. Num a => a -> a
abs Int
a)
  signum :: PDFReference s -> PDFReference s
signum (PDFReference Int
a) = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference (Int -> Int
forall a. Num a => a -> a
signum Int
a)
  fromInteger :: Integer -> PDFReference s
fromInteger Integer
a = Int -> PDFReference s
forall s. Int -> PDFReference s
PDFReference (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
a)

instance PdfObject s => PdfObject (PDFReference s) where
  toPDF :: PDFReference s -> Builder
toPDF (PDFReference Int
i) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Builder) -> (Int -> String) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Int
i
                                     , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String
" 0 R" :: String)]
                                      
                                   
instance PdfObject s => PdfLengthInfo (PDFReference s) where
               
instance (PdfObject a,PdfObject b) => PdfObject (Either a b) where
  toPDF :: Either a b -> Builder
toPDF (Left a
a) = a -> Builder
forall a. PdfObject a => a -> Builder
toPDF a
a
  toPDF (Right b
a) = b -> Builder
forall a. PdfObject a => a -> Builder
toPDF b
a

instance (PdfObject a, PdfObject b) => PdfLengthInfo (Either a b) where

modifyStrict :: (MonadState s m) => (s -> s) -> m ()
modifyStrict :: (s -> s) -> m ()
modifyStrict s -> s
f = do
   s
s <- m s
forall s (m :: * -> *). MonadState s m => m s
get
   s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (s -> m ()) -> s -> m ()
forall a b. (a -> b) -> a -> b
$! (s -> s
f s
s)

-- | A monad where paths can be created
class MonadWriter Builder m => MonadPath m

{-

Font types

-}

data EmbeddedFont 


instance PdfObject EmbeddedFont where
  toPDF :: EmbeddedFont -> Builder
toPDF EmbeddedFont
_ = Builder
forall a. Monoid a => a
noPdfObject

instance PdfLengthInfo EmbeddedFont where