--------------------------------------------------------- -- | -- Copyright : (c) alpha 2006 -- 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 as M import Data.List(intersperse) import Data.Int import Text.Printf import Control.Monad.State import Control.Monad.Writer import Data.Encoding import Data.Encoding.ISO88591 import System.Random import Data.Binary.Builder(Builder,fromByteString) import Graphics.PDF.LowLevel.Serializer import Data.Monoid import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as S import Data.ByteString.Base(LazyByteString(..)) -- | PDF Objects class PdfObject a where toPDF :: a -> Builder -- | Anonymous PDF object data AnyPdfObject = forall a . PdfObject a => AnyPdfObject a instance PdfObject AnyPdfObject where toPDF (AnyPdfObject a) = toPDF a -- | An integer in a PDF document newtype PDFInteger = PDFInteger Int deriving(Eq,Show,Ord,Num) -- | A length in a PDF document data PDFLength = PDFLength Int64 deriving(Eq,Show,Ord) instance Num PDFLength where (+) (PDFLength a) (PDFLength b) = PDFLength (a+b) (*) (PDFLength a) (PDFLength b) = PDFLength (a*b) negate (PDFLength a) = PDFLength (negate a) abs (PDFLength a) = PDFLength (abs a) signum (PDFLength a) = PDFLength (signum a) fromInteger a = PDFLength (fromInteger a) -- | A real number in a PDF document newtype PDFFloat = PDFFloat Double deriving(Eq,Ord,Num,Fractional,Floating,RealFrac,Real,Random) instance Show PDFFloat where show (PDFFloat x) = printf "%.5f" x instance PdfObject PDFInteger where toPDF (PDFInteger a) = serialize a instance PdfObject Int where toPDF a = serialize a instance PdfObject PDFLength where toPDF (PDFLength a) = serialize (show a) instance PdfObject PDFFloat where toPDF (PDFFloat a) = serialize a instance PdfObject Double where toPDF a = serialize a instance PdfObject Bool where toPDF (True) = serialize "true" toPDF (False) = serialize "false" -- | A PDFString containing a strict bytestring newtype PDFString = PDFString S.ByteString deriving(Eq,Ord,Show) -- | Create a PDF string from an Haskell one toPDFString :: String -> PDFString toPDFString = PDFString . encode ISO88591 . escapeString instance SerializeValue B.ByteString PDFString where serialize (PDFString t) = LPS [t] instance SerializeValue Builder PDFString where serialize (PDFString t) = fromByteString t -- | Escape PDF characters which have a special meaning escapeString :: String -> String escapeString [] = [] escapeString ('(':l) = '\\':'(':escapeString l escapeString (')':l) = '\\':')':escapeString l escapeString ('\\':l) = '\\':'\\':escapeString l escapeString (a:l) = a:escapeString l -- Misc strings useful to build bytestrings lparen :: SerializeValue s Char => s lparen = serialize '(' rparen :: SerializeValue s Char => s rparen = serialize ')' lbracket :: SerializeValue s Char => s lbracket = serialize '[' rbracket :: SerializeValue s Char => s rbracket = serialize ']' bspace :: SerializeValue s Char => s bspace = serialize ' ' blt :: SerializeValue s Char => s blt = serialize '<' bgt :: SerializeValue s Char => s bgt = serialize '>' newline :: SerializeValue s Char => s newline = serialize '\n' noPdfObject :: Monoid s => s noPdfObject = mempty instance PdfObject PDFString where toPDF a = mconcat [ lparen , serialize a , rparen ] -- | A PDFName object newtype PDFName = PDFName String deriving(Eq,Ord) instance PdfObject PDFName where toPDF (PDFName a) = serialize ("/" ++ a) -- | A PDFArray type PDFArray = [AnyPdfObject] instance PdfObject a => PdfObject [a] where toPDF l = mconcat $ (lbracket:intersperse bspace (map toPDF l)) ++ [bspace] ++ [rbracket] -- | A PDFDictionary newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject) instance PdfObject PDFDictionary where toPDF (PDFDictionary a) = mconcat $ [blt,blt,newline] ++ [convertLevel a] ++ [bgt,bgt] where convertLevel _ = let convertItem key value current = mconcat $ [ toPDF key , bspace , toPDF value , newline , current ] in M.foldWithKey convertItem mempty a -- | Am empty dictionary emptyDictionary :: PDFDictionary emptyDictionary = PDFDictionary M.empty isEmptyDictionary :: PDFDictionary -> Bool isEmptyDictionary (PDFDictionary d) = M.null d insertInPdfDict :: PDFName -> AnyPdfObject -> PDFDictionary -> PDFDictionary insertInPdfDict key obj (PDFDictionary d) = PDFDictionary $ M.insert key obj d pdfDictUnion :: PDFDictionary -> PDFDictionary -> PDFDictionary pdfDictUnion (PDFDictionary a) (PDFDictionary b) = PDFDictionary $ M.union a b -- | A PDF rectangle data PDFRect = PDFRect !Int !Int !Int !Int instance PdfObject PDFRect where toPDF (PDFRect a b c d) = toPDF . map (AnyPdfObject . PDFInteger) $ [a,b,c,d] -- | A Referenced objects data PDFReferencedObject a = PDFReferencedObject !Int !a instance PdfObject a => PdfObject (PDFReferencedObject a) where toPDF (PDFReferencedObject referenceId obj) = mconcat $ [ serialize . show $ referenceId , serialize " 0 obj" , newline , toPDF obj , newline , serialize "endobj" , newline , newline ] -- | A reference to a PDF object data PDFReference s = PDFReference !Int deriving(Eq,Ord,Show) -- | Get the reference value referenceValue :: PDFReference s -> Int referenceValue (PDFReference i) = i instance PdfObject s => Num (PDFReference s) where (+) (PDFReference a) (PDFReference b) = PDFReference (a+b) (*) (PDFReference a) (PDFReference b) = PDFReference (a*b) negate (PDFReference a) = PDFReference (negate a) abs (PDFReference a) = PDFReference (abs a) signum (PDFReference a) = PDFReference (signum a) fromInteger a = PDFReference (fromInteger a) instance PdfObject s => PdfObject (PDFReference s) where toPDF (PDFReference i) = mconcat $ [ serialize . show $ i , serialize " 0 R"] instance (PdfObject a,PdfObject b) => PdfObject (Either a b) where toPDF (Left a) = toPDF a toPDF (Right a) = toPDF a modifyStrict :: (MonadState s m) => (s -> s) -> m () modifyStrict f = do s <- get put $! (f s) -- | A monad where paths can be created class MonadWriter Builder m => MonadPath m