diff --git a/Graphics/PDF.hs b/Graphics/PDF.hs --- a/Graphics/PDF.hs +++ b/Graphics/PDF.hs @@ -1,66 +1,221 @@ --------------------------------------------------------- -- | --- Copyright : (c) alpha 2006 +-- Copyright : (c) alpheccar 2007 -- License : BSD-style -- -- Maintainer : misc@NOSPAMalpheccar.org -- Stability : experimental -- Portability : portable -- --- PDF API for Haskell +-- Generation of PDF documents --------------------------------------------------------- module Graphics.PDF - (-- * HPDF - -- ** The PDF type - PDF - -- ** PDF Operator used to build a PDF document (in addition to the Monoid ones) - ,withContext, (<>), emptyPdf, PdfCmd - -- ** PDF Transformations - , module Graphics.PDF.Geometry - -- ** PDF Text - , module Graphics.PDF.Text - -- ** PDF Shapes - , module Graphics.PDF.Shape - -- ** PDF Colors - , module Graphics.PDF.Color - -- ** PDF Shadings - , module Graphics.PDF.Shading - -- ** PDF Font - , module Graphics.PDF.Font - -- ** PDF File - , module Graphics.PDF.File - -- * Example - -- $example + ( + -- * HPDF + -- ** PDF Monad + PDF + , runPdf + -- ** PDF Common Types + , PDFRect(..) + , PDFFloat(..) + , PDFReference + , PDFString + , PDFPage + , Pages + -- ** Document management + , module Graphics.PDF.Document + -- ** Drawing + , module Graphics.PDF.Shapes + -- ** Colors + , module Graphics.PDF.Colors + -- ** Geometry + , module Graphics.PDF.Coordinates + -- ** Text + , module Graphics.PDF.Text + -- ** Navigation + , module Graphics.PDF.Navigation + -- ** Annotations + , module Graphics.PDF.Annotation + -- ** Actions + , module Graphics.PDF.Action + -- ** Images + , module Graphics.PDF.Image + -- ** Patterns + , module Graphics.PDF.Pattern + -- ** Shading + , module Graphics.PDF.Shading ) where - - -import Graphics.PDF.LowLevel -import Graphics.PDF.Geometry -import Graphics.PDF.Shape -import Graphics.PDF.Color + import Graphics.PDF.Shading -import Graphics.PDF.File +import Graphics.PDF.Pattern +import Graphics.PDF.Navigation import Graphics.PDF.Text -import Graphics.PDF.Font +import qualified Data.IntMap as IM +import qualified Data.Map as M +import qualified Data.ByteString.Lazy as B +import Data.Int +import System.IO +import Control.Exception(bracket) +import Text.Printf(printf) +import Control.Monad.State +import Graphics.PDF.Annotation +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import Graphics.PDF.Colors +import Graphics.PDF.Shapes +import Graphics.PDF.Coordinates +import Graphics.PDF.Pages +import Graphics.PDF.Document +import Codec.Compression.Zlib +import Graphics.PDF.Action +import Graphics.PDF.Image +import Graphics.PDF.Resources(emptyResource) +-- | Create a new PDF document and return a first page +-- The page is using the document size by default +createPDF :: PDF () +createPDF = do + -- Create the Proc structure + --proc <- addObject PDFProc + -- Create an empty resource + --addObject $ PDFResource proc + return () + +-- Create the PDF stream objects from the draw monads +createStreams :: [(Int, (Maybe (PDFReference PDFPage),Draw ()))] -> PDF () +createStreams l = mapM_ addStream l + where + addStream (k,(p,d)) = do + -- New reference for the stream + r <- supply + -- Run the drawing and get the new state (resource, annotation) + myBounds <- gets xobjectBound + cp <- gets currentPage + let (_,state',w') = runDrawing d (emptyEnvironment {streamId = r, xobjectb = myBounds, currentp = maybe Nothing (\(PDFReference x) -> Just x) cp }) + ref = PDFReference r :: PDFReference PDFLength + + -- Pattern NEEDS a resource entry even if empty otherwise don't work with acrobat reader + -- Image DON'T want a resource entry if empty otherwise don't work with apple reader + resources <- if (emptyResource (rsrc state')) && (not (pdfDictMember (PDFName "PatternType") (otherRsrcs state'))) + then do + case p of + -- Not linked to a page + -- otherResource are entries specific to a special stream (like an XObject) so we return empty for a page + Nothing -> return (otherRsrcs state') + -- Linked to a page + Just pageRef -> do + setPageAnnotations (annots state') pageRef + return emptyDictionary + -- Some resource are needed by the stream + else do + rsrcRef <- addObject (rsrc state') + case p of + -- Not linked to a page + Nothing -> do + return $ (otherRsrcs state') `pdfDictUnion` (PDFDictionary . M.fromList $ [(PDFName "Resources",AnyPdfObject rsrcRef)]) + -- Linked to a page + Just pageRef -> do + setPageAnnotations (annots state') pageRef + setPageResource rsrcRef pageRef + return emptyDictionary + + infos <- gets docInfo + -- Resources to add to the stream + -- We compress only if the stream is not using its own filter + if (compressed infos) && (not (pdfDictMember (PDFName "Filter") resources)) + then do + let w'' = compress w' + updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w'' True ref resources) + updateObject ref (PDFLength (B.length w'')) + else do + updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w' False ref resources) + updateObject ref (PDFLength (B.length w')) --- $example --- > test :: IO () --- > test = let document = rgbSpace <> --- > chooseFont Helvetica 70 <> --- > applyMatrix (translate 50 0) <> --- > applyMatrix (rotate (Degree 45)) <> --- > clipText 0 0 "HPDF" <> --- > applyMatrix (rotate (Degree (-45))) <> --- > applyMatrix (translate (-50) 0) <> --- > fillColor (Rgb 0 0 1) <> --- > fillRectangle 0 0 100 100 <> --- > fillColor (Rgb 1 0 0) <> --- > setAlpha 0.4 <> --- > fillRectangle 50 50 100 100 <> --- > resetAlpha <> --- > fillColor (Rgb 0 1 0) <> --- > fillRectangle 80 80 100 100 <> --- > emptyPdf 180 180 --- > in --- > writePdf "test.pdf" document +-- | Save all the pages and streams in the main object dictionary +saveObjects :: PDF (PDFReference PDFCatalog) +saveObjects = do + ls <- gets streams + createStreams . IM.toList $ ls + infos <- gets docInfo + -- Save pages and streams to the object dictionary so that they are saved in the PDF document + pRef <- addPages + -- Create outlines object + o <- gets outline + oref <- addOutlines o + -- Create the catalog + cat <- addObject $ PDFCatalog oref pRef (pageMode infos) (pageLayout infos) (viewerPreferences infos) + modify $ \s -> s {catalog = cat} + gets catalog + +-- | Write PDF objects in the TOC +writeObjectsAndCreateToc :: Handle -- ^ File handle + -> [B.ByteString] -- ^ List of objects each object being already converted to a bytestring + -> IO (Int,Int64,[B.ByteString]) +writeObjectsAndCreateToc h l = foldM writeObject (0,0::Int64,[]) l where + writeObject (nb,len,toc) obj = do + -- Write the object to the file + B.hPut h obj + -- Remember the position + return (nb+1,len + B.length obj,(toByteString (printf "%010d 00000 n \n" ((fromIntegral len)::Integer))) : toc) + +withFile :: FilePath -> (Handle -> IO c) -> IO c +withFile name = bracket (openBinaryFile name WriteMode) hClose + +-- | The PDFTrailer +#ifndef __HADDOCK__ +data PDFTrailer = PDFTrailer + !Int -- ^ Number of PDF objects in the document + !(PDFReference PDFCatalog) -- ^ Reference to the PDf catalog + !(PDFDocumentInfo) +#else +data PDFTrailer +#endif + +instance PdfObject PDFTrailer where + toPDF (PDFTrailer size root infos) = toPDF $ PDFDictionary. M.fromList $ + [ (PDFName "Size",AnyPdfObject . PDFInteger $ size) + , (PDFName "Root",AnyPdfObject root) + , (PDFName "Info",AnyPdfObject . PDFDictionary . M.fromList $ allInfos) + ] + where + allInfos = [ (PDFName "Author",AnyPdfObject . author $ infos) + , (PDFName "Subject",AnyPdfObject . subject $ infos) + ] + +-- | Generates a PDF document +runPdf :: String -- ^ Name of the PDF document + -> PDFDocumentInfo + -> PDFRect -- ^ Default size for a page + -> PDF a -- ^ PDF action + -> IO () +runPdf filename infos rect m = do + (root,s) <- flip runStateT vars . unPDF $ createPDF >> m >> saveObjects + let header = toByteString "%PDF-1.5\n" + objs = objects s + withFile filename $ \h -> do + (nb,len,toc) <- writeObjectsAndCreateToc h $ header : (map (toPDF . pointer) . IM.toAscList $ objs) + B.hPut h . toByteString $ "xref\n" + B.hPut h . toByteString $ "0 " ++ show nb ++ "\n" + B.hPut h . toByteString $ "0000000000 65535 f \n" + B.hPut h . B.concat . tail . reverse $ toc + B.hPut h . toByteString $ "\ntrailer\n" + B.hPut h . toPDF $ PDFTrailer nb root infos + B.hPut h . toByteString $ "\nstartxref\n" + B.hPut h . toByteString $ (show len) + B.hPut h . toByteString $ "\n%%EOF" + where + pointer (x,a) = PDFReferencedObject (fromIntegral x) a + vars = PdfState { + supplySrc = 1 + , objects = IM.empty + , pages = noPages + , streams = IM.empty + , catalog = PDFReference 0 + , defaultRect = rect + , docInfo = infos + , outline = Nothing + , currentPage = Nothing + , xobjectBound = IM.empty + , firstOutline = [True] + } + diff --git a/Graphics/PDF/Action.hs b/Graphics/PDF/Action.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Action.hs @@ -0,0 +1,73 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Actions +--------------------------------------------------------- + +module Graphics.PDF.Action( + -- * Actions + -- ** Types + Action + , GoToURL(..) + -- ** Functions + ) where + +import Graphics.PDF.LowLevel.Types +import qualified Data.Map as M + + +-- Media action +--data MediaAction = Play +-- | Stop +-- | Pause +-- | Resume +-- deriving(Enum) + +class PdfObject a => Action a + +-- | Action of going to an URL +newtype GoToURL = GoToURL String + +--data Rendition = Rendition +--instance PdfObject Rendition where +-- toPDF a = toPDF . PDFDictionary . M.fromList $ +-- [ (PDFName "Type",AnyPdfObject . PDFName $ "Rendition") +-- , (PDFName "S",AnyPdfObject . PDFName $ "MR") +-- , (PDFName "C",AnyPdfObject movie) +-- ] +-- where +-- movie = PDFDictionary . M.fromList $ +-- [ (PDFName "Type",AnyPdfObject . PDFName $ "MediaClip") +-- , (PDFName "S",AnyPdfObject . PDFName $ "MCD") +-- , (PDFName "CT",AnyPdfObject . toPDFString $ "video/3gpp") +-- , (PDFName "D",AnyPdfObject (toPDFString "17.3gp")) +-- ] + +-- Action to control a media +--data ControlMedia = ControlMedia MediaAction Int (PDFReference Rendition) + +instance PdfObject GoToURL where + toPDF (GoToURL s) = toPDF . PDFDictionary . M.fromList $ + [ (PDFName "Type",AnyPdfObject . PDFName $ "Action") + , (PDFName "S",AnyPdfObject (PDFName "URI")) + , (PDFName "URI",AnyPdfObject (toPDFString s)) + ] +instance Action GoToURL + + +--instance PdfObject ControlMedia where +-- toPDF (ControlMedia operation relatedScreenAnnotation rendition) = toPDF . PDFDictionary . M.fromList $ +-- [ (PDFName "Type",AnyPdfObject . PDFName $ "Action") +-- , (PDFName "S",AnyPdfObject (PDFName "Rendition")) +-- , (PDFName "R",AnyPdfObject rendition) +-- , (PDFName "OP",AnyPdfObject . PDFInteger $ (fromEnum operation)) +-- , (PDFName "AN",AnyPdfObject $ (PDFReference relatedScreenAnnotation :: PDFReference AnyPdfObject)) +-- ] +-- +--instance Action ControlMedia diff --git a/Graphics/PDF/Annotation.hs b/Graphics/PDF/Annotation.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Annotation.hs @@ -0,0 +1,122 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Annotations +--------------------------------------------------------- + +module Graphics.PDF.Annotation( + -- * Annotations + -- ** Types + TextAnnotation(..) + , URLLink(..) + , PDFLink(..) + , TextIcon(..) + -- ** Functions + , newAnnotation + ) where + +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import qualified Data.Map as M +import Graphics.PDF.Action +import Graphics.PDF.Pages + +data TextIcon = Note + | Paragraph + | NewParagraph + | Key + | Comment + | Help + | Insert + deriving(Eq,Show) + + +data TextAnnotation = TextAnnotation PDFString [PDFFloat] TextIcon +data URLLink = URLLink PDFString [PDFFloat] String Bool +data PDFLink = PDFLink PDFString [PDFFloat] (PDFReference PDFPage) PDFFloat PDFFloat Bool +--data Screen = Screen (PDFReference Rendition) PDFString [PDFFloat] (PDFReference PDFPage) (Maybe (PDFReference ControlMedia)) (Maybe (PDFReference ControlMedia)) + +-- | Get the border shqpe depending on the style +getBorder :: Bool -> [PDFInteger] +getBorder False = [0,0,0] +getBorder True = [0,0,1] + +standardAnnotationDict :: AnnotationObject a => a -> [(PDFName,AnyPdfObject)] +standardAnnotationDict a = [(PDFName "Type",AnyPdfObject . PDFName $ "Annot") + , (PDFName "Subtype",AnyPdfObject $ annotationType a) + , (PDFName "Rect",AnyPdfObject . map AnyPdfObject $ annotationRect a) + , (PDFName "Contents",AnyPdfObject $ annotationContent a) + ] + +--instance PdfObject Screen where +-- toPDF a@(Screen _ _ _ p play stop) = toPDF . PDFDictionary . M.fromList $ +-- standardAnnotationDict a ++ [(PDFName "P",AnyPdfObject p)] +-- ++ (maybe [] (\x -> [(PDFName "A",AnyPdfObject x)]) play) +-- ++ (maybe [] (\x -> [(PDFName "AA",AnyPdfObject $ otherActions x)]) stop) +-- where +-- otherActions x = PDFDictionary . M.fromList $ [(PDFName "D",AnyPdfObject x)] +-- +--instance AnnotationObject Screen where +-- addAnnotation (Screen video s rect p _ _) = do +-- r <- supply +-- playAction <- addObject $ ControlMedia Play r video +-- stopAction <- addObject $ ControlMedia Stop r video +-- updateObject (PDFReference r) $ Screen video s rect p (Just playAction) (Just playAction) +-- return $ PDFReference r +-- annotationType _ = PDFName "Screen" +-- annotationContent (Screen _ s _ _ _ _) = s +-- annotationRect (Screen _ _ r _ _ _) = r + +instance PdfObject TextAnnotation where + toPDF a@(TextAnnotation _ _ i) = toPDF . PDFDictionary . M.fromList $ + standardAnnotationDict a ++ [(PDFName "Name",AnyPdfObject . PDFName $ show i)] + +instance AnnotationObject TextAnnotation where + addAnnotation = addObject + annotationType _ = PDFName "Text" + annotationContent (TextAnnotation s _ _) = s + annotationRect (TextAnnotation _ r _) = r + +instance PdfObject URLLink where + toPDF a@(URLLink _ _ url border) = toPDF . PDFDictionary . M.fromList $ + standardAnnotationDict a ++ + [ (PDFName "A",AnyPdfObject (GoToURL url)) + , (PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border)) + ] + +instance AnnotationObject URLLink where + addAnnotation = addObject + annotationType _ = PDFName "Link" + annotationContent (URLLink s _ _ _) = s + annotationRect (URLLink _ r _ _) = r + +instance PdfObject PDFLink where + toPDF a@(PDFLink _ _ page x y border) = toPDF . PDFDictionary . M.fromList $ + standardAnnotationDict a ++ + [(PDFName "Dest",AnyPdfObject dest) + ,(PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))] + where + dest = [ AnyPdfObject page + , AnyPdfObject (PDFName "XYZ") + , AnyPdfObject x + , AnyPdfObject y + , AnyPdfObject (PDFInteger 0)] + + +instance AnnotationObject PDFLink where + addAnnotation = addObject + annotationType _ = PDFName "Link" + annotationContent (PDFLink s _ _ _ _ _) = s + annotationRect (PDFLink _ r _ _ _ _) = r + +-- | Create a new annotation object +newAnnotation :: (PdfObject a, AnnotationObject a) => a -> Draw () +newAnnotation annot = do + modifyStrict $ \s -> s {annots = (AnyAnnotation annot):(annots s)} + return () diff --git a/Graphics/PDF/Color.hs b/Graphics/PDF/Color.hs deleted file mode 100644 --- a/Graphics/PDF/Color.hs +++ /dev/null @@ -1,60 +0,0 @@ --- | Functions used to control the colors in a PDF document - -module Graphics.PDF.Color - (-- * Colors - -- ** Data types - Color(..) - -- ** Operators - , strokeColor,fillColor,rgbSpace, setAlpha,resetAlpha - ) - where - -import Graphics.PDF.LowLevel -import Text.Printf - --- | Color data type -data Color = Rgb Float Float Float -- ^ RGB Color - -instance Show Color where - show (Rgb r g b) = "rgb" ++ (show r) ++ (show g) ++ (show b) - --- | Create a new state dictionary for an alpha value -newState :: Float -> PdfObject -newState a = pdfDictionary [("Type",PdfName "ExtGState"), - ("CA",PdfFloat a), - ("ca",PdfFloat a) - ] - - - --- | Change the stroke color in a PDF document -strokeColor :: Color -> PdfCmd -strokeColor c = case c of - Rgb r g b -> (PdfSC r g b,[]) - - - --- | Change the fill color in a PDF document -fillColor :: Color -> PdfCmd -fillColor c = case c of - Rgb r g b -> (PdfSF r g b,[]) - - --- | Change the alpha setting for transparency in the document -setAlpha :: Float -> PdfCmd -setAlpha a = (PdfAlpha dictName,[(PdfState,dictName,PdfUnknownPointer dictName), - (PdfAnyObject,dictName,newState a)]) - where - dictName = printf "alpha%f" a - - - --- | Reset alpha value to opaque for stroke and fill colors -resetAlpha :: PdfCmd -resetAlpha = (PdfResetAlpha,[]) - --- | Set color space to RGB. Must always be used before starting to use any color. -rgbSpace :: PdfCmd -rgbSpace = (PdfRgbSpace,[]) - - diff --git a/Graphics/PDF/Colors.hs b/Graphics/PDF/Colors.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Colors.hs @@ -0,0 +1,93 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- Colors for a PDF document +--------------------------------------------------------- +module Graphics.PDF.Colors( + -- * Colors + -- ** Types + Color(..) + -- ** Functions + , setRGBColorSpace + , fillColor + , strokeColor + , setStrokeAlpha + , setFillAlpha + , hsvToRgb + -- ** Some colors + , black + , white + , red + , blue + , green + ) where + +import Graphics.PDF.Draw +import Graphics.PDF.LowLevel.Types +import Control.Monad.State(gets) +import Graphics.PDF.Resources + + +black :: Color +black = Rgb 0 0 0 + +white :: Color +white = Rgb 1 1 1 + +red :: Color +red = Rgb 1 0 0 + +green :: Color +green = Rgb 0 1 0 + +blue :: Color +blue = Rgb 0 0 1 + + + +-- | Set alpha value for transparency +setStrokeAlpha :: Double -> Draw () +setStrokeAlpha alpha = do + alphaMap <- gets strokeAlphas + (newName,newMap) <- setResource "ExtGState" (StrokeAlpha alpha) alphaMap + modifyStrict $ \s -> s { strokeAlphas = newMap } + writeCmd ("\n/" ++ newName ++ " gs") + +-- | Set alpha value for transparency +setFillAlpha :: Double -> Draw () +setFillAlpha alpha = do + alphaMap <- gets fillAlphas + (newName,newMap) <- setResource "ExtGState" (FillAlpha alpha) alphaMap + modifyStrict $ \s -> s { fillAlphas = newMap } + writeCmd ("\n/" ++ newName ++ " gs") + +-- | Init the PDF color space to RGB. +setRGBColorSpace :: Draw () +setRGBColorSpace = writeCmd "\n/DeviceRGB CS\n/DeviceRGB cs\n" + + + +-- | Select the filling color +fillColor :: MonadPath m => Color -- ^ Filling color + -> m () +fillColor (Rgb r g b) = do + writeCmd $ "\n" ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ " rg" +fillColor (Hsv h s v) = do + let (r,g,b) = hsvToRgb (h,s,v) + writeCmd $ "\n" ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ " rg" + +-- | Select the drawing color +strokeColor :: MonadPath m => Color -- ^ Drawing color + -> m () +strokeColor (Rgb r g b) = do + writeCmd $ "\n" ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ " RG" +strokeColor (Hsv h s v) = do + let (r,g,b) = hsvToRgb (h,s,v) + writeCmd $ "\n" ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ " RG" + diff --git a/Graphics/PDF/Coordinates.hs b/Graphics/PDF/Coordinates.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Coordinates.hs @@ -0,0 +1,90 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- Coordinates for a PDF document +--------------------------------------------------------- + +module Graphics.PDF.Coordinates( + -- * Geometry + -- ** Types + Angle(..) + , Matrix(..) + -- ** Transformations + , rotate, translate, scale, identity + -- ** Frame of reference operators + , applyMatrix + ) + where + +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw + +-- | Angle +data Angle = Degree PDFFloat -- ^ Angle in degrees + | Radian PDFFloat -- ^ Angle in radians + +-- | A transformation matrix. An affine transformation a b c d e f +-- +-- @ +-- a b e +-- c d f +-- 0 0 1 +-- @ + +data Matrix = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat deriving (Eq) + +-- | Identity matrix +identity :: Matrix +identity = Matrix 1.0 0 0 1.0 0 0 + +instance Show Matrix where + show (Matrix ma mb mc md me mf) = "Matrix " ++ (unwords [(show ma),(show mb),(show mc),(show md),(show me),(show mf)]) + +instance Num Matrix where + -- Matrix addition + (+) (Matrix ma mb mc md me mf ) (Matrix na nb nc nd ne nf) = + Matrix (ma+na) (mb+nb) (mc+nc) (md+nd) (me+ne) (mf+nf) + (*) (Matrix ma mb mc md me mf) (Matrix na nb nc nd ne nf) = + Matrix (ma*na+mb*nc) (ma*nb + mb*nd ) (mc*na+md*nc) (mc*nb +md*nd) (me*na+mf*nc+ne) (me*nb+mf*nd+nf) + negate (Matrix ma mb mc md me mf ) = + Matrix (-ma) (-mb) (-mc) (-md) (-me) (-mf) + abs m = m + signum _ = identity + fromInteger i = Matrix r 0 0 r 0 0 + where + r = fromInteger i + + +-- | Apply a transformation matrix to the current coordinate frame +applyMatrix :: Matrix -> Draw () +applyMatrix (Matrix a b c d e f) = + writeCmd $ "\n" ++ show (a) ++ " " ++ show (b) ++ " " ++ show (c) ++ " " ++ show (d) ++ " " ++ show (e) ++ " " ++ show (f) ++ " cm" + +-- | Rotation matrix +rotate :: Angle -- ^ Rotation angle + -> Matrix +rotate r = Matrix ( (cos radian)) ( (sin radian)) (- ( (sin radian))) ( (cos radian)) 0 0 + where + radian = case r of + Degree angle -> angle / 180 * pi + Radian angle -> angle + + +-- | Translation matrix +translate :: PDFFloat -- ^ Horizontal translation + -> PDFFloat -- ^ Vertical translation + -> Matrix +translate tx ty = Matrix 1 0 0 1 tx ty + + +-- | Scaling matrix +scale :: PDFFloat -- ^ Horizontal scaling + -> PDFFloat -- ^ Horizontal scaling + -> Matrix +scale sx sy = Matrix sx 0 0 sy 0 0 diff --git a/Graphics/PDF/Data/PDFTree.hs b/Graphics/PDF/Data/PDFTree.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Data/PDFTree.hs @@ -0,0 +1,204 @@ +{-# OPTIONS -cpp -fglasgow-exts -fno-bang-patterns #-} +----------------------------------------------------------------------------- +-- | +-- Module : PDFTree.hs +-- Copyright : (c) Daan Leijen 2002 +-- License : BSD-style +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : provisional +-- Portability : portable +-- +-- An efficient implementation of maps from integer keys to values. +-- +-- Customized by alpheccar for the need of the PDF library. The original is IntMap from +-- the ghc standard libraries +----------------------------------------------------------------------------- +-- #hide +module Graphics.PDF.Data.PDFTree( + PDFTree + , Key + , empty + , lookup + , insert + , fromList + , fold2 + , isLeaf + , size + , keyOf + ) where + +import Prelude hiding (lookup,map,filter,foldr,foldl,null) +import Data.Bits +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts ( Word(..), Int(..), shiftRL# ) +#elif __GLASGOW_HASKELL__ +import Word +import GlaExts ( Word(..), Int(..), shiftRL# ) +#else +import Data.Word +#endif + +import Graphics.PDF.LowLevel.Types + +type Nat = Word + +natFromInt :: Key a -> Nat +natFromInt (PDFReference i) = fromIntegral i + +intFromNat :: Nat -> Key a +intFromNat w = PDFReference (fromIntegral w) + +type Prefix a = PDFReference a +type Mask a = PDFReference a +type Key a = PDFReference a + +-- | A map of integers to values @a@. +-- The total size of subtrees is tracked by each node. It is needed for the PDF Tree +data PDFTree a = Nil + | Tip {-# UNPACK #-} !(Key a) a + | Bin {-# UNPACK #-} !(Prefix a) {-# UNPACK #-} !(Mask a) !(PDFTree a) !(PDFTree a) + deriving(Eq,Show) + +-- | The key function needed to export a Tree of PDF objects into the format defined +-- by the PDF spec +fold2 :: Monad m => Maybe b -- ^ Parent ref + -> (Maybe b -> PDFTree a -> PDFTree a -> m (Int,b)) -- ^ Node action + -> (Maybe b -> Key a -> a -> m (Int,b)) -- ^ Leaf action + -> PDFTree a -- ^ PDFTree + -> m (Int,b) -- ^ Final action and reference of the root node +fold2 _ _ _ Nil = error "Page tree is empty" +fold2 p _ leaf (Tip k a) = leaf p k a +fold2 p node _ (Bin _ _ l r) = node p l r + + + +isLeaf :: PDFTree a -> Bool +isLeaf (Tip _ _) = True +isLeaf _ = False + +keyOf :: PDFTree a -> Key a +keyOf (Tip k _) = k +keyOf _ = error "No key for a node" + +{-------------------------------------------------------------------- + Query +--------------------------------------------------------------------} + +-- | /O(n)/. Number of elements in the map. +size :: PDFTree a -> Int +size t + = case t of + Bin _ _ l r -> (size l) + (size r) + Tip _ _ -> 1 + Nil -> 0 + +-- | /O(min(n,W))/. Lookup the value at a key in the map. +lookup :: (Monad m) => Key a -> PDFTree a -> m a +lookup k t = case lookup' k t of + Just x -> return x + Nothing -> fail "Data.PDFTree.lookup: Key not found" + +lookup' :: Key a -> PDFTree a -> Maybe a +lookup' k t + = let nk = natFromInt k in seq nk (lookupN nk t) + +lookupN :: Nat -> PDFTree a -> Maybe a +lookupN k t + = case t of + Bin _ m l r + | zeroN k (natFromInt m) -> lookupN k l + | otherwise -> lookupN k r + Tip kx x + | (k == natFromInt kx) -> Just x + | otherwise -> Nothing + Nil -> Nothing + +zeroN :: Nat -> Nat -> Bool +zeroN i m = (i .&. m) == 0 + +insert :: Key a -> a -> PDFTree a -> PDFTree a +insert k x t + = case t of + Bin p m l r + | nomatch k p m -> join k (Tip k x) p t + | zero k m -> Bin p m (insert k x l) r + | otherwise -> Bin p m l (insert k x r) + Tip ky _ + | k==ky -> Tip k x + | otherwise -> join k (Tip k x) ky t + Nil -> Tip k x + +join :: Prefix a -> PDFTree a -> Prefix a -> PDFTree a -> PDFTree a +join p1 t1 p2 t2 + | zero p1 m = Bin p m t1 t2 + | otherwise = Bin p m t2 t1 + where + m = branchMask p1 p2 + p = mask p1 m + +zero :: Key a -> Mask a -> Bool +zero i m + = (natFromInt i) .&. (natFromInt m) == 0 + +nomatch :: Key a -> Prefix a -> Mask a -> Bool +nomatch i p m + = (mask i m) /= p + +mask :: Key a -> Mask a -> Prefix a +mask i m + = maskW (natFromInt i) (natFromInt m) + +{-------------------------------------------------------------------- + Big endian operations +--------------------------------------------------------------------} +maskW :: Nat -> Nat -> Prefix a +maskW i m + = intFromNat (i .&. (complement (m-1) `xor` m)) + +branchMask :: Prefix a -> Prefix a -> Mask a +branchMask p1 p2 + = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2)) + +highestBitMask :: Nat -> Nat +highestBitMask x + = case (x .|. shiftRL x 1) of + x1 -> case (x1 .|. shiftRL x1 2) of + x2 -> case (x2 .|. shiftRL x2 4) of + x3 -> case (x3 .|. shiftRL x3 8) of + x4 -> case (x4 .|. shiftRL x4 16) of + x5 -> case (x5 .|. shiftRL x5 32) of -- for 64 bit platforms + x6 -> (x6 `xor` (shiftRL x6 1)) + +shiftRL :: Nat -> Int -> Nat +#if __GLASGOW_HASKELL__ +{-------------------------------------------------------------------- + GHC: use unboxing to get @shiftRL@ inlined. +--------------------------------------------------------------------} +shiftRL (W# x) (I# i) + = W# (shiftRL# x i) +#else +shiftRL x i = shiftR x i +#endif + +empty :: PDFTree a +empty + = Nil + +{-------------------------------------------------------------------- + Utilities +--------------------------------------------------------------------} +foldlStrict :: (a -> t -> a) -> a -> [t] -> a +foldlStrict f z xs + = case xs of + [] -> z + (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) + +-- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs. +fromList :: [(Key a,a)] -> PDFTree a +fromList xs + = foldlStrict ins empty xs + where + ins t (k,x) = insert k x t + + + diff --git a/Graphics/PDF/Demo.hs b/Graphics/PDF/Demo.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Demo.hs @@ -0,0 +1,151 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF demo. Generate a file demo.pdf +--------------------------------------------------------- +module Graphics.PDF.Demo(demo) where + +import Graphics.PDF + +fontDebug :: PDFFont -> PDFString -> Draw () +fontDebug f t = do + drawText $ do + setFont f + textStart 10 200.0 + leading $ getHeight f + renderMode FillText + displayText t + startNewLine + displayText $ toPDFString "Another little test" + strokeColor $ Rgb 1 0 0 + stroke $ Line 10 200 612 200 + fill $ Circle 10 200 10 + stroke $ Rectangle 10 (200.0 - (getDescent f)) (10.0 + textWidth f t) (200.0 - getDescent f + getHeight f) + + +geometryTest :: Draw () +geometryTest = do + strokeColor red + stroke $ Rectangle 0 0 200 100 + fillColor blue + fill $ Ellipse 100 100 300 200 + fillAndStroke $ RoundRectangle 32 32 200 200 600 400 + +lineStyle ::Draw () +lineStyle = do + withNewContext $ do + setWidth 2 + setDash $ DashPattern [3] 0 + geometryTest + + +shadingTest :: Draw () +shadingTest = do + paintWithShading (RadialShading 0 0 50 0 0 600 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Rectangle 0 0 300 300) + paintWithShading (AxialShading 300 300 600 400 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Ellipse 300 300 600 400) + + +patternTest :: PDFReference PDFPage -> PDF () +patternTest page = do + p <- createUncoloredTiling 0 0 100 50 100 50 ConstantSpacing pattern + cp <- createColoredTiling 0 0 100 50 100 50 ConstantSpacing cpattern + drawWithPage page $ do + strokeColor green + setUncoloredFillPattern p (Rgb 1 0 0) + fillAndStroke $ Ellipse 0 0 300 300 + setColoredFillPattern cp + fillAndStroke $ Ellipse 300 300 600 400 + + where + myDrawing = do + stroke (Line 0 0 100 100) + fill (Rectangle 100 100 200 200) + pattern = do + stroke (Ellipse 0 0 100 50) + cpattern = do + strokeColor (Rgb 0 0 1) + stroke (Ellipse 0 0 100 50) + +testAnnotation :: Draw () +testAnnotation = do + strokeColor red + newAnnotation (URLLink (toPDFString "Go to my blog") [0,0,100,100] "http://www.alpheccar.org" True) + drawText $ text (PDFFont Times_Roman 12) 10 30 (toPDFString "Go to my blog") + stroke $ Rectangle 0 0 100 100 + newAnnotation (TextAnnotation (toPDFString "Key annotation") [100,100,130,130] Key) + +textTest :: Draw () +textTest = do + strokeColor red + fillColor blue + fontDebug (PDFFont Times_Roman 48) (toPDFString "This is a test !") + + +--testImage :: FilePath -> PDFReference PDFPage -> PDF () +--testImage logo page = do +-- Right jpg <- createPDFJpeg logo +-- drawWithPage page $ do +-- withNewContext $ do +-- setFillAlpha 0.4 +-- drawXObject jpg +-- withNewContext $ do +-- applyMatrix $ rotate (Degree 20) +-- applyMatrix $ translate 200 200 +-- applyMatrix $ scale 2 2 +-- drawXObject jpg + +testAll :: FilePath -> PDF () +testAll logo = do + page <- addPage Nothing + newSection (toPDFString "Shapes") Nothing Nothing $ do + + newSection (toPDFString "Geometry") Nothing Nothing $ do + drawWithPage page $ do + geometryTest + + page <- addPage Nothing + newSection (toPDFString "Line style") Nothing Nothing $ do + drawWithPage page $ do + lineStyle + page <- addPage Nothing + newSection (toPDFString "Object reuse") Nothing Nothing $ do + r <- createPDFXForm 0 0 200 200 lineStyle + drawWithPage page $ do + drawXObject r + + page <- addPage Nothing + newSectionWithPage (toPDFString "Painting") Nothing Nothing page $ do + newSection (toPDFString "Patterns") Nothing Nothing $ do + patternTest page + page <- addPage Nothing + newSection (toPDFString "Shading") Nothing Nothing $ do + drawWithPage page $ do + shadingTest + page <- addPage Nothing + --newSection (toPDFString "Media") Nothing Nothing $ do + -- newSection (toPDFString "image") Nothing Nothing $ do + -- testImage logo page + + page <- addPage Nothing + newSection (toPDFString "Annotations") Nothing Nothing $ do + drawWithPage page $ do + testAnnotation + page <- addPage Nothing + newSection (toPDFString "Text") Nothing Nothing $ do + drawWithPage page $ do + textTest + + +-- | Run the demo and create a demo.pdf file +demo :: IO() +demo = do + let rect = PDFRect 0 0 600 400 + runPdf "demo.pdf" (standardDocInfo { author=toPDFString $ "alpheccar"}) rect $ do + testAll "" + diff --git a/Graphics/PDF/Document.hs b/Graphics/PDF/Document.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Document.hs @@ -0,0 +1,134 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- Management of the PDF structure +--------------------------------------------------------- + +module Graphics.PDF.Document( + -- * Document actions + -- ** Special document objects + PDFXForm + -- ** Page management + , addPage + , addPageWithTransition + , drawWithPage + , createPDFXForm + -- ** Page transitions + , PDFTransition(..) + , PDFTransStyle(..) + , PDFTransDirection(..) + , PDFTransDimension(..) + , PDFTransDirection2(..) + -- ** Document information + , PDFDocumentInfo(..) + , PDFDocumentPageMode(..) + , PDFDocumentPageLayout(..) + , PDFViewerPreferences(..) + , standardDocInfo + , standardViewerPrefs + -- * Draw monad and drawing functions + -- ** Types + , Draw + , PDFXObject(drawXObject,bounds) + -- ** General drawing functions + , withNewContext + , emptyDrawing + ) where + +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import Graphics.PDF.Pages +import Control.Monad.State +import qualified Data.IntMap as IM +import qualified Data.Map as M + + + +-- | No information for the document +standardDocInfo :: PDFDocumentInfo +standardDocInfo = PDFDocumentInfo (toPDFString "") (toPDFString "") UseNone SinglePage standardViewerPrefs True + +-- | Create a PDF XObject +createPDFXForm :: PDFFloat -- ^ Left + -> PDFFloat -- ^ Bottom + -> PDFFloat -- ^ Right + -> PDFFloat -- ^ Top + -> Draw a -- ^ Drawing commands + -> PDF (PDFReference PDFXForm) +createPDFXForm xa ya xb yb d = let a' = do modifyStrict $ \s -> s {otherRsrcs = PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject") + , (PDFName "Subtype",AnyPdfObject . PDFName $ "Form") + , (PDFName "FormType",AnyPdfObject . PDFInteger $ 1) + , (PDFName "Matrix",AnyPdfObject . (map (AnyPdfObject . PDFInteger)) $ [1,0,0,1,0,0]) + , (PDFName "BBox",AnyPdfObject . (map AnyPdfObject) $ [xa,ya,xb,yb]) + ] + } + d + in do + PDFReference s <- createContent a' Nothing + recordBound s (xb-xa) (yb-ya) + return (PDFReference s) + + +-- Create a new empty page +createANewPage :: Maybe PDFRect -- ^ Page size or default document's one + -> PDF (Int,PDFPage) -- ^ Reference to the new page +createANewPage rect' = do + rect <- maybe (gets defaultRect) return rect' + -- Get the root page reference + -- Create a new page reference + pageref <- supply + -- Create a new empty content for the page + pageContent <- createContent (return ()) (Just (PDFReference pageref :: PDFReference PDFPage)) + -- Create a new page having as parent the root page + let page = PDFPage Nothing rect pageContent Nothing Nothing Nothing [] + return (pageref , page) + +-- | Add a new page to a PDF document +addPage :: Maybe PDFRect -- ^ Page size or default document's one + -> PDF (PDFReference PDFPage) -- ^ Reference to the new page +addPage rect' = do + (pf,page) <- createANewPage rect' + let pageref = PDFReference pf + modifyStrict $ \s -> s {pages = recordPage pageref page (pages s), currentPage = Just pageref} + return pageref + +addPageWithTransition :: Maybe PDFRect -- ^ Page size or default document's one + -> Maybe PDFFloat -- ^ Optional duration + -> Maybe PDFTransition -- ^ Optional transition + -> PDF (PDFReference PDFPage) -- ^ Reference to the new page +addPageWithTransition rect' dur t = do + (pf,PDFPage a b c d _ _ pageAnnots) <- createANewPage rect' + let pageref = PDFReference pf + modifyStrict $ \s -> s {pages = recordPage pageref (PDFPage a b c d dur t pageAnnots) (pages s), currentPage = Just pageref} + return pageref + + +-- | Draw on a given page +drawWithPage :: PDFReference PDFPage -- ^ Page + -> Draw a -- ^ Drawing commands + -> PDF () +drawWithPage page draw = do + -- Get the page dictionary + lPages <- gets pages + -- Get the stream dictionary + lStreams <- gets streams + -- Look for the page + let thePage = findPage page lPages + case thePage of + Nothing -> return () + -- If the page is found, get its stream reference and look for the stream + Just(PDFPage _ _ (PDFReference streamRef) _ _ _ _) -> do + let theContent = IM.lookup streamRef lStreams + case theContent of + Nothing -> return() + -- If the stream is found + Just (_,c) -> do + -- Create a new cntent and update the stream + modifyStrict $ \s -> s {streams = IM.insert streamRef (Just page,c >> draw >> return ()) lStreams} diff --git a/Graphics/PDF/Draw.hs b/Graphics/PDF/Draw.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Draw.hs @@ -0,0 +1,623 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2006 +-- 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(..) + , supplyName + , emptyDrawing + , writeCmd + , runDrawing + , setResource + , emptyEnvironment + , PDFXForm + , PDFXObject(..) + , AnyPdfXForm + , pdfDictMember + , getBound + -- PDF types + , PDF(..) + , PDFPage(..) + , PDFPages(..) + , PdfState(..) + , PDFCatalog(..) + , Pages(..) + , PDFDocumentPageMode(..) + , PDFDocumentPageLayout(..) + , PDFViewerPreferences(..) + , PDFDocumentInfo(..) + -- ** Page transitions + , PDFTransition(..) + , PDFTransStyle(..) + , PDFTransDirection(..) + , PDFTransDimension(..) + , PDFTransDirection2(..) + -- ** Outlines + , PDFOutline(..) + , OutlineStyle(..) + , PDFOutlineEntry(..) + , Destination(..) + , Outline + , OutlineLoc(..) + , Tree(..) + , OutlineCtx(..) + , AnnotationObject(..) + , Color(..) + , hsvToRgb + , OutlineData + , AnyAnnotation(..) + , AnnotationStyle(..) + , PDFShading(..) + , getRgbColor + ) where + +import Graphics.PDF.LowLevel.Types +import qualified Data.ByteString.Lazy as B +import Control.Monad.RWS +import Control.Monad.Writer +import Control.Monad.Reader +import Control.Monad.State +import qualified Data.Map as M +import Graphics.PDF.Resources +import qualified Data.IntMap as IM +import Graphics.PDF.Data.PDFTree(PDFTree) +import Data.Maybe + +data AnnotationStyle = AnnotationStyle !(Maybe Color) + +class AnnotationObject a where + addAnnotation :: a -> PDF (PDFReference a) + annotationType :: a -> PDFName + annotationContent :: a -> PDFString + annotationRect :: a -> [PDFFloat] + +data AnyAnnotation = forall a.(PdfObject a,AnnotationObject a) => AnyAnnotation a + +instance PdfObject AnyAnnotation where + toPDF (AnyAnnotation a) = toPDF a + +instance AnnotationObject AnyAnnotation where + addAnnotation (AnyAnnotation a) = do + PDFReference r <- addAnnotation a + return (PDFReference r) + annotationType (AnyAnnotation a) = annotationType a + annotationContent (AnyAnnotation a) = annotationContent a + annotationRect (AnyAnnotation a) = annotationRect a + + +-- | A PDF color +data Color = Rgb !Double !Double !Double + | Hsv !Double !Double !Double + deriving(Eq,Ord) + +data DrawState = DrawState { + supplyNames :: [String] + , rsrc :: PDFResource + , strokeAlphas :: M.Map StrokeAlpha String + , fillAlphas :: M.Map FillAlpha String + , theFonts :: M.Map PDFFont String + , xobjects :: M.Map (PDFReference AnyPdfXForm) String + , otherRsrcs :: PDFDictionary + , annots :: [AnyAnnotation] + , patterns :: M.Map (PDFReference AnyPdfPattern) String + , colorSpaces :: M.Map PDFColorSpace String + , shadings :: M.Map PDFShading String + } +data DrawEnvironment = DrawEnvironment { + streamId :: Int + , xobjectb :: IM.IntMap (PDFFloat,PDFFloat) + , currentp :: Maybe Int + } + +emptyEnvironment :: DrawEnvironment +emptyEnvironment = DrawEnvironment 0 IM.empty Nothing + + + +-- | The drawing monad +newtype Draw a = Draw {unDraw :: RWS DrawEnvironment B.ByteString DrawState a} +#ifndef __HADDOCK__ + deriving(Monad,MonadWriter B.ByteString, MonadReader DrawEnvironment, MonadState DrawState, Functor) +#else +instance Monad Draw +instance MonadWriter B.ByteString Draw +instance MonadReader DrawEnvironment Draw +instance MonadState DrawState Draw +instance Functor Draw +#endif + +instance MonadPath Draw + +-- | A PDF stream object +data PDFStream = PDFStream !B.ByteString !Bool !(PDFReference PDFLength) !PDFDictionary + +instance PdfObject PDFStream where + toPDF (PDFStream s c l d) = + B.concat $ [ toPDF dict + , toByteString "\nstream" + , newline + , s + , newline + , toByteString "endstream"] + where + compressedStream False = [] + compressedStream True = if not (pdfDictMember (PDFName "Filter") d) then [(PDFName "Filter",AnyPdfObject $ [AnyPdfObject . PDFName $ "FlateDecode"])] else [] + lenDict = PDFDictionary. M.fromList $ [ (PDFName "Length",AnyPdfObject l)] ++ compressedStream c + dict = pdfDictUnion lenDict d + +-- | An empty drawing +emptyDrawing :: Draw () +emptyDrawing = return () + +-- | is member of the dictionary +pdfDictMember :: PDFName -> PDFDictionary -> Bool +pdfDictMember k (PDFDictionary d) = M.member k d + +-- | Write a command to the drawing +writeCmd :: (MonadWriter B.ByteString m) => String -> m () +writeCmd = tell . toByteString + +-- | Get a new resource name +supplyName :: Draw String +supplyName = do + (x:xs) <- gets supplyNames + modifyStrict $ \s -> s {supplyNames = xs} + return x + +-- | Execute the drawing commands to get a new state and an uncompressed PDF stream +runDrawing :: Draw a -> DrawEnvironment -> (a,DrawState,B.ByteString) +runDrawing drawing environment = + let names = (map (("O" ++ (show . streamId $ environment)) ++ ) $ [replicate k ['a'..'z'] | k <- [1..]] >>= sequence) + state = DrawState + names + emptyRsrc + M.empty M.empty M.empty M.empty + emptyDictionary [] M.empty M.empty M.empty + (a,state',w') = (runRWS . unDraw $ drawing) environment state + in + (a,state',w') + +-- | Draw in a new drawing context without perturbing the previous context +-- that is restored after the draw +withNewContext :: Draw a -> Draw a +withNewContext m = do + writeCmd "\nq" + a <- m + writeCmd "\nQ" + return 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 dict values oldCache = do + case M.lookup values oldCache of + Nothing -> do + newName <- supplyName + modifyStrict $ \s -> s { rsrc = addResource (PDFName dict) (PDFName newName) (toRsrc values) (rsrc s)} + return (newName,M.insert values newName oldCache) + Just n -> return (n,oldCache) + +-- | A PDF Xobject which can be drawn +class PDFXObject a where + drawXObject :: PDFReference a -> Draw () + bounds :: PDFReference a -> Draw (PDFFloat,PDFFloat) + + privateDrawXObject :: PDFReference a -> Draw () + privateDrawXObject (PDFReference r) = do + xobjectMap <- gets xobjects + (newName,newMap) <- setResource "XObject" (PDFReference r) xobjectMap + modifyStrict $ \s -> s { xobjects = newMap } + writeCmd ("\n/" ++ newName ++ " Do") + drawXObject = privateDrawXObject + + bounds (PDFReference r) = getBound r + +-- | An XObject +data AnyPdfXForm = forall a. (PDFXObject a,PdfObject a) => AnyPdfXForm a +instance PdfObject AnyPdfXForm where + toPDF (AnyPdfXForm a) = toPDF a + +instance PDFXObject AnyPdfXForm + +data PDFXForm +instance PDFXObject PDFXForm +instance PdfObject PDFXForm where + toPDF _ = noPdfObject +instance PdfResourceObject (PDFReference PDFXForm) where + toRsrc = AnyPdfObject + +instance PdfResourceObject (PDFReference AnyPdfXForm) where + toRsrc = AnyPdfObject + + +-- | Get the bounds for an xobject +getBound :: Int -- ^ Reference + -> Draw (PDFFloat,PDFFloat) +getBound ref = do + theBounds <- asks xobjectb + return $ IM.findWithDefault (0.0,0.0) ref theBounds + +----------- +-- +-- PDF types +-- +------------ + +-- | The PDF Catalog +data PDFCatalog = PDFCatalog + !(Maybe (PDFReference PDFOutline)) + !(PDFReference PDFPages) + !PDFDocumentPageMode + !PDFDocumentPageLayout + !PDFViewerPreferences + +-- | The PDF state +data PdfState = PdfState { supplySrc :: !Int -- ^ Supply of unique identifiers + , objects :: !(IM.IntMap AnyPdfObject) -- ^ Dictionary of PDF objects + , pages :: !Pages -- ^ Pages + , streams :: !(IM.IntMap ((Maybe (PDFReference PDFPage)),Draw ())) -- ^ Draw commands + , catalog :: !(PDFReference PDFCatalog) -- ^ Reference to the PDF catalog + , defaultRect :: !PDFRect -- ^ Default page size + , docInfo :: !PDFDocumentInfo -- ^ Document infos + , outline :: Maybe Outline -- ^ Root outline + , currentPage :: Maybe (PDFReference PDFPage) -- ^ Reference to the current page used to create outlines + , xobjectBound :: !(IM.IntMap (PDFFloat,PDFFloat)) -- ^ Width and height of xobjects + , 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" + +-- | 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(Eq) + + +-- | Dimension of a transition +data PDFTransDimension = Horizontal | Vertical + deriving(Eq) + + +instance Show PDFTransDimension where + show Horizontal = "H" + show Vertical = "V" + +-- | Direction of a transition +data PDFTransDirection = Inward | Outward deriving(Eq) + +instance Show PDFTransDirection where + show Inward = "I" + show Outward = "O" + +-- | Direction of a transition +data PDFTransDirection2 = LeftToRight + | BottomToTop -- ^ Wipe only + | RightToLeft -- ^ Wipe only + | TopToBottom + | TopLeftToBottomRight -- ^ Glitter only + deriving(Eq) + +-- | The PDF Monad +newtype PDF a = PDF {unPDF :: StateT PdfState IO a} +#ifndef __HADDOCK__ + deriving (Functor, Monad, MonadState PdfState, MonadIO) +#else +instance Functor PDF +instance Monad PDF +instance MonadState PdfState PDF +instance MonadIO PDF +#endif + +-- | Transition style +data PDFTransStyle = Split PDFTransDimension PDFTransDirection + | Blinds PDFTransDimension + | Box PDFTransDirection + | Wipe PDFTransDirection2 + | Dissolve + | Glitter PDFTransDirection2 + deriving(Eq) + +-- | Document metadata +data PDFDocumentInfo = PDFDocumentInfo { + author :: PDFString + , subject :: PDFString + , pageMode :: PDFDocumentPageMode + , pageLayout :: PDFDocumentPageLayout + , viewerPreferences :: PDFViewerPreferences + , compressed :: Bool + } + + +-- | Document page mode +data PDFDocumentPageMode = UseNone + | UseOutlines + | UseThumbs + | FullScreen + deriving(Eq,Show) + +-- | Document page layout +data PDFDocumentPageLayout = SinglePage + | OneColumn + | TwoColumnLeft + | TwoColumnRight + | TwoPageLeft + | TwoPageRight + deriving(Eq,Show) + +-- | Viewer preferences +data PDFViewerPreferences = PDFViewerPreferences { hideToolbar :: Bool -- ^ To hide the toolbar + , hideMenuBar :: Bool -- ^ To hide the menubar + , hideWindowUI :: Bool -- ^ To hide the window + , fitWindow :: Bool -- ^ Fit window to screen + , centerWindow :: Bool -- ^ Center window on screen + , displayDoctitle :: Bool -- ^ Display the docu,ent title + , nonFullScreenPageMode :: PDFDocumentPageMode -- ^ Display mode when exiting the full screen mode + } + +data PDFOutline = PDFOutline !(PDFReference PDFOutlineEntry) !(PDFReference PDFOutlineEntry) + +instance PdfObject PDFOutline where + toPDF (PDFOutline first lasto) = toPDF $ PDFDictionary. M.fromList $ [ + (PDFName "Type",AnyPdfObject . PDFName $ "Outlines") + , (PDFName "First",AnyPdfObject first) + , (PDFName "Last",AnyPdfObject lasto) + ] + +data OutlineStyle = Normal + | Italic + | Bold + deriving(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(Eq,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 { value :: a + , parent :: OutlineCtx a + , lefts :: [Tree a] + , rights :: [Tree a] + } + + +data OutlineLoc a = OutlineLoc (Tree a) (OutlineCtx a) + +instance PdfObject PDFViewerPreferences where + toPDF (PDFViewerPreferences ht hm hwui fw cw ddt nfspm ) = toPDF $ PDFDictionary. M.fromList $ + [ (PDFName "HideToolbar",AnyPdfObject ht) + , (PDFName "HideMenubar",AnyPdfObject hm) + , (PDFName "HideWindowUI",AnyPdfObject hwui) + , (PDFName "FitWindow",AnyPdfObject fw) + , (PDFName "CenterWindow",AnyPdfObject cw) + , (PDFName "DisplayDocTitle",AnyPdfObject ddt) + , (PDFName "NonFullScreenPageMode",AnyPdfObject . PDFName . show $ nfspm) + ] + + +instance Show PDFTransStyle where + show (Split _ _) = "Split" + show (Blinds _) = "Blinds" + show (Box _) = "Box" + show (Wipe _) = "Wipe" + show (Dissolve) = "Dissolve" + show (Glitter _) = "Glitter" + +instance PdfObject PDFTransition where + toPDF (PDFTransition d t) = toPDF $ PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject (PDFName "Trans")) + , (PDFName "S",AnyPdfObject (PDFName (show t))) + , (PDFName "D",AnyPdfObject d) + ] ++ optionalDm t ++ optionalM t ++ optionalDi t + where + optionalDm (Split a _) = [ (PDFName "Dm",AnyPdfObject (PDFName (show a)))] + optionalDm (Blinds a) = [ (PDFName "Dm",AnyPdfObject (PDFName (show a)))] + optionalDm _ = [] + optionalM (Split _ a) = [ (PDFName "M",AnyPdfObject (PDFName (show a)))] + optionalM (Box a) = [ (PDFName "M",AnyPdfObject (PDFName (show a)))] + optionalM _ = [] + optionalDi (Wipe a) = [ (PDFName "Di",AnyPdfObject (floatDirection a))] + optionalDi (Glitter a) = [ (PDFName "Di",AnyPdfObject (floatDirection a))] + optionalDi _ = [] + +-- PDF Pages + +instance PdfObject PDFPages where + toPDF (PDFPages c Nothing l) = toPDF $ PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject (PDFName "Pages")) + , (PDFName "Kids",AnyPdfObject $ map AnyPdfObject l) + , (PDFName "Count",AnyPdfObject . PDFInteger $ c) + ] + toPDF (PDFPages c (Just theParent) l) = toPDF $ PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject (PDFName "Pages")) + , (PDFName "Parent",AnyPdfObject theParent) + , (PDFName "Kids",AnyPdfObject $ map AnyPdfObject l) + , (PDFName "Count",AnyPdfObject . PDFInteger $ c) + ] + + +instance PdfObject PDFPage where + toPDF (PDFPage (Just theParent) box content theRsrc d t theAnnots) = toPDF $ PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject (PDFName "Page")) + , (PDFName "Parent",AnyPdfObject theParent) + , (PDFName "MediaBox",AnyPdfObject box) + , (PDFName "Contents",AnyPdfObject content) + , if isJust theRsrc + then + (PDFName "Resources",AnyPdfObject . fromJust $ theRsrc) + else + (PDFName "Resources",AnyPdfObject emptyDictionary) + ] ++ (maybe [] (\x -> [(PDFName "Dur",AnyPdfObject x)]) d) + ++ (maybe [] (\x -> [(PDFName "Trans",AnyPdfObject x)]) t) + ++ ((\x -> if null x then [] else [(PDFName "Annots",AnyPdfObject x)]) theAnnots) + toPDF (PDFPage Nothing _ _ _ _ _ _) = noPdfObject + + +-- Main objects in a PDF document + +instance PdfObject PDFCatalog where + toPDF (PDFCatalog outlines lPages pgMode pgLayout viewerPrefs) = toPDF $ PDFDictionary . M.fromList $ + [ (PDFName "Type",AnyPdfObject (PDFName "Catalog")) + , (PDFName "Pages",AnyPdfObject lPages) + , (PDFName "PageMode", AnyPdfObject . PDFName . show $ pgMode) + , (PDFName "PageLayout", AnyPdfObject . PDFName . show $ pgLayout) + , (PDFName "ViewerPreferences", AnyPdfObject viewerPrefs) + ] ++ (maybe [] (\x -> [(PDFName "Outlines",AnyPdfObject x)]) outlines) + + +instance PdfObject OutlineStyle where + toPDF Normal = toPDF (PDFInteger 0) + toPDF Italic = toPDF (PDFInteger 1) + toPDF Bold = toPDF (PDFInteger 2) + +instance PdfObject PDFOutlineEntry where + toPDF (PDFOutlineEntry title theParent prev next first theLast count dest color style) = + toPDF $ PDFDictionary. M.fromList $ [ + (PDFName "Title",AnyPdfObject title) + , (PDFName "Parent",AnyPdfObject theParent) + ] + ++ + maybe [] (\x -> [(PDFName "Prev",AnyPdfObject x)]) prev + ++ + maybe [] (\x -> [(PDFName "Next",AnyPdfObject x)]) next + ++ + maybe [] (\x -> [(PDFName "First",AnyPdfObject x)]) first + ++ + maybe [] (\x -> [(PDFName "Last",AnyPdfObject x)]) theLast + ++ + [ (PDFName "Count",AnyPdfObject (PDFInteger count)) + , (PDFName "Dest",AnyPdfObject dest) + , (PDFName "C",AnyPdfObject color) + , (PDFName "F",AnyPdfObject style) + ] + + + +instance PdfObject Destination where + toPDF (Destination r) = toPDF [ AnyPdfObject r + , AnyPdfObject . PDFName $ "Fit" + ] + +instance PdfObject Color where + toPDF (Rgb r g b) = toPDF . map (AnyPdfObject . PDFFloat) $ [r,g,b] + toPDF (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v) + in toPDF . map (AnyPdfObject . PDFFloat) $ [r,g,b] + +-- Degree for a transition direction +floatDirection :: PDFTransDirection2 -> PDFFloat +floatDirection LeftToRight = 0 +floatDirection BottomToTop = 90 +floatDirection RightToLeft = 180 +floatDirection TopToBottom = 270 +floatDirection TopLeftToBottomRight = 315 + + +hsvToRgb :: (Double,Double,Double) -> (Double,Double,Double) +hsvToRgb (h,s,v) = + let hi = fromIntegral (floor (h / 60) `mod` 6 :: Int) :: Double + f = h/60 - hi + p = v * (1-s) + q = v * (1 - f*s) + t = v * (1 - (1-f)*s) in + case hi of + 0 -> (v,t,p) + 1 -> (q,v,p) + 2 -> (p,v,t) + 3 -> (p,q,v) + 4 -> (t,p,v) + 5 -> (v,p,q) + _ -> error "Hue value incorrect" + +getRgbColor :: Color -> (PDFFloat,PDFFloat,PDFFloat) +getRgbColor (Rgb r g b) = (PDFFloat r,PDFFloat g,PDFFloat b) +getRgbColor (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v) in (PDFFloat r,PDFFloat g,PDFFloat b) + +-- | Interpolation function +interpole :: Int -> PDFFloat -> PDFFloat -> AnyPdfObject +interpole n x y = AnyPdfObject . PDFDictionary . M.fromList $ + [ (PDFName "FunctionType", AnyPdfObject . PDFInteger $ 2) + , (PDFName "Domain", AnyPdfObject . map AnyPdfObject $ [PDFFloat 0,PDFFloat 1]) + , (PDFName "C0", AnyPdfObject . map AnyPdfObject $ [x]) + , (PDFName "C1", AnyPdfObject . map AnyPdfObject $ [y]) + , (PDFName "N", AnyPdfObject . PDFInteger $ n) + ] + +-- | A shading +data PDFShading = AxialShading PDFFloat PDFFloat PDFFloat PDFFloat Color Color + | RadialShading PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat Color Color + deriving(Eq,Ord) + +instance PdfResourceObject PDFShading where + toRsrc (AxialShading x0 y0 x1 y1 ca cb) = AnyPdfObject . PDFDictionary . M.fromList $ + [ (PDFName "ShadingType",AnyPdfObject . PDFInteger $ 2) + , (PDFName "Coords",AnyPdfObject . map AnyPdfObject $ [x0,y0,x1,y1]) + , (PDFName "ColorSpace",AnyPdfObject . PDFName $ "DeviceRGB") + , (PDFName "Function",AnyPdfObject $ [interpole 1 ra rb,interpole 1 ga gb,interpole 1 ba bb]) + ] + where + (ra,ga,ba) = getRgbColor ca + (rb,gb,bb) = getRgbColor cb + toRsrc (RadialShading x0 y0 r0 x1 y1 r1 ca cb) = AnyPdfObject . PDFDictionary . M.fromList $ + [ (PDFName "ShadingType",AnyPdfObject . PDFInteger $ 3) + , (PDFName "Coords",AnyPdfObject . map AnyPdfObject $ [x0,y0,r0,x1,y1,r1]) + , (PDFName "ColorSpace",AnyPdfObject . PDFName $ "DeviceRGB") + , (PDFName "Function",AnyPdfObject $ [interpole 1 ra rb,interpole 1 ga gb,interpole 1 ba bb]) + ] + where + (ra,ga,ba) = getRgbColor ca + (rb,gb,bb) = getRgbColor cb diff --git a/Graphics/PDF/File.hs b/Graphics/PDF/File.hs deleted file mode 100644 --- a/Graphics/PDF/File.hs +++ /dev/null @@ -1,174 +0,0 @@ -module Graphics.PDF.File - (-- * PDF generation - writePdf - ) where - -import System.IO -import Control.Monad -import Control.Monad.State -import Graphics.PDF.LowLevel -import Text.Printf -import qualified Data.Map as Map -import Data.List -import System.Mem - --- writeSome text and increment the size counter -writeText :: Handle -> String -> StateT (Int,String) IO () -writeText f text = do (s,t) <- get - put (s + (length text),t) - lift $ hPutStr f (seq s text) - - -writeStream :: Handle -> [Cmd] -> StateT (Int,String) IO () -writeStream f c = mapM_ (drawAction f) c - -drawAction :: Handle -> Cmd -> StateT (Int,String) IO () -drawAction f (PdfQ actions) = do writeText f "\nq" - writeStream f actions - writeText f "\nQ" - - -drawAction f action = writeText f (show action) - -class PdfWrite a where - writePdfObject :: Handle -> a -> Int -> StateT (Int,String) IO Int - -instance PdfWrite PdfDictionary where - writePdfObject f (PdfDictionary d) k = do writeText f "<<\n" - Map.foldWithKey item (return ()) d - writeText f ">>" - return 0 - where - item key itm m = do m - writeText f ("/" ++ key ++ " " ) - writePdfObject f itm k - writeText f "\n" - -instance PdfWrite PdfObject where - writePdfObject f (PdfInt a) k = do writeText f (show a) - return 0 - writePdfObject f (PdfFloat a) k = do writeText f (show a) - return 0 - writePdfObject f (PdfUnknownPointer s) k = error ("The object " ++ s ++ " has not been found or defined") - writePdfObject f (PdfPointer a) k = do writeText f $ (show a) ++ " 0 R" - return 0 - writePdfObject f (PdfString a) k = do writeText f $ "(" ++ a ++ ")" - return 0 - writePdfObject f (PdfBool a) k = if a then do writeText f $ "true" - return 0 - else do writeText f $ "false" - return 0 - writePdfObject f (PdfName a) k = do writeText f $ "/" ++ a - return 0 - writePdfObject f (PdfDict d) k | pdfDictionaryEmpty d = do writeText f "<< >>" - return 0 - | otherwise = do writePdfObject f d k - return 0 - writePdfObject f (PdfArray []) k = do writeText f "[]" - return 0 - writePdfObject f (PdfArray l) k = do writeText f "[" - mapM_ (\x -> writePdfObject f x k >> writeText f " ") $ l - writeText f " ]" - return 0 - - writePdfObject f (PdfStream c) k = do writeText f "<<\n" - writeText f ("/Length " ++ (show (k+1)) ++ " 0 R") - writeText f "\n>>\n" - writeText f "stream" - (before,_) <- get - writeStream f (stream c) - (after,_) <- get - writeText f "\nendstream" - return (after-before) - where - stream (Content(s)) = s - - - -resources = pdfDictionary [("ExtGState",PdfUnknownPointer "ExtGState"), - ("XObject",PdfUnknownPointer "XObject"), - ("Font",PdfUnknownPointer "Font"), - ("Pattern",PdfUnknownPointer "Pattern"), - ("Shading",PdfUnknownPointer "Shading"), - ("ProcSet",PdfUnknownPointer "ProcSet") - ] -header = "%PDF-1.4\n" -obj1 = pdfDictionary [("Type", PdfName "Catalog"), - ("Outlines",PdfUnknownPointer "Obj2"), - ("Pages",PdfUnknownPointer "Obj3") - ] -obj2 = pdfDictionary [("Type",PdfName "Outlines"), - ("Count", PdfInt 0) - ] -obj3 = pdfDictionary [("Type", PdfName "Pages"), - ("Kids",PdfArray [PdfUnknownPointer "Obj4"]), - ("Count",PdfInt 1) - ] -obj4 pdf = pdfDictionary [("Type",PdfName "Page"), - ("Parent",PdfUnknownPointer "Obj3"), - ("MediaBox",PdfArray [PdfInt 0,PdfInt 0,PdfInt (round (x pdf)),PdfInt (round (y pdf))]), - ("Contents",PdfUnknownPointer "Main"), - ("Resources",resources) - ] -obj6 = PdfArray [PdfName "PDF"] -beginxref nb = ("xref\n" ++ printf "0 %d\n" (nb+1)) -trailer np = ("trailer\n" ++ - (printf " << /Size %d\n" ((nbObjects np)+1)) ++ - (printf " /Root %d 0 R\n" (objectIndex "Obj1" np) ) ++ - " >>\n\ - \startxref\n") -eof = "%%EOF" - - -standardAlpha = pdfDictionary [("Type",PdfName "ExtGState"), - ("ca",PdfFloat 1.0), - ("CA",PdfFloat 1.0) - ] - --- write and object, increment the size counter and the object number -writeObj f k o maxnb = do (s,t) <- get - put (s,t ++ printf "%010d 00000 n \n" (s::Int) ) - writeText f (printf "%d 0 obj\n" k) - len <- writePdfObject f o maxnb - writeText f ("\nendobj\n\n") - return len - - -- Write the xref table -writeXref f p = do (_,t) <- get - writeText f (beginxref (nbObjects p)) - writeText f t - writeText f ("\n") - -- write all pending objects -writeObjects f thepdf = do len <- foldM write 0 (allObjects thepdf) - return len - where - write old (k,s) = do len <- writeObj f k s maxnb - return(len+old) - maxnb = nbObjects thepdf - --- Write the PDF document to file -writePdf :: String -> PDF -> IO () -writePdf fileName pdf = - -- New pdf with object describing a one page PDF - let newpdf = computeObjectPos . - addObject "Obj1" obj1 . - addObject "Obj2" obj2 . - addObject "Obj3" obj3 . - addObject "Obj4" (obj4 pdf) . - addObject "ProcSet" obj6 . - addState "standardAlpha" standardAlpha $ pdf - in - do f <- lift $ openBinaryFile fileName WriteMode - writeText f header - len <- writeObjects f newpdf - writeEndPdf f len (addObject "ZZZ" (PdfInt len) newpdf) - `evalStateT` (0,"0000000000 65535 f \n") - where - writeEndPdf f len epdf = do writeObj f (nbObjects epdf) (PdfInt len) (nbObjects epdf) - (xrefStart,_) <- get - writeXref f epdf - writeText f (trailer epdf) - writeText f (printf "%d\n" (xrefStart::Int)) - writeText f eof - lift $ hClose f - diff --git a/Graphics/PDF/Font.hs b/Graphics/PDF/Font.hs deleted file mode 100644 --- a/Graphics/PDF/Font.hs +++ /dev/null @@ -1,61 +0,0 @@ --- | Function used to control the fonts in a PDF document - -module Graphics.PDF.Font - (-- * Font - -- * Font type - Font(..) - -- ** Font selection - ,chooseFont - ) - where - -import Graphics.PDF.LowLevel - - --- | List of supported fonts -data Font = TimesRoman - | TimesBold - | TimesItalic - | Helvetica - | HelveticaBold - | HelveticaOblique - | HelveticaBoldOblique - | Courier - | CourierBold - | CourierOblique - | CourierBoldOblique - | Symbol - | ZapfDingbats - -instance Show Font where - show TimesRoman = "Times-Roman" - show TimesBold = "Times-Bold" - show TimesItalic = "Times-Italic" - show Helvetica = "Helvetica" - show HelveticaBold = "Helvetica-Bold" - show HelveticaOblique = "Helvetica-Oblique" - show HelveticaBoldOblique = "Helvetica-BoldOblique" - show Courier = "Courier" - show CourierBold = "Courier-Bold" - show CourierOblique = "Courier-Oblique" - show CourierBoldOblique = "Courier-BoldOblique" - show Symbol = "Symbol" - show ZapfDingbats = "ZapfDingbats" - -type Size = Int - --- | Create a new font dictionary -newFont :: String -> PdfObject -newFont name= pdfDictionary [("Type",PdfName "FontDescriptor"), - ("Subtype",PdfName "Type1"), - ("BaseFont",PdfName name) - ] - --- | Select new font in the document -chooseFont :: Font -> Size -> PdfCmd -chooseFont font fontSize = (PdfBT fontName fontSize,[(PdfFont,fontName,PdfUnknownPointer fontName), - (PdfAnyObject, fontName, newFont fontName) - ]) - where - fontName = show font - diff --git a/Graphics/PDF/Geometry.hs b/Graphics/PDF/Geometry.hs deleted file mode 100644 --- a/Graphics/PDF/Geometry.hs +++ /dev/null @@ -1,71 +0,0 @@ --- | Transformations of a PDF document - -module Graphics.PDF.Geometry - (-- * Geometry - -- ** Units - Angle(..) - -- ** Data types - , Matrix - -- ** Transformations - , rotate, translate, scale, applyMatrix, identity - ) - where - -import Graphics.PDF.LowLevel - - --- | Angle -data Angle = Degree Float -- ^ Angle in degrees - | Radian Float -- ^ Angle in radians - --- | A transformation matrix (affine transformation) -newtype Matrix = Matrix(Float,Float,Float,Float,Float,Float) deriving (Eq) - --- | Identity matrix -identity :: Matrix -identity = Matrix(1.0,0,0,1.0,0,0) - -instance Show Matrix where - show (Matrix(ma,mb,mc,md,me,mf)) = "Matrix " ++ (unwords [(show ma),(show mb),(show mc),(show md),(show me),(show mf)]) - -instance Num Matrix where - -- Matrix addition - (+) (Matrix(ma,mb,mc,md,me,mf)) (Matrix(na,nb,nc,nd,ne,nf)) = - Matrix( (ma+na), (mb+nb), (mc+nc), (md+nd), (me+ne), (mf+nf)) - -- Matrix multiplication - -- ma mb 0 na nb 0 - -- mc md 0 nc nd 0 - -- me mf 1 ne nf 1 - (*) (Matrix(ma,mb,mc,md,me,mf)) (Matrix(na,nb,nc,nd,ne,nf)) = - Matrix( (ma*na+mb*nc), (ma*nb + mb*nd ), (mc*na+md*nc), (mc*nb +md*nd), (me*na+mf*nc+ne), (me*nb+mf*nd+nf)) - negate (Matrix(ma,mb,mc,md,me,mf)) = - Matrix( (-ma), (-mb), (-mc), (-md), (-me), (-mf)) - abs m = m - signum _ = identity - fromInteger i = Matrix(r,0,0,r, 0, 0) - where - r = fromInteger i - - --- | Apply a transformation matrix to the current coordinate frame -applyMatrix :: Matrix -> PdfCmd -applyMatrix (Matrix(a,b,c,d,e,f)) = (PdfCM a b c d e f,[]) - --- | Rotation matrix -rotate :: Angle -> Matrix -rotate r = Matrix ((cos(radian)), (sin(radian)), (-sin(radian)) ,(cos(radian)), 0, 0) - where - radian = case r of - Degree angle -> angle / 180 * pi - Radian angle -> angle - - --- | Translation matrix -translate :: Float -> Float -> Matrix -translate tx ty = Matrix( 1, 0, 0, 1 ,tx ,ty) - - --- | Scaling matrix -scale :: Float -> Float -> Matrix -scale sx sy = Matrix (sx, 0, 0, sy, 0 ,0 ) - diff --git a/Graphics/PDF/Image.hs b/Graphics/PDF/Image.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Image.hs @@ -0,0 +1,288 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Images +--------------------------------------------------------- + +module Graphics.PDF.Image( + -- * Images + -- ** Types + PDFJpeg + -- ** Functions + , createPDFJpeg + ) where + +import Graphics.PDF.LowLevel.Types +import qualified Data.Map as M +import Graphics.PDF.Draw +import Graphics.PDF.Resources +import Graphics.PDF.Pages +import Graphics.PDF.Document +import qualified Data.ByteString.Lazy as B +import Control.Monad.Writer +import System.IO +import Data.Char(ord) +import Data.Bits +import Control.Monad.Error +import Graphics.PDF.Coordinates + +m_sof0 :: Int +m_sof0 = 0xc0 +m_sof1 :: Int +m_sof1 = 0xc1 +--m_sof2 :: Int +--m_sof2 = 0xc2 +m_sof3 :: Int +m_sof3 = 0xc3 +m_sof5 :: Int +m_sof5 = 0xc5 +m_sof6 :: Int +m_sof6 = 0xc6 +m_sof7 :: Int +m_sof7 = 0xc7 +--m_jpg :: Int +--m_jpg = 0xc8 +m_sof9 :: Int +m_sof9 = 0xc9 +m_sof10 :: Int +m_sof10 = 0xca +m_sof11 :: Int +m_sof11 = 0xcb +m_sof13 :: Int +m_sof13 = 0xcd +m_sof14 :: Int +m_sof14 = 0xce +m_sof15 :: Int +m_sof15 = 0xcf +--m_dht :: Int +--m_dht = 0xc4 +--m_dac :: Int +--m_dac = 0xcc +m_rst0 :: Int +m_rst0 = 0xd0 +m_rst1 :: Int +m_rst1 = 0xd1 +m_rst2 :: Int +m_rst2 = 0xd2 +m_rst3 :: Int +m_rst3 = 0xd3 +m_rst4 :: Int +m_rst4 = 0xd4 +m_rst5 :: Int +m_rst5 = 0xd5 +m_rst6 :: Int +m_rst6 = 0xd6 +m_rst7 :: Int +m_rst7 = 0xd7 +m_soi :: Int +m_soi = 0xd8 +m_eoi :: Int +m_eoi = 0xd9 +--m_sos :: Int +--m_sos = 0xda +--m_dqt :: Int +--m_dqt = 0xdb +--m_dnl :: Int +--m_dnl = 0xdc +--m_dri :: Int +--m_dri = 0xdd +--m_dhp :: Int +--m_dhp = 0xde +--m_exp :: Int +--m_exp = 0xdf +--m_app0 :: Int +--m_app0 = 0xe0 +--m_app1 :: Int +--m_app1 = 0xe1 +--m_app2 :: Int +--m_app2 = 0xe2 +--m_app3 :: Int +--m_app3 = 0xe3 +--m_app4 :: Int +--m_app4 = 0xe4 +--m_app5 :: Int +--m_app5 = 0xe5 +--m_app6 :: Int +--m_app6 = 0xe6 +--m_app7 :: Int +--m_app7 = 0xe7 +--m_app8 :: Int +--m_app8 = 0xe8 +--m_app9 :: Int +--m_app9 = 0xe9 +--m_app10 :: Int +--m_app10 = 0xea +--m_app11 :: Int +--m_app11 = 0xeb +--m_app12 :: Int +--m_app12 = 0xec +--m_app13 :: Int +--m_app13 = 0xed +--m_app14 :: Int +--m_app14 = 0xee +--m_app15 :: Int +--m_app15 = 0xef +--m_jpg0 :: Int +--m_jpg0 = 0xf0 +--m_jpg13 :: Int +--m_jpg13 = 0xfd +--m_com :: Int +--m_com = 0xfe +m_tem :: Int +m_tem = 0x01 +--m_error :: Int +--m_error = 0x100 + +io :: IO a -> FA a +io = FA . liftIO + +-- | File analyzer monad +newtype FA a = FA {unFA :: ErrorT String PDF a} +#ifndef __HADDOCK__ + deriving(Monad,MonadError String,Functor) +#else +instance Monad FA +instance MonadError String FA +instance MonadIO FA +instance Functor FA +#endif + +runFA :: FA a -> PDF (Either String a) +runFA = runErrorT . unFA + +readWord16 :: Handle -> FA Int +readWord16 h = io $ do + hi <- hGetChar h + lo <- hGetChar h + return $ ((fromEnum hi) `shiftL` 8) .|. (fromEnum . ord $ lo) + +readWord8 :: Handle -> FA Int +readWord8 h = io $ do + lo <- hGetChar h + return $ fromEnum . ord $ lo + +--optional :: FA (Maybe a) -> FA (Maybe a) +--optional a = a --`catchError` (\e -> return Nothing) + +--jfif :: Handle -> FA (Maybe (Double,Double)) +--jfif h = do +-- header <- readWord16 h +-- when (header /= 0x0FFE0) $ throwError (strMsg "No JFIF magic number") +-- readWord16 h +-- mapM_ check "JFIF" +-- readWord16 h +-- unit <- readWord8 h +-- width <- fromIntegral `fmap` readWord16 h +-- height <- fromIntegral `fmap` readWord16 h +-- case unit of +-- 1 -> return $ Just (width,height) +-- 2 -> return $ Just (width*2.54,height*2.54) +-- _ -> return $ Just (0,0) +-- where +-- check c' = do +-- c <- io $ hGetChar h +-- when (c /= c') $ throwError (strMsg "No JFIF header") + +parseJpegContent :: Handle -> FA (Int,Int,Int,Int) +parseJpegContent h = do + r <- readWord8 h + when (r /= 0x0FF) $ throwError (strMsg "No marker found") + sof <- readWord8 h + case sof of + a | a `elem` [m_sof5,m_sof6,m_sof7,m_sof9,m_sof10,m_sof11,m_sof13,m_sof14,m_sof15] -> throwError (strMsg "Unuspported compression mode") + | a `elem` [m_sof0,m_sof1,m_sof3] -> do + readWord16 h + bits_per_component <- readWord8 h + height <- readWord16 h + width <- readWord16 h + color_space <- readWord8 h + return (bits_per_component,height,width,color_space) + | a `elem` [m_soi,m_eoi,m_tem,m_rst0,m_rst1,m_rst2,m_rst3,m_rst4,m_rst5,m_rst6,m_rst7] -> parseJpegContent h + | otherwise -> do + l <- readWord16 h + io $ hSeek h RelativeSeek (fromIntegral (l-2)) + parseJpegContent h + +analyzeJpeg :: Handle -> FA (Int,PDFFloat,PDFFloat,Int) +analyzeJpeg h = do + -- Get Length + io $ hSeek h SeekFromEnd 0 + --fileLength <- io $ hTell h + io $ hSeek h AbsoluteSeek 0 + -- Check jpeg + header <- readWord16 h + when (header /= 0x0FFD8) $ throwError (strMsg "Not a JPEG File") + + -- Extract resolution from jfif + --res <- optional $ jfif h + + io $ hSeek h AbsoluteSeek 0 + + (bits_per_component,height,width,color_space) <- parseJpegContent h + --io $ print fileLength + --io $ print res + --io $ print bits_per_component + --io $ print height + --io $ print width + --io $ print color_space + --io $ hClose h + unless (color_space `elem` [1,3,4]) $ throwError (strMsg "Color space not supported") + return (bits_per_component,(fromIntegral height),(fromIntegral width),color_space) + +--test = analyzePng "Test/logo.png" + + +-- | Create a PDF XObject for a JPEG image +createPDFJpeg :: FilePath + -> PDF (Either String (PDFReference PDFJpeg)) +createPDFJpeg f = do + h <- liftIO $ openBinaryFile f ReadMode + r <- runFA (analyzeJpeg h) + liftIO $ hClose h + case r of + Right settings@(_,height,width,_) -> do + img <- liftIO $ B.readFile f + PDFReference s <- createContent (a' img settings) Nothing + recordBound s width height + return (Right $ PDFReference s) + Left s -> return $ Left s + where + color c = case c of + 1 -> [(PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceGray")] + 3 -> [(PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceRGB")] + 4 -> [(PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceCMYK") + ,(PDFName "Decode",AnyPdfObject . map (AnyPdfObject . PDFInteger) $ [1,0,1,0,1,0,1,0]) + ] + _ -> error "Jpeg color space not supported" + a' img (bits_per_component,height,width,color_space) = + do modifyStrict $ \s -> s {otherRsrcs = PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject") + , (PDFName "Subtype",AnyPdfObject . PDFName $ "Image") + , (PDFName "Width",AnyPdfObject . PDFInteger $ round width) + , (PDFName "Height",AnyPdfObject . PDFInteger $ round height) + , (PDFName "BitsPerComponent",AnyPdfObject . PDFInteger $ bits_per_component) + , (PDFName "Interpolate", AnyPdfObject True) + , (PDFName "Filter",AnyPdfObject . PDFName $ "DCTDecode") + ] ++ color color_space + } + tell img + + +data PDFJpeg +instance PDFXObject PDFJpeg where + drawXObject a = withNewContext $ do + (width,height) <- bounds a + applyMatrix (scale width height) + applyMatrix (translate 0 0) + privateDrawXObject a + +instance PdfObject PDFJpeg where + toPDF _ = noPdfObject +instance PdfResourceObject (PDFReference PDFJpeg) where + toRsrc = AnyPdfObject diff --git a/Graphics/PDF/LowLevel.hs b/Graphics/PDF/LowLevel.hs deleted file mode 100644 --- a/Graphics/PDF/LowLevel.hs +++ /dev/null @@ -1,308 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} --- #hide -module Graphics.PDF.LowLevel - (-- * PDF low level operators - -- ** Data types - PdfObject(..),PdfDictionary(..),PDF(..),Content(..),PdfCmd,CreatedObject,ObjectKind(..), Cmd(..), PdfString(..),TextRendering(..) - -- ** Data type support functions - ,dictionaryExtract, pdfDictionaryEmpty, emptyDictionary, emptyPdf - -- ** Low level object operators - ,nbObjects, objectIndex, allObjects,pdfDictionary - -- ** Low level PDF operators - ,addObject, addFont, addState, addNewContent, applyCommand,computeObjectPos,(<>),withContext - ) where - -import qualified Data.Map as Map -import Data.Monoid -import Text.Printf -import Text.Show - --- | A PDF string -newtype PdfString = S String - -data TextRendering = TextStroke - | TextFill - | TextFillStroke - | TextClip - -data Cmd = PdfRgbSpace - | PdfSC Float Float Float - | PdfSF Float Float Float - | PdfBT String Int - | PdfCM Float Float Float Float Float Float - | PdfL Float Float Float Float - | PdfW Float - | PdfRect Float Float Float Float - | PdfFillRect Float Float Float Float - | PdfDash [Float] Float - | PdfStartPath Float Float - | PdfAddLineToPath Float Float - | PdfAddRectangleToPath Float Float Float Float - | PdfText TextRendering Float Float [PdfString] - | PdfStroke - | PdfFill - | PdfClip - | PdfFillAndStroke - | PdfClosePath - | PdfAlpha String - | PdfQ [Cmd] - | PdfResetAlpha - | PdfCharSpacing Float - | PdfWordSpacing Float - | PdfLeading Float - | PdfStrokePattern String - | PdfFillPattern String - | PdfNone - --- | Escape character whose meaning is special in a PDF String -instance Show PdfString where - show (S a) = "("++a++")" - showList l = \s -> r ++ s - where - r = case l of - [] -> "" - (a:l) -> (show a) ++ " Tj " ++ concat (zipWith (++) (map show l) (repeat " ' ")) - -instance Show Cmd where - show (PdfQ l) = error "Require a special processing" - show PdfNone = "" - show PdfClip = "\nW" - show PdfResetAlpha = "\n/standardAlpha gs" - show (PdfAlpha s) = printf "\n/%s gs" s - show (PdfStrokePattern s) = printf "\n/Pattern CS /%s SCN" s - show (PdfFillPattern s) = printf "\n/Pattern cs /%s scn" s - show PdfRgbSpace = "\n/DeviceRGB CS\n/DeviceRGB cs\n/standardAlpha gs" - show (PdfSC r g b) = printf "\n%f %f %f SC" r g b - show (PdfSF r g b) = printf "\n%f %f %f sc" r g b - show (PdfBT fontName fontSize) = printf "\nBT /%s %d Tf ET" fontName fontSize - show (PdfCM a b c d e f) = printf "\n%f %f %f %f %f %f cm" a b c d e f - show (PdfL xa ya xb yb) = printf "\nh %f %f m %f %f l S" xa ya xb yb - show (PdfW w) = printf "\n%f w" w - show (PdfRect xa ya width height) = printf "\nh %f %f %f %f re S" xa ya width height - show (PdfFillRect xa ya width height) = printf "\nh %f %f %f %f re f" xa ya width height - show (PdfDash a phase) = printf "\n[%s] %f d" (unwords . map show $ a) phase - show (PdfStartPath xa ya) = printf "\nh %f %f m" xa ya - show (PdfClosePath) = "\nh" - show (PdfAddLineToPath xa ya) = printf "\n%f %f l" xa ya - show (PdfAddRectangleToPath xa ya width height) = printf "\n%f %f %f %f re" xa ya width height - show PdfStroke = "\nS" - show PdfFill = "\nf" - show PdfFillAndStroke = "\nB" - show (PdfText TextStroke px py s) = printf "\n1 Tr BT %f %f Td %s ET" px py (show s) - show (PdfText TextFill px py s) = printf "\n0 Tr BT %f %f Td %s ET" px py (show s) - show (PdfText TextFillStroke px py s) = printf "\n2 Tr BT %f %f Td %s ET" px py (show s) - show (PdfText TextClip px py s) = printf "\n7 Tr BT %f %f Td %s ET" px py (show s) - show (PdfCharSpacing x) = printf "\n%f Tc" x - show (PdfWordSpacing x) = printf "\n%f Tw" x - show (PdfLeading x) = printf "\n%f TL" x - --- | PDF commands for a picture -newtype Content = Content ([Cmd]) - -instance Monoid Content where - mempty = Content ([]) - mappend (Content(ca)) (Content(cb)) = Content(ca ++ cb) - --- | A PDF object as defined in PDF specification -data PdfObject = PdfInt Int - | PdfFloat Float - | PdfString String - | PdfName String - | PdfDict PdfDictionary - | PdfUnknownPointer String - | PdfPointer Int - | PdfBool Bool - | PdfArray [PdfObject] - | PdfStream Content - --- | A dictionary of objects -newtype PdfDictionary = PdfDictionary (Map.Map String PdfObject) - -dictionaryExtract :: PdfDictionary -> Map.Map String PdfObject -dictionaryExtract (PdfDictionary a) = a - --- | Kind of created object -data ObjectKind = PdfAnyObject | PdfFont | PdfState | PdfShading | PdfPatternObject - --- | Object created by a command -type CreatedObject = (ObjectKind,String,PdfObject) - --- | Type returned by a PDF command creator -type PdfCmd = (Cmd,[CreatedObject]) - --- | Number of objects in the PDF -nbObjects :: PDF -> Int -nbObjects p = let PdfDictionary d = (objects p) - in - Map.size d - - - --- | Object index in the PDF -objectIndex :: String -> PDF -> Int -objectIndex s p = let PdfDictionary d = (objects p) - in - (Map.findIndex s d) + 1 - --- | List of object contents with their index -allObjects :: PDF -> [(Int,PdfObject)] -allObjects p = let d = dictionaryExtract (objects p) - in - map createItem . Map.toAscList $ d - where - createItem (k,s) = ((objectIndex k p),s) - --- Name of PDF object containing the content -contentName :: String -contentName = "Main" - --- | PDF data with its state, xobject and font dictionary -data PDF = PDF {content :: Content, - objects :: PdfDictionary, - extgstate :: PdfDictionary, - xobject :: PdfDictionary, - font :: PdfDictionary, - pattern :: PdfDictionary, - shading :: PdfDictionary, - x :: Float, - y :: Float - } - - --- | Check is a dictionary is empty -pdfDictionaryEmpty :: PdfDictionary -> Bool -pdfDictionaryEmpty (PdfDictionary m) | Map.null m = True - | otherwise = False - -emptyDictionary :: PdfDictionary -emptyDictionary = PdfDictionary Map.empty - --- | Create a new empty document of given width and height -emptyPdf :: Float -> Float -> PDF -emptyPdf width height = PDF { - objects = emptyDictionary, - content = mempty, - extgstate=emptyDictionary, - xobject=emptyDictionary, - font=emptyDictionary, - pattern=emptyDictionary, - shading=emptyDictionary, - x = width, - y = height - } - --- | Insert an object into a PdfDictionary -insertObject :: String -> PdfObject -> PdfDictionary -> PdfDictionary -insertObject name object (PdfDictionary d) = PdfDictionary (Map.insert name object d) - --- | Add an object of a PDF -addObject :: String -> PdfObject -> PDF -> PDF -addObject name object p = p {objects = insertObject name object (objects p)} - --- | Add a font object of a PDF -addFont :: String -> PdfObject -> PDF -> PDF -addFont name object p = p {font=insertObject name object (font p)} - --- | Add a font object of a PDF -addState :: String -> PdfObject -> PDF -> PDF -addState name object p = p {extgstate=insertObject name object (extgstate p)} - --- | Add a shading object of a PDF -addShading :: String -> PdfObject -> PDF -> PDF -addShading name object p = p {shading=insertObject name object (shading p)} - --- | Add a pattern object of a PDF -addPattern :: String -> PdfObject -> PDF -> PDF -addPattern name object p = p {pattern=insertObject name object (pattern p)} - - --- | Add a created object -addCreatedObject :: CreatedObject -> PDF -> PDF -addCreatedObject (PdfFont,name,object) p = addFont name object p -addCreatedObject (PdfState,name,object) p = addState name object p -addCreatedObject (PdfShading,name,object) p = addShading name object p -addCreatedObject (PdfPatternObject,name,object) p = addPattern name object p -addCreatedObject (_,name,object) p = addObject name object p - -pdfDictionary :: [(String,PdfObject)] -> PdfObject -pdfDictionary l = PdfDict (PdfDictionary(Map.fromList l)) - - --- PDF document can be concatenated -instance Monoid PDF where - mempty = emptyPdf 0 0 - mappend pdfa pdfb = PDF {objects = union (objects pdfa) (objects pdfb), - content = (content pdfa) `mappend` (content pdfb), - extgstate = union (extgstate pdfa) (extgstate pdfb), - xobject = union (xobject pdfa) (xobject pdfb), - font = union (font pdfa) (font pdfb), - pattern = union (pattern pdfa) (pattern pdfb), - shading = union (shading pdfa) (shading pdfb), - x = max (x pdfa) (x pdfb), - y = max (y pdfa) (y pdfb) - } where - union (PdfDictionary a) (PdfDictionary b) = PdfDictionary (Map.union a b) - - --- | Generate a new PDF with an updated content -addNewContent :: Cmd -> PDF -> PDF -addNewContent s p = p {content = Content(s : c)} - where - Content(c) = content p - --- | Generate a new PDF with an updated content -replaceContent :: Content -> PDF -> PDF -replaceContent s p = p {content = s} - --- | Create a new PDF graphic where the graphic context is saved\/restored and thus isolated --- from additional modifications that could be applied to this PDF document -withContext :: PDF -> PdfCmd -withContext f = (PdfQ l,newobjs) - where - Content(l) = content f - newobjs = listOfObjects PdfState (extgstate f) ++ listOfObjects PdfFont (font f) - listOfObjects s d = map tag (Map.toList (dictionaryExtract d)) - where - tag (n,o) = (s,n,o) - ---addNewContent "\nq" (f `mappend` (addNewContent "\nQ" mempty)) - - - --- | add a PDF command to the current PDF content -applyCommand :: Cmd -> PDF -> PDF -applyCommand cmd p = addNewContent cmd p - --- | Update the pointer value of the PDF dictionary given element of list objects. --- The specific dictionary extgstate, xobject and font are merged with the generic dictionary -computeObjectPos :: PDF -> PDF -computeObjectPos p = p {content = mempty, - objects = renumber newobjects, - extgstate= emptyDictionary, - xobject= emptyDictionary, - font= emptyDictionary, - pattern= emptyDictionary, - shading= emptyDictionary - } - where - newobjects = foldl insertObjs (objects p) [(contentName,(PdfStream (content p))), - ("ExtGState",PdfDict (extgstate p)), - ("XObject",PdfDict (xobject p)), - ("Font",PdfDict (font p)), - ("Pattern",PdfDict (pattern p)), - ("Shading",PdfDict (shading p)) - ] - insertObjs dict (s,o) = insertObject s o dict - renumber (PdfDictionary objs) = PdfDictionary(Map.map (setNumber objs) objs) - setNumber objs (PdfUnknownPointer s) = PdfPointer ((Map.findIndex s objs)+1) - setNumber objs (PdfDict (PdfDictionary d)) = PdfDict . PdfDictionary . Map.map (setNumber objs) $ d - setNumber objs (PdfArray l) = PdfArray . map (setNumber objs) $ l - setNumber _ a = a - -infixr 9 <> --- | Combine two PDF actions -(<>) :: PdfCmd -> PDF -> PDF -(<>) (c,l) p = addNewContent c (foldr addCreatedObject p l) - - - diff --git a/Graphics/PDF/LowLevel/Kern.hs b/Graphics/PDF/LowLevel/Kern.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/LowLevel/Kern.hs @@ -0,0 +1,7 @@ +-- #hide +module Graphics.PDF.LowLevel.Kern(kerns) where + +import qualified Data.Map as M +import Data.Word +kerns :: M.Map (Int,Word8,Word8) Int +kerns = M.fromList [((0,32,84),-50),((0,32,86),-50),((0,32,87),-40),((0,32,89),-90),((0,32,96),-60),((0,32,170),-30),((0,39,32),-70),((0,39,39),-57),((0,39,100),-50),((0,39,114),-50),((0,39,115),-50),((0,44,39),-100),((0,44,186),-100),((0,46,32),-60),((0,46,39),-100),((0,46,186),-100),((0,58,32),-50),((0,59,32),-50),((0,65,67),-30),((0,65,71),-30),((0,65,79),-30),((0,65,81),-30),((0,65,84),-120),((0,65,85),-50),((0,65,86),-70),((0,65,87),-50),((0,65,89),-100),((0,65,117),-30),((0,65,118),-40),((0,65,119),-40),((0,65,121),-40),((0,65,233),-30),((0,66,44),-20),((0,66,46),-20),((0,66,85),-10),((0,67,44),-30),((0,67,46),-30),((0,68,44),-70),((0,68,46),-70),((0,68,65),-40),((0,68,86),-70),((0,68,87),-40),((0,68,89),-90),((0,70,44),-150),((0,70,46),-150),((0,70,65),-80),((0,70,97),-50),((0,70,101),-30),((0,70,111),-30),((0,70,114),-45),((0,70,249),-30),((0,74,44),-30),((0,74,46),-30),((0,74,65),-20),((0,74,97),-20),((0,74,117),-20),((0,75,79),-50),((0,75,101),-40),((0,75,111),-40),((0,75,117),-30),((0,75,121),-50),((0,75,233),-50),((0,75,249),-40),((0,76,39),-160),((0,76,84),-110),((0,76,86),-110),((0,76,87),-70),((0,76,89),-140),((0,76,121),-30),((0,76,186),-140),((0,79,44),-40),((0,79,46),-40),((0,79,65),-20),((0,79,84),-40),((0,79,86),-50),((0,79,87),-30),((0,79,88),-60),((0,79,89),-70),((0,80,44),-180),((0,80,46),-180),((0,80,65),-120),((0,80,97),-40),((0,80,101),-50),((0,80,111),-50),((0,80,249),-50),((0,81,85),-10),((0,82,79),-20),((0,82,84),-30),((0,82,85),-40),((0,82,86),-50),((0,82,87),-30),((0,82,89),-50),((0,82,233),-20),((0,83,44),-20),((0,83,46),-20),((0,84,44),-120),((0,84,45),-140),((0,84,46),-120),((0,84,58),-20),((0,84,59),-20),((0,84,65),-120),((0,84,79),-40),((0,84,97),-120),((0,84,101),-120),((0,84,111),-120),((0,84,114),-120),((0,84,117),-120),((0,84,119),-120),((0,84,121),-120),((0,84,233),-40),((0,84,249),-120),((0,85,44),-40),((0,85,46),-40),((0,85,65),-40),((0,86,44),-125),((0,86,45),-80),((0,86,46),-125),((0,86,58),-40),((0,86,59),-40),((0,86,65),-80),((0,86,71),-40),((0,86,79),-40),((0,86,97),-70),((0,86,101),-80),((0,86,111),-80),((0,86,117),-70),((0,86,233),-40),((0,86,249),-80),((0,87,44),-80),((0,87,45),-40),((0,87,46),-80),((0,87,65),-50),((0,87,79),-20),((0,87,97),-40),((0,87,101),-30),((0,87,111),-30),((0,87,117),-30),((0,87,121),-20),((0,87,233),-20),((0,87,249),-30),((0,89,44),-140),((0,89,45),-140),((0,89,46),-140),((0,89,58),-60),((0,89,59),-60),((0,89,65),-110),((0,89,79),-85),((0,89,97),-140),((0,89,101),-140),((0,89,105),-20),((0,89,111),-140),((0,89,117),-110),((0,89,233),-85),((0,89,249),-140),((0,96,96),-57),((0,97,118),-20),((0,97,119),-20),((0,97,121),-30),((0,98,44),-40),((0,98,46),-40),((0,98,98),-10),((0,98,108),-20),((0,98,117),-20),((0,98,118),-20),((0,98,121),-20),((0,98,248),-20),((0,99,44),-15),((0,99,107),-20),((0,101,44),-15),((0,101,46),-15),((0,101,118),-30),((0,101,119),-20),((0,101,120),-30),((0,101,121),-20),((0,102,39),50),((0,102,44),-30),((0,102,46),-30),((0,102,97),-30),((0,102,101),-30),((0,102,111),-30),((0,102,186),60),((0,102,245),-28),((0,102,249),-30),((0,103,114),-10),((0,104,121),-30),((0,107,101),-20),((0,107,111),-20),((0,107,249),-20),((0,109,117),-10),((0,109,121),-15),((0,110,117),-10),((0,110,118),-20),((0,110,121),-15),((0,111,44),-40),((0,111,46),-40),((0,111,118),-15),((0,111,119),-15),((0,111,120),-30),((0,111,121),-30),((0,112,44),-35),((0,112,46),-35),((0,112,121),-30),((0,114,44),-50),((0,114,46),-50),((0,114,58),30),((0,114,59),30),((0,114,97),-10),((0,114,105),15),((0,114,107),15),((0,114,108),15),((0,114,109),25),((0,114,110),25),((0,114,112),30),((0,114,116),40),((0,114,117),15),((0,114,118),30),((0,114,121),30),((0,114,248),15),((0,115,44),-15),((0,115,46),-15),((0,115,119),-30),((0,118,44),-80),((0,118,46),-80),((0,118,97),-25),((0,118,101),-25),((0,118,111),-25),((0,118,249),-25),((0,119,44),-60),((0,119,46),-60),((0,119,97),-15),((0,119,101),-10),((0,119,111),-10),((0,119,249),-10),((0,120,101),-30),((0,121,44),-100),((0,121,46),-100),((0,121,97),-20),((0,121,101),-20),((0,121,111),-20),((0,121,249),-20),((0,122,101),-15),((0,122,111),-15),((0,122,249),-15),((0,186,32),-40),((0,232,39),-160),((0,232,84),-110),((0,232,86),-110),((0,232,87),-70),((0,232,89),-140),((0,232,121),-30),((0,232,186),-140),((0,233,44),-40),((0,233,46),-40),((0,233,65),-20),((0,233,84),-40),((0,233,86),-50),((0,233,87),-30),((0,233,88),-60),((0,233,89),-70),((0,249,44),-95),((0,249,46),-95),((0,249,97),-55),((0,249,98),-55),((0,249,99),-55),((0,249,100),-55),((0,249,101),-55),((0,249,102),-55),((0,249,103),-55),((0,249,104),-55),((0,249,105),-55),((0,249,106),-55),((0,249,107),-55),((0,249,108),-55),((0,249,109),-55),((0,249,110),-55),((0,249,111),-55),((0,249,112),-55),((0,249,113),-55),((0,249,114),-55),((0,249,115),-55),((0,249,116),-55),((0,249,117),-55),((0,249,118),-70),((0,249,119),-70),((0,249,120),-85),((0,249,121),-70),((0,249,122),-55),((0,249,248),-55),((0,249,249),-55),((1,32,84),-100),((1,32,86),-80),((1,32,87),-80),((1,32,89),-120),((1,32,96),-60),((1,32,170),-80),((1,39,32),-80),((1,39,39),-46),((1,39,100),-80),((1,39,108),-20),((1,39,114),-40),((1,39,115),-60),((1,39,118),-20),((1,39,248),-20),((1,44,32),-40),((1,44,39),-120),((1,44,186),-120),((1,46,32),-40),((1,46,39),-120),((1,46,186),-120),((1,58,32),-40),((1,59,32),-40),((1,65,67),-40),((1,65,71),-50),((1,65,79),-40),((1,65,81),-40),((1,65,84),-90),((1,65,85),-50),((1,65,86),-80),((1,65,87),-60),((1,65,89),-110),((1,65,117),-30),((1,65,118),-40),((1,65,119),-30),((1,65,121),-30),((1,65,233),-40),((1,66,65),-30),((1,66,85),-10),((1,68,44),-30),((1,68,46),-30),((1,68,65),-40),((1,68,86),-40),((1,68,87),-40),((1,68,89),-70),((1,70,44),-100),((1,70,46),-100),((1,70,65),-80),((1,70,97),-20),((1,74,44),-20),((1,74,46),-20),((1,74,65),-20),((1,74,117),-20),((1,75,79),-30),((1,75,101),-15),((1,75,111),-35),((1,75,117),-30),((1,75,121),-40),((1,75,233),-30),((1,75,249),-35),((1,76,39),-140),((1,76,84),-90),((1,76,86),-110),((1,76,87),-80),((1,76,89),-120),((1,76,121),-30),((1,76,186),-140),((1,79,44),-40),((1,79,46),-40),((1,79,65),-50),((1,79,84),-40),((1,79,86),-50),((1,79,87),-50),((1,79,88),-50),((1,79,89),-70),((1,80,44),-120),((1,80,46),-120),((1,80,65),-100),((1,80,97),-30),((1,80,101),-30),((1,80,111),-40),((1,80,249),-40),((1,81,44),20),((1,81,46),20),((1,81,85),-10),((1,82,79),-20),((1,82,84),-20),((1,82,85),-20),((1,82,86),-50),((1,82,87),-40),((1,82,89),-50),((1,82,233),-20),((1,84,44),-80),((1,84,45),-120),((1,84,46),-80),((1,84,58),-40),((1,84,59),-40),((1,84,65),-90),((1,84,79),-40),((1,84,97),-80),((1,84,101),-60),((1,84,111),-80),((1,84,114),-80),((1,84,117),-90),((1,84,119),-60),((1,84,121),-60),((1,84,233),-40),((1,84,249),-80),((1,85,44),-30),((1,85,46),-30),((1,85,65),-50),((1,86,44),-120),((1,86,45),-80),((1,86,46),-120),((1,86,58),-40),((1,86,59),-40),((1,86,65),-80),((1,86,71),-50),((1,86,79),-50),((1,86,97),-60),((1,86,101),-50),((1,86,111),-90),((1,86,117),-60),((1,86,233),-50),((1,86,249),-90),((1,87,44),-80),((1,87,45),-40),((1,87,46),-80),((1,87,58),-10),((1,87,59),-10),((1,87,65),-60),((1,87,79),-20),((1,87,97),-40),((1,87,101),-35),((1,87,111),-60),((1,87,117),-45),((1,87,121),-20),((1,87,233),-20),((1,87,249),-60),((1,89,44),-100),((1,89,46),-100),((1,89,58),-50),((1,89,59),-50),((1,89,65),-110),((1,89,79),-70),((1,89,97),-90),((1,89,101),-80),((1,89,111),-100),((1,89,117),-100),((1,89,233),-70),((1,89,249),-100),((1,96,96),-46),((1,97,103),-10),((1,97,118),-15),((1,97,119),-15),((1,97,121),-20),((1,98,108),-10),((1,98,117),-20),((1,98,118),-20),((1,98,121),-20),((1,98,248),-10),((1,99,104),-10),((1,99,107),-20),((1,99,108),-20),((1,99,121),-10),((1,99,248),-20),((1,100,100),-10),((1,100,118),-15),((1,100,119),-15),((1,100,121),-15),((1,101,44),10),((1,101,46),20),((1,101,118),-15),((1,101,119),-15),((1,101,120),-15),((1,101,121),-15),((1,102,39),30),((1,102,44),-10),((1,102,46),-10),((1,102,101),-10),((1,102,111),-20),((1,102,186),30),((1,102,249),-20),((1,103,101),10),((1,103,103),-10),((1,104,121),-20),((1,107,111),-15),((1,107,249),-15),((1,108,119),-15),((1,108,121),-15),((1,109,117),-20),((1,109,121),-30),((1,110,117),-10),((1,110,118),-40),((1,110,121),-20),((1,111,118),-20),((1,111,119),-15),((1,111,120),-30),((1,111,121),-20),((1,112,121),-15),((1,114,44),-60),((1,114,45),-20),((1,114,46),-60),((1,114,99),-20),((1,114,100),-20),((1,114,103),-15),((1,114,111),-20),((1,114,113),-20),((1,114,115),-15),((1,114,116),20),((1,114,118),10),((1,114,121),10),((1,114,249),-20),((1,115,119),-15),((1,118,44),-80),((1,118,46),-80),((1,118,97),-20),((1,118,111),-30),((1,118,249),-30),((1,119,44),-40),((1,119,46),-40),((1,119,111),-20),((1,119,249),-20),((1,120,101),-10),((1,121,44),-80),((1,121,46),-80),((1,121,97),-30),((1,121,101),-10),((1,121,111),-25),((1,121,249),-25),((1,122,101),10),((1,186,32),-80),((1,232,39),-140),((1,232,84),-90),((1,232,86),-110),((1,232,87),-80),((1,232,89),-120),((1,232,121),-30),((1,232,186),-140),((1,233,44),-40),((1,233,46),-40),((1,233,65),-50),((1,233,84),-40),((1,233,86),-50),((1,233,87),-50),((1,233,88),-50),((1,233,89),-70),((1,248,119),-15),((1,248,121),-15),((1,249,118),-20),((1,249,119),-15),((1,249,120),-30),((1,249,121),-20),((2,32,84),-50),((2,32,86),-50),((2,32,87),-40),((2,32,89),-90),((2,32,96),-60),((2,32,170),-30),((2,39,32),-70),((2,39,39),-57),((2,39,100),-50),((2,39,114),-50),((2,39,115),-50),((2,44,39),-100),((2,44,186),-100),((2,46,32),-60),((2,46,39),-100),((2,46,186),-100),((2,58,32),-50),((2,59,32),-50),((2,65,67),-30),((2,65,71),-30),((2,65,79),-30),((2,65,81),-30),((2,65,84),-120),((2,65,85),-50),((2,65,86),-70),((2,65,87),-50),((2,65,89),-100),((2,65,117),-30),((2,65,118),-40),((2,65,119),-40),((2,65,121),-40),((2,65,233),-30),((2,66,44),-20),((2,66,46),-20),((2,66,85),-10),((2,67,44),-30),((2,67,46),-30),((2,68,44),-70),((2,68,46),-70),((2,68,65),-40),((2,68,86),-70),((2,68,87),-40),((2,68,89),-90),((2,70,44),-150),((2,70,46),-150),((2,70,65),-80),((2,70,97),-50),((2,70,101),-30),((2,70,111),-30),((2,70,114),-45),((2,70,249),-30),((2,74,44),-30),((2,74,46),-30),((2,74,65),-20),((2,74,97),-20),((2,74,117),-20),((2,75,79),-50),((2,75,101),-40),((2,75,111),-40),((2,75,117),-30),((2,75,121),-50),((2,75,233),-50),((2,75,249),-40),((2,76,39),-160),((2,76,84),-110),((2,76,86),-110),((2,76,87),-70),((2,76,89),-140),((2,76,121),-30),((2,76,186),-140),((2,79,44),-40),((2,79,46),-40),((2,79,65),-20),((2,79,84),-40),((2,79,86),-50),((2,79,87),-30),((2,79,88),-60),((2,79,89),-70),((2,80,44),-180),((2,80,46),-180),((2,80,65),-120),((2,80,97),-40),((2,80,101),-50),((2,80,111),-50),((2,80,249),-50),((2,81,85),-10),((2,82,79),-20),((2,82,84),-30),((2,82,85),-40),((2,82,86),-50),((2,82,87),-30),((2,82,89),-50),((2,82,233),-20),((2,83,44),-20),((2,83,46),-20),((2,84,44),-120),((2,84,45),-140),((2,84,46),-120),((2,84,58),-20),((2,84,59),-20),((2,84,65),-120),((2,84,79),-40),((2,84,97),-120),((2,84,101),-120),((2,84,111),-120),((2,84,114),-120),((2,84,117),-120),((2,84,119),-120),((2,84,121),-120),((2,84,233),-40),((2,84,249),-120),((2,85,44),-40),((2,85,46),-40),((2,85,65),-40),((2,86,44),-125),((2,86,45),-80),((2,86,46),-125),((2,86,58),-40),((2,86,59),-40),((2,86,65),-80),((2,86,71),-40),((2,86,79),-40),((2,86,97),-70),((2,86,101),-80),((2,86,111),-80),((2,86,117),-70),((2,86,233),-40),((2,86,249),-80),((2,87,44),-80),((2,87,45),-40),((2,87,46),-80),((2,87,65),-50),((2,87,79),-20),((2,87,97),-40),((2,87,101),-30),((2,87,111),-30),((2,87,117),-30),((2,87,121),-20),((2,87,233),-20),((2,87,249),-30),((2,89,44),-140),((2,89,45),-140),((2,89,46),-140),((2,89,58),-60),((2,89,59),-60),((2,89,65),-110),((2,89,79),-85),((2,89,97),-140),((2,89,101),-140),((2,89,105),-20),((2,89,111),-140),((2,89,117),-110),((2,89,233),-85),((2,89,249),-140),((2,96,96),-57),((2,97,118),-20),((2,97,119),-20),((2,97,121),-30),((2,98,44),-40),((2,98,46),-40),((2,98,98),-10),((2,98,108),-20),((2,98,117),-20),((2,98,118),-20),((2,98,121),-20),((2,98,248),-20),((2,99,44),-15),((2,99,107),-20),((2,101,44),-15),((2,101,46),-15),((2,101,118),-30),((2,101,119),-20),((2,101,120),-30),((2,101,121),-20),((2,102,39),50),((2,102,44),-30),((2,102,46),-30),((2,102,97),-30),((2,102,101),-30),((2,102,111),-30),((2,102,186),60),((2,102,245),-28),((2,102,249),-30),((2,103,114),-10),((2,104,121),-30),((2,107,101),-20),((2,107,111),-20),((2,107,249),-20),((2,109,117),-10),((2,109,121),-15),((2,110,117),-10),((2,110,118),-20),((2,110,121),-15),((2,111,44),-40),((2,111,46),-40),((2,111,118),-15),((2,111,119),-15),((2,111,120),-30),((2,111,121),-30),((2,112,44),-35),((2,112,46),-35),((2,112,121),-30),((2,114,44),-50),((2,114,46),-50),((2,114,58),30),((2,114,59),30),((2,114,97),-10),((2,114,105),15),((2,114,107),15),((2,114,108),15),((2,114,109),25),((2,114,110),25),((2,114,112),30),((2,114,116),40),((2,114,117),15),((2,114,118),30),((2,114,121),30),((2,114,248),15),((2,115,44),-15),((2,115,46),-15),((2,115,119),-30),((2,118,44),-80),((2,118,46),-80),((2,118,97),-25),((2,118,101),-25),((2,118,111),-25),((2,118,249),-25),((2,119,44),-60),((2,119,46),-60),((2,119,97),-15),((2,119,101),-10),((2,119,111),-10),((2,119,249),-10),((2,120,101),-30),((2,121,44),-100),((2,121,46),-100),((2,121,97),-20),((2,121,101),-20),((2,121,111),-20),((2,121,249),-20),((2,122,101),-15),((2,122,111),-15),((2,122,249),-15),((2,186,32),-40),((2,232,39),-160),((2,232,84),-110),((2,232,86),-110),((2,232,87),-70),((2,232,89),-140),((2,232,121),-30),((2,232,186),-140),((2,233,44),-40),((2,233,46),-40),((2,233,65),-20),((2,233,84),-40),((2,233,86),-50),((2,233,87),-30),((2,233,88),-60),((2,233,89),-70),((2,249,44),-95),((2,249,46),-95),((2,249,97),-55),((2,249,98),-55),((2,249,99),-55),((2,249,100),-55),((2,249,101),-55),((2,249,102),-55),((2,249,103),-55),((2,249,104),-55),((2,249,105),-55),((2,249,106),-55),((2,249,107),-55),((2,249,108),-55),((2,249,109),-55),((2,249,110),-55),((2,249,111),-55),((2,249,112),-55),((2,249,113),-55),((2,249,114),-55),((2,249,115),-55),((2,249,116),-55),((2,249,117),-55),((2,249,118),-70),((2,249,119),-70),((2,249,120),-85),((2,249,121),-70),((2,249,122),-55),((2,249,248),-55),((2,249,249),-55),((3,32,84),-100),((3,32,86),-80),((3,32,87),-80),((3,32,89),-120),((3,32,96),-60),((3,32,170),-80),((3,39,32),-80),((3,39,39),-46),((3,39,100),-80),((3,39,108),-20),((3,39,114),-40),((3,39,115),-60),((3,39,118),-20),((3,39,248),-20),((3,44,32),-40),((3,44,39),-120),((3,44,186),-120),((3,46,32),-40),((3,46,39),-120),((3,46,186),-120),((3,58,32),-40),((3,59,32),-40),((3,65,67),-40),((3,65,71),-50),((3,65,79),-40),((3,65,81),-40),((3,65,84),-90),((3,65,85),-50),((3,65,86),-80),((3,65,87),-60),((3,65,89),-110),((3,65,117),-30),((3,65,118),-40),((3,65,119),-30),((3,65,121),-30),((3,65,233),-40),((3,66,65),-30),((3,66,85),-10),((3,68,44),-30),((3,68,46),-30),((3,68,65),-40),((3,68,86),-40),((3,68,87),-40),((3,68,89),-70),((3,70,44),-100),((3,70,46),-100),((3,70,65),-80),((3,70,97),-20),((3,74,44),-20),((3,74,46),-20),((3,74,65),-20),((3,74,117),-20),((3,75,79),-30),((3,75,101),-15),((3,75,111),-35),((3,75,117),-30),((3,75,121),-40),((3,75,233),-30),((3,75,249),-35),((3,76,39),-140),((3,76,84),-90),((3,76,86),-110),((3,76,87),-80),((3,76,89),-120),((3,76,121),-30),((3,76,186),-140),((3,79,44),-40),((3,79,46),-40),((3,79,65),-50),((3,79,84),-40),((3,79,86),-50),((3,79,87),-50),((3,79,88),-50),((3,79,89),-70),((3,80,44),-120),((3,80,46),-120),((3,80,65),-100),((3,80,97),-30),((3,80,101),-30),((3,80,111),-40),((3,80,249),-40),((3,81,44),20),((3,81,46),20),((3,81,85),-10),((3,82,79),-20),((3,82,84),-20),((3,82,85),-20),((3,82,86),-50),((3,82,87),-40),((3,82,89),-50),((3,82,233),-20),((3,84,44),-80),((3,84,45),-120),((3,84,46),-80),((3,84,58),-40),((3,84,59),-40),((3,84,65),-90),((3,84,79),-40),((3,84,97),-80),((3,84,101),-60),((3,84,111),-80),((3,84,114),-80),((3,84,117),-90),((3,84,119),-60),((3,84,121),-60),((3,84,233),-40),((3,84,249),-80),((3,85,44),-30),((3,85,46),-30),((3,85,65),-50),((3,86,44),-120),((3,86,45),-80),((3,86,46),-120),((3,86,58),-40),((3,86,59),-40),((3,86,65),-80),((3,86,71),-50),((3,86,79),-50),((3,86,97),-60),((3,86,101),-50),((3,86,111),-90),((3,86,117),-60),((3,86,233),-50),((3,86,249),-90),((3,87,44),-80),((3,87,45),-40),((3,87,46),-80),((3,87,58),-10),((3,87,59),-10),((3,87,65),-60),((3,87,79),-20),((3,87,97),-40),((3,87,101),-35),((3,87,111),-60),((3,87,117),-45),((3,87,121),-20),((3,87,233),-20),((3,87,249),-60),((3,89,44),-100),((3,89,46),-100),((3,89,58),-50),((3,89,59),-50),((3,89,65),-110),((3,89,79),-70),((3,89,97),-90),((3,89,101),-80),((3,89,111),-100),((3,89,117),-100),((3,89,233),-70),((3,89,249),-100),((3,96,96),-46),((3,97,103),-10),((3,97,118),-15),((3,97,119),-15),((3,97,121),-20),((3,98,108),-10),((3,98,117),-20),((3,98,118),-20),((3,98,121),-20),((3,98,248),-10),((3,99,104),-10),((3,99,107),-20),((3,99,108),-20),((3,99,121),-10),((3,99,248),-20),((3,100,100),-10),((3,100,118),-15),((3,100,119),-15),((3,100,121),-15),((3,101,44),10),((3,101,46),20),((3,101,118),-15),((3,101,119),-15),((3,101,120),-15),((3,101,121),-15),((3,102,39),30),((3,102,44),-10),((3,102,46),-10),((3,102,101),-10),((3,102,111),-20),((3,102,186),30),((3,102,249),-20),((3,103,101),10),((3,103,103),-10),((3,104,121),-20),((3,107,111),-15),((3,107,249),-15),((3,108,119),-15),((3,108,121),-15),((3,109,117),-20),((3,109,121),-30),((3,110,117),-10),((3,110,118),-40),((3,110,121),-20),((3,111,118),-20),((3,111,119),-15),((3,111,120),-30),((3,111,121),-20),((3,112,121),-15),((3,114,44),-60),((3,114,45),-20),((3,114,46),-60),((3,114,99),-20),((3,114,100),-20),((3,114,103),-15),((3,114,111),-20),((3,114,113),-20),((3,114,115),-15),((3,114,116),20),((3,114,118),10),((3,114,121),10),((3,114,249),-20),((3,115,119),-15),((3,118,44),-80),((3,118,46),-80),((3,118,97),-20),((3,118,111),-30),((3,118,249),-30),((3,119,44),-40),((3,119,46),-40),((3,119,111),-20),((3,119,249),-20),((3,120,101),-10),((3,121,44),-80),((3,121,46),-80),((3,121,97),-30),((3,121,101),-10),((3,121,111),-25),((3,121,249),-25),((3,122,101),10),((3,186,32),-80),((3,232,39),-140),((3,232,84),-90),((3,232,86),-110),((3,232,87),-80),((3,232,89),-120),((3,232,121),-30),((3,232,186),-140),((3,233,44),-40),((3,233,46),-40),((3,233,65),-50),((3,233,84),-40),((3,233,86),-50),((3,233,87),-50),((3,233,88),-50),((3,233,89),-70),((3,248,119),-15),((3,248,121),-15),((3,249,118),-20),((3,249,119),-15),((3,249,120),-30),((3,249,121),-20),((4,32,65),-55),((4,32,84),-18),((4,32,86),-50),((4,32,87),-30),((4,32,89),-90),((4,39,32),-74),((4,39,39),-74),((4,39,100),-50),((4,39,108),-10),((4,39,114),-50),((4,39,115),-55),((4,39,116),-18),((4,39,118),-50),((4,39,248),-10),((4,44,39),-70),((4,44,186),-70),((4,46,39),-70),((4,46,186),-70),((4,65,39),-111),((4,65,67),-40),((4,65,71),-40),((4,65,79),-55),((4,65,81),-55),((4,65,84),-111),((4,65,85),-55),((4,65,86),-135),((4,65,87),-90),((4,65,89),-105),((4,65,118),-74),((4,65,119),-92),((4,65,121),-92),((4,65,233),-55),((4,66,65),-35),((4,66,85),-10),((4,68,65),-40),((4,68,86),-40),((4,68,87),-30),((4,68,89),-55),((4,70,44),-80),((4,70,46),-80),((4,70,65),-74),((4,70,97),-15),((4,70,111),-15),((4,70,249),-15),((4,74,65),-60),((4,75,79),-30),((4,75,101),-25),((4,75,111),-35),((4,75,117),-15),((4,75,121),-25),((4,75,233),-30),((4,75,249),-35),((4,76,39),-92),((4,76,84),-92),((4,76,86),-100),((4,76,87),-74),((4,76,89),-100),((4,76,121),-55),((4,78,65),-35),((4,79,65),-35),((4,79,84),-40),((4,79,86),-50),((4,79,87),-35),((4,79,88),-40),((4,79,89),-50),((4,80,44),-111),((4,80,46),-111),((4,80,65),-92),((4,80,97),-15),((4,81,85),-10),((4,82,79),-40),((4,82,84),-60),((4,82,85),-40),((4,82,86),-80),((4,82,87),-55),((4,82,89),-65),((4,82,233),-40),((4,84,44),-74),((4,84,45),-92),((4,84,46),-74),((4,84,58),-50),((4,84,59),-55),((4,84,65),-93),((4,84,79),-18),((4,84,97),-80),((4,84,101),-70),((4,84,105),-35),((4,84,111),-80),((4,84,114),-35),((4,84,117),-45),((4,84,119),-80),((4,84,121),-80),((4,84,233),-18),((4,84,249),-80),((4,85,65),-40),((4,86,44),-129),((4,86,45),-100),((4,86,46),-129),((4,86,58),-74),((4,86,59),-74),((4,86,65),-135),((4,86,71),-15),((4,86,79),-40),((4,86,97),-111),((4,86,101),-111),((4,86,105),-60),((4,86,111),-129),((4,86,117),-75),((4,86,233),-40),((4,86,249),-129),((4,87,44),-92),((4,87,45),-65),((4,87,46),-92),((4,87,58),-37),((4,87,59),-37),((4,87,65),-120),((4,87,79),-10),((4,87,97),-80),((4,87,101),-80),((4,87,105),-40),((4,87,111),-80),((4,87,117),-50),((4,87,121),-73),((4,87,233),-10),((4,87,249),-80),((4,89,44),-129),((4,89,45),-111),((4,89,46),-129),((4,89,58),-92),((4,89,59),-92),((4,89,65),-120),((4,89,79),-30),((4,89,97),-100),((4,89,101),-100),((4,89,105),-55),((4,89,111),-110),((4,89,117),-111),((4,89,233),-30),((4,89,249),-110),((4,96,65),-80),((4,96,96),-74),((4,97,118),-20),((4,97,119),-15),((4,98,46),-40),((4,98,117),-20),((4,98,118),-15),((4,99,121),-15),((4,101,103),-15),((4,101,118),-25),((4,101,119),-25),((4,101,120),-15),((4,101,121),-15),((4,102,39),55),((4,102,97),-10),((4,102,102),-25),((4,102,105),-20),((4,102,245),-50),((4,103,97),-5),((4,104,121),-5),((4,105,118),-25),((4,107,101),-10),((4,107,111),-10),((4,107,121),-15),((4,107,249),-10),((4,108,119),-10),((4,110,118),-40),((4,110,121),-15),((4,111,118),-15),((4,111,119),-25),((4,111,121),-10),((4,112,121),-10),((4,114,44),-40),((4,114,45),-20),((4,114,46),-55),((4,114,103),-18),((4,118,44),-65),((4,118,46),-65),((4,118,97),-25),((4,118,101),-15),((4,118,111),-20),((4,118,249),-20),((4,119,44),-65),((4,119,46),-65),((4,119,97),-10),((4,119,111),-10),((4,119,249),-10),((4,120,101),-15),((4,121,44),-65),((4,121,46),-65),((4,170,65),-80),((4,232,39),-92),((4,232,84),-92),((4,232,86),-100),((4,232,87),-74),((4,232,89),-100),((4,232,121),-55),((4,233,65),-35),((4,233,84),-40),((4,233,86),-50),((4,233,87),-35),((4,233,88),-40),((4,233,89),-50),((4,248,119),-10),((4,249,118),-15),((4,249,119),-25),((4,249,121),-10),((5,32,65),-55),((5,32,84),-30),((5,32,86),-45),((5,32,87),-30),((5,32,89),-55),((5,39,32),-74),((5,39,39),-63),((5,39,100),-20),((5,39,114),-20),((5,39,115),-37),((5,39,118),-20),((5,44,39),-55),((5,44,186),-45),((5,46,39),-55),((5,46,186),-55),((5,65,39),-74),((5,65,67),-55),((5,65,71),-55),((5,65,79),-45),((5,65,81),-45),((5,65,84),-95),((5,65,85),-50),((5,65,86),-145),((5,65,87),-130),((5,65,89),-100),((5,65,112),-25),((5,65,117),-50),((5,65,118),-100),((5,65,119),-90),((5,65,121),-74),((5,65,233),-45),((5,66,65),-30),((5,66,85),-10),((5,68,46),-20),((5,68,65),-35),((5,68,86),-40),((5,68,87),-40),((5,68,89),-40),((5,70,44),-92),((5,70,46),-110),((5,70,65),-90),((5,70,97),-25),((5,70,101),-25),((5,70,111),-25),((5,70,249),-25),((5,74,46),-20),((5,74,65),-30),((5,74,97),-15),((5,74,101),-15),((5,74,111),-15),((5,74,117),-15),((5,74,249),-15),((5,75,79),-30),((5,75,101),-25),((5,75,111),-25),((5,75,117),-15),((5,75,121),-45),((5,75,233),-30),((5,75,249),-25),((5,76,39),-110),((5,76,84),-92),((5,76,86),-92),((5,76,87),-92),((5,76,89),-92),((5,76,121),-55),((5,76,186),-20),((5,78,65),-20),((5,79,65),-40),((5,79,84),-40),((5,79,86),-50),((5,79,87),-50),((5,79,88),-40),((5,79,89),-50),((5,80,44),-92),((5,80,46),-110),((5,80,65),-74),((5,80,97),-10),((5,80,101),-20),((5,80,111),-20),((5,80,249),-20),((5,81,46),-20),((5,81,85),-10),((5,82,79),-30),((5,82,84),-40),((5,82,85),-30),((5,82,86),-55),((5,82,87),-35),((5,82,89),-35),((5,82,233),-30),((5,84,44),-74),((5,84,45),-92),((5,84,46),-90),((5,84,58),-74),((5,84,59),-74),((5,84,65),-90),((5,84,79),-18),((5,84,97),-92),((5,84,101),-92),((5,84,105),-18),((5,84,111),-92),((5,84,114),-74),((5,84,117),-92),((5,84,119),-74),((5,84,121),-34),((5,84,233),-18),((5,84,249),-92),((5,85,44),-50),((5,85,46),-50),((5,85,65),-60),((5,86,44),-129),((5,86,45),-74),((5,86,46),-145),((5,86,58),-92),((5,86,59),-92),((5,86,65),-135),((5,86,71),-30),((5,86,79),-45),((5,86,97),-92),((5,86,101),-100),((5,86,105),-37),((5,86,111),-100),((5,86,117),-92),((5,86,233),-45),((5,86,249),-100),((5,87,44),-92),((5,87,45),-37),((5,87,46),-92),((5,87,58),-55),((5,87,59),-55),((5,87,65),-120),((5,87,79),-10),((5,87,97),-65),((5,87,101),-65),((5,87,105),-18),((5,87,111),-75),((5,87,117),-50),((5,87,121),-60),((5,87,233),-10),((5,87,249),-75),((5,89,44),-92),((5,89,45),-92),((5,89,46),-92),((5,89,58),-92),((5,89,59),-92),((5,89,65),-110),((5,89,79),-35),((5,89,97),-85),((5,89,101),-111),((5,89,105),-37),((5,89,111),-111),((5,89,117),-92),((5,89,233),-35),((5,89,249),-111),((5,96,65),-10),((5,96,96),-63),((5,97,118),-25),((5,98,46),-40),((5,98,98),-10),((5,98,117),-20),((5,98,118),-15),((5,100,119),-15),((5,101,118),-15),((5,102,39),55),((5,102,44),-15),((5,102,46),-15),((5,102,105),-25),((5,102,111),-25),((5,102,186),50),((5,102,245),-35),((5,102,249),-25),((5,103,46),-15),((5,104,121),-15),((5,105,118),-10),((5,107,101),-10),((5,107,111),-15),((5,107,121),-15),((5,107,249),-15),((5,110,118),-40),((5,111,118),-10),((5,111,119),-10),((5,114,44),-92),((5,114,45),-37),((5,114,46),-100),((5,114,99),-18),((5,114,101),-18),((5,114,103),-10),((5,114,110),-15),((5,114,111),-18),((5,114,112),-10),((5,114,113),-18),((5,114,118),-10),((5,114,249),-18),((5,118,44),-55),((5,118,46),-70),((5,118,97),-10),((5,118,101),-10),((5,118,111),-10),((5,118,249),-10),((5,119,44),-55),((5,119,46),-70),((5,119,111),-10),((5,119,249),-10),((5,121,44),-55),((5,121,46),-70),((5,121,101),-10),((5,121,111),-25),((5,121,249),-25),((5,170,65),-10),((5,232,39),-110),((5,232,84),-92),((5,232,86),-92),((5,232,87),-92),((5,232,89),-92),((5,232,121),-55),((5,232,186),-20),((5,233,65),-40),((5,233,84),-40),((5,233,86),-50),((5,233,87),-50),((5,233,88),-40),((5,233,89),-50),((5,249,118),-10),((5,249,119),-10),((6,32,65),-18),((6,32,84),-18),((6,32,86),-35),((6,32,87),-40),((6,32,89),-75),((6,39,32),-111),((6,39,39),-111),((6,39,100),-25),((6,39,114),-25),((6,39,115),-40),((6,39,116),-30),((6,39,118),-10),((6,44,39),-140),((6,44,186),-140),((6,46,39),-140),((6,46,186),-140),((6,65,39),-37),((6,65,67),-30),((6,65,71),-35),((6,65,79),-40),((6,65,81),-40),((6,65,84),-37),((6,65,85),-50),((6,65,86),-105),((6,65,87),-95),((6,65,89),-55),((6,65,117),-20),((6,65,118),-55),((6,65,119),-55),((6,65,121),-55),((6,65,233),-40),((6,66,65),-25),((6,66,85),-10),((6,68,65),-35),((6,68,86),-40),((6,68,87),-40),((6,68,89),-40),((6,70,44),-135),((6,70,46),-135),((6,70,65),-115),((6,70,97),-75),((6,70,101),-75),((6,70,105),-45),((6,70,111),-105),((6,70,114),-55),((6,70,249),-105),((6,74,44),-25),((6,74,46),-25),((6,74,65),-40),((6,74,97),-35),((6,74,101),-25),((6,74,111),-25),((6,74,117),-35),((6,74,249),-25),((6,75,79),-50),((6,75,101),-35),((6,75,111),-40),((6,75,117),-40),((6,75,121),-40),((6,75,233),-50),((6,75,249),-40),((6,76,39),-37),((6,76,84),-20),((6,76,86),-55),((6,76,87),-55),((6,76,89),-20),((6,76,121),-30),((6,78,65),-27),((6,79,65),-55),((6,79,84),-40),((6,79,86),-50),((6,79,87),-50),((6,79,88),-40),((6,79,89),-50),((6,80,44),-135),((6,80,46),-135),((6,80,65),-90),((6,80,97),-80),((6,80,101),-80),((6,80,111),-80),((6,80,249),-80),((6,81,85),-10),((6,82,79),-40),((6,82,85),-40),((6,82,86),-18),((6,82,87),-18),((6,82,89),-18),((6,82,233),-40),((6,84,44),-74),((6,84,45),-74),((6,84,46),-74),((6,84,58),-55),((6,84,59),-65),((6,84,65),-50),((6,84,79),-18),((6,84,97),-92),((6,84,101),-92),((6,84,105),-55),((6,84,111),-92),((6,84,114),-55),((6,84,117),-55),((6,84,119),-74),((6,84,121),-74),((6,84,233),-18),((6,84,249),-92),((6,85,44),-25),((6,85,46),-25),((6,85,65),-40),((6,86,44),-129),((6,86,45),-55),((6,86,46),-129),((6,86,58),-65),((6,86,59),-74),((6,86,65),-60),((6,86,79),-30),((6,86,97),-111),((6,86,101),-111),((6,86,105),-74),((6,86,111),-111),((6,86,117),-74),((6,86,233),-30),((6,86,249),-111),((6,87,44),-92),((6,87,45),-37),((6,87,46),-92),((6,87,58),-65),((6,87,59),-65),((6,87,65),-60),((6,87,79),-25),((6,87,97),-92),((6,87,101),-92),((6,87,105),-55),((6,87,111),-92),((6,87,117),-55),((6,87,121),-70),((6,87,233),-25),((6,87,249),-92),((6,89,44),-92),((6,89,45),-74),((6,89,46),-92),((6,89,58),-65),((6,89,59),-65),((6,89,65),-50),((6,89,79),-15),((6,89,97),-92),((6,89,101),-92),((6,89,105),-74),((6,89,111),-92),((6,89,117),-92),((6,89,233),-15),((6,89,249),-92),((6,96,96),-111),((6,97,103),-10),((6,98,46),-40),((6,98,117),-20),((6,99,104),-15),((6,99,107),-20),((6,101,44),-10),((6,101,46),-15),((6,101,103),-40),((6,101,118),-15),((6,101,119),-15),((6,101,120),-20),((6,101,121),-30),((6,102,39),92),((6,102,44),-10),((6,102,46),-15),((6,102,102),-18),((6,102,105),-20),((6,102,245),-60),((6,103,44),-10),((6,103,46),-15),((6,103,101),-10),((6,103,103),-10),((6,107,101),-10),((6,107,111),-10),((6,107,121),-10),((6,107,249),-10),((6,110,118),-40),((6,111,103),-10),((6,111,118),-10),((6,114,44),-111),((6,114,45),-20),((6,114,46),-111),((6,114,97),-15),((6,114,99),-37),((6,114,100),-37),((6,114,101),-37),((6,114,103),-37),((6,114,111),-45),((6,114,113),-37),((6,114,115),-10),((6,114,249),-45),((6,118,44),-74),((6,118,46),-74),((6,119,44),-74),((6,119,46),-74),((6,121,44),-55),((6,121,46),-55),((6,232,39),-37),((6,232,84),-20),((6,232,86),-55),((6,232,87),-55),((6,232,89),-20),((6,232,121),-30),((6,233,65),-55),((6,233,84),-40),((6,233,86),-50),((6,233,87),-50),((6,233,88),-40),((6,233,89),-50),((6,249,103),-10),((6,249,118),-10),((7,32,65),-37),((7,32,86),-70),((7,32,87),-70),((7,32,89),-70),((7,39,32),-74),((7,39,39),-74),((7,39,100),-15),((7,39,114),-15),((7,39,115),-74),((7,39,116),-37),((7,39,118),-15),((7,44,39),-95),((7,44,186),-95),((7,46,39),-95),((7,46,186),-95),((7,65,39),-74),((7,65,67),-65),((7,65,71),-60),((7,65,79),-50),((7,65,81),-55),((7,65,84),-55),((7,65,85),-50),((7,65,86),-95),((7,65,87),-100),((7,65,89),-70),((7,65,117),-30),((7,65,118),-74),((7,65,119),-74),((7,65,121),-74),((7,65,233),-50),((7,66,65),-25),((7,66,85),-10),((7,68,65),-25),((7,68,86),-50),((7,68,87),-40),((7,68,89),-50),((7,70,44),-129),((7,70,46),-129),((7,70,65),-100),((7,70,97),-95),((7,70,101),-100),((7,70,105),-40),((7,70,111),-70),((7,70,114),-50),((7,70,249),-70),((7,74,44),-10),((7,74,46),-10),((7,74,65),-25),((7,74,97),-40),((7,74,101),-40),((7,74,111),-40),((7,74,117),-40),((7,74,249),-40),((7,75,79),-30),((7,75,101),-25),((7,75,111),-25),((7,75,117),-20),((7,75,121),-20),((7,75,233),-30),((7,75,249),-25),((7,76,39),-55),((7,76,84),-18),((7,76,86),-37),((7,76,87),-37),((7,76,89),-37),((7,76,121),-37),((7,78,65),-30),((7,79,65),-40),((7,79,84),-40),((7,79,86),-50),((7,79,87),-50),((7,79,88),-40),((7,79,89),-50),((7,80,44),-129),((7,80,46),-129),((7,80,65),-85),((7,80,97),-40),((7,80,101),-50),((7,80,111),-55),((7,80,249),-55),((7,81,85),-10),((7,82,79),-40),((7,82,84),-30),((7,82,85),-40),((7,82,86),-18),((7,82,87),-18),((7,82,89),-18),((7,82,233),-40),((7,84,44),-92),((7,84,45),-92),((7,84,46),-92),((7,84,58),-74),((7,84,59),-74),((7,84,65),-55),((7,84,79),-18),((7,84,97),-92),((7,84,101),-92),((7,84,105),-37),((7,84,111),-95),((7,84,114),-37),((7,84,117),-37),((7,84,119),-37),((7,84,121),-37),((7,84,233),-18),((7,84,249),-95),((7,85,65),-45),((7,86,44),-129),((7,86,45),-70),((7,86,46),-129),((7,86,58),-74),((7,86,59),-74),((7,86,65),-85),((7,86,71),-10),((7,86,79),-30),((7,86,97),-111),((7,86,101),-111),((7,86,105),-55),((7,86,111),-111),((7,86,117),-55),((7,86,233),-30),((7,86,249),-111),((7,87,44),-74),((7,87,45),-50),((7,87,46),-74),((7,87,58),-55),((7,87,59),-55),((7,87,65),-74),((7,87,79),-15),((7,87,97),-85),((7,87,101),-90),((7,87,105),-37),((7,87,111),-80),((7,87,117),-55),((7,87,121),-55),((7,87,233),-15),((7,87,249),-80),((7,89,44),-92),((7,89,45),-92),((7,89,46),-74),((7,89,58),-92),((7,89,59),-92),((7,89,65),-74),((7,89,79),-25),((7,89,97),-92),((7,89,101),-111),((7,89,105),-55),((7,89,111),-111),((7,89,117),-92),((7,89,233),-25),((7,89,249),-111),((7,96,96),-74),((7,98,46),-40),((7,98,98),-10),((7,98,117),-20),((7,99,104),-10),((7,99,107),-10),((7,101,98),-10),((7,102,39),55),((7,102,44),-10),((7,102,46),-10),((7,102,101),-10),((7,102,102),-18),((7,102,111),-10),((7,102,245),-30),((7,102,249),-10),((7,107,101),-30),((7,107,111),-10),((7,107,249),-10),((7,110,118),-40),((7,111,118),-15),((7,111,119),-25),((7,111,120),-10),((7,111,121),-10),((7,114,44),-65),((7,114,46),-65),((7,118,44),-37),((7,118,46),-37),((7,118,101),-15),((7,118,111),-15),((7,118,249),-15),((7,119,44),-37),((7,119,46),-37),((7,119,97),-10),((7,119,101),-10),((7,119,111),-15),((7,119,249),-15),((7,120,101),-10),((7,121,44),-37),((7,121,46),-37),((7,232,39),-55),((7,232,84),-18),((7,232,86),-37),((7,232,87),-37),((7,232,89),-37),((7,232,121),-37),((7,233,65),-40),((7,233,84),-40),((7,233,86),-50),((7,233,87),-50),((7,233,88),-40),((7,233,89),-50),((7,249,118),-15),((7,249,119),-25),((7,249,120),-10),((7,249,121),-10)] diff --git a/Graphics/PDF/LowLevel/Types.hs b/Graphics/PDF/LowLevel/Types.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/LowLevel/Types.hs @@ -0,0 +1,223 @@ +--------------------------------------------------------- +-- | +-- 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.ByteString.Lazy as B +import Data.ByteString.Base(c2w) +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.UTF8 +import Data.Encoding.ISO88591 + +-- | PDF Objects +class PdfObject a where + toPDF :: a -> B.ByteString + +-- | 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) + +instance Show PDFFloat where + show (PDFFloat x) = printf "%.5f" x + +instance PdfObject PDFInteger where + toPDF (PDFInteger a) = toByteString (show a) + +instance PdfObject PDFLength where + toPDF (PDFLength a) = toByteString (show a) + +instance PdfObject PDFFloat where + toPDF (PDFFloat a) = toByteString (show a) + +instance PdfObject Bool where + toPDF (True) = toByteString "true" + toPDF (False) = toByteString "false" + +-- | A PDFString +newtype PDFString = PDFString B.ByteString deriving(Eq,Ord) + +-- | Create a PDF string from an Haskell one +toPDFString :: String -> PDFString +toPDFString = PDFString . encodeLazy ISO88591 . escapeString + +-- | Convert an Haskell string to an UTF8 encoded bytestring +toByteString :: String -> B.ByteString +--toByteString = B.pack . encode +toByteString = encodeLazy UTF8 + +-- | 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 :: B.ByteString +lparen = B.singleton . c2w $ '(' + +rparen :: B.ByteString +rparen = B.singleton . c2w $ ')' + +lbracket :: B.ByteString +lbracket = B.singleton . c2w $ '[' + +rbracket :: B.ByteString +rbracket = B.singleton . c2w $ ']' + +bspace :: B.ByteString +bspace = B.singleton . c2w $ ' ' + +blt :: B.ByteString +blt = B.singleton . c2w $ '<' + +bgt :: B.ByteString +bgt = B.singleton . c2w $ '>' + +newline :: B.ByteString +newline = B.singleton . c2w $ '\n' + +noPdfObject :: B.ByteString +noPdfObject = B.empty + +instance PdfObject PDFString where + toPDF (PDFString a) = B.concat [ lparen + , a + , rparen + ] + +-- | A PDFName object +newtype PDFName = PDFName String deriving(Eq,Ord) + +instance PdfObject PDFName where + toPDF (PDFName a) = toByteString ("/" ++ a) + +-- | A PDFArray +type PDFArray = [AnyPdfObject] + +instance PdfObject PDFArray where + toPDF l = B.concat $ (lbracket:intersperse bspace (map toPDF l)) ++ [bspace] ++ [rbracket] + +-- | A PDFDictionary + +newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject) + +instance PdfObject PDFDictionary where + toPDF (PDFDictionary a) = B.concat $ [blt,blt,newline] + ++ [convertLevel a] + ++ [bgt,bgt] + where + convertLevel _ = let convertItem key value current = B.concat $ [ toPDF key + , bspace + , toPDF value + , newline + , current + ] + + in + M.foldWithKey convertItem B.empty 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) = + B.concat $ [ toByteString . show $ referenceId + , toByteString " 0 obj" + , newline + , toPDF obj + , newline + , toByteString "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) = B.concat $ [ toByteString . show $ i + , toByteString " 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 B.ByteString m => MonadPath m diff --git a/Graphics/PDF/Navigation.hs b/Graphics/PDF/Navigation.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Navigation.hs @@ -0,0 +1,129 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Navigation +--------------------------------------------------------- + +module Graphics.PDF.Navigation( + -- * Navigation + -- ** Types + OutlineStyle(..) + -- ** Functions + , newSection + , newSectionWithPage + ) where + +import Graphics.PDF.Pages +import Graphics.PDF.Draw +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Colors(Color(..)) +import Control.Monad.State(gets) +import Control.Monad(when) +import Data.Maybe(isNothing) + +-- | True if we are adding the first outline to this level +isFirst :: [Bool] -> Bool +isFirst r = head r + +-- | Start a new outline level +startNew :: PDF () +startNew = modifyStrict $ \s -> s{firstOutline = True:(firstOutline s)} + +-- | We remember there are outlines at this level +addedOutline :: PDF () +addedOutline = modifyStrict $ \s -> s{firstOutline = False:tail (firstOutline s)} + +-- | Close an outline level +closeNew :: PDF() +closeNew = do + r <- gets firstOutline + when (not (isFirst r)) $ moveToParent + modifyStrict $ \s -> s{firstOutline = tail (firstOutline s)} + +-- | Create a new outline section pointing to the last created page +newSection :: PDFString -- ^ Outline title + -> Maybe Color -- ^ Outline color + -> Maybe OutlineStyle -- ^Outline style + -> PDF () + -> PDF () +newSection myS col style p = newSectionPrivate myS col style Nothing p + +-- | Create a new outline section pointing to a given page +newSectionWithPage :: PDFString -- ^ Outline title + -> Maybe Color -- ^ Outline color + -> Maybe OutlineStyle -- ^ Outline style + -> PDFReference PDFPage -- ^ Page reference + -> PDF () + -> PDF () +newSectionWithPage myS col style page p = newSectionPrivate myS col style (Just page) p + +newSectionPrivate :: PDFString -- ^ Outline title + -> Maybe Color -- ^ Outline color + -> Maybe OutlineStyle -- ^Outline style + -> Maybe (PDFReference PDFPage) + -> PDF () + -> PDF () +newSectionPrivate myS col style page p = do + let newlevel = do + startNew + p + closeNew + r <- gets firstOutline + if isFirst r + then do + if length r > 1 + then do + newChild myS col style page + addedOutline + newlevel + else do + newSibling myS col style page + newlevel + else do + newSibling myS col style page + newlevel + +newSibling :: PDFString -- ^ Outline title + -> Maybe Color -- ^ Outline color + -> Maybe OutlineStyle -- ^Outline style + -> Maybe (PDFReference PDFPage) + -> PDF () +newSibling myS col style page = do + p <- if isNothing page then gets currentPage else return page + case p of + Nothing -> return () + Just aPage -> do + ot <- gets outline + let myValue = (myS,col,style,Destination aPage) + case ot of + Nothing -> modifyStrict $ \s -> s {outline = Just $ insertDown myValue (OutlineLoc (Node myValue []) Top)} + Just r -> modifyStrict $ \s -> s {outline = Just $ insertRight myValue r} + +newChild :: PDFString -- ^ Outline title + -> Maybe Color -- ^ Outline color + -> Maybe OutlineStyle -- ^Outline style + -> Maybe (PDFReference PDFPage) + -> PDF () +newChild myS col style page = do + p <- if isNothing page then gets currentPage else return page + case p of + Nothing -> return () + Just aPage -> do + ot <- gets outline + let myValue = (myS,col,style,Destination aPage) + case ot of + Nothing -> modifyStrict $ \s -> s {outline = Just $ insertDown myValue (OutlineLoc (Node myValue []) Top)} + Just r -> modifyStrict $ \s -> s {outline = Just $ insertDown myValue r} + +moveToParent :: PDF () +moveToParent = do + ot <- gets outline + case ot of + Nothing -> return () + Just r -> modifyStrict $ \s -> s {outline = Just $ up r} diff --git a/Graphics/PDF/Pages.hs b/Graphics/PDF/Pages.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Pages.hs @@ -0,0 +1,266 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2006 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- Low level page management +--------------------------------------------------------- +-- #hide +module Graphics.PDF.Pages( + -- * Low level stuff + -- ** Document management + standardViewerPrefs + -- ** Page management + , findPage + , recordPage + , noPages + , addPages + , getCurrentPage + -- ** PDF Object management + , addObject + , supply + , updateObject + , addOutlines + , insertDown + , insertRight + , up + , createContent + , recordBound + , setPageResource + , setPageAnnotations + ) where + +import qualified Data.IntMap as IM +import Control.Monad.State +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import qualified Graphics.PDF.Data.PDFTree as PT hiding(PDFTree,Key) +import Graphics.PDF.Resources +import Data.List(zip4) + +import Graphics.PDF.Data.PDFTree(PDFTree,Key) + +-- | Set page annotations +setPageAnnotations :: [AnyAnnotation] -> PDFReference PDFPage -> PDF () +setPageAnnotations an page = do + -- Get the page dictionary + lPages <- gets pages + -- Look for the page + let thePage = findPage page lPages + case thePage of + Nothing -> return () + -- If the page is found, get its stream reference and look for the stream + Just (PDFPage a b c d e f _) -> do + refs <- mapM (\x -> addAnnotation x >>= return . AnyPdfObject) an + modifyStrict $ \s -> s {pages = recordPage page (PDFPage a b c d e f refs) lPages} + +-- | Set page resource +setPageResource :: PDFReference PDFResource -> PDFReference PDFPage -> PDF () +setPageResource newr page = do + -- Get the page dictionary + lPages <- gets pages + -- Look for the page + let thePage = findPage page lPages + case thePage of + Nothing -> return () + -- If the page is found, get its stream reference and look for the stream + Just (PDFPage a b c _ e f g) -> modifyStrict $ \s -> s {pages = recordPage page (PDFPage a b c (Just newr) e f g) lPages} + + +-- | Create a new empty content for a page +createContent :: Draw a -- ^ List of drawing commands + -> Maybe (PDFReference PDFPage) + -> PDF (PDFReference PDFStream) -- ^ Reference to the drawing +createContent d page = do + -- Create a new stream referenbce + streamref <- supply + modifyStrict $ \s -> s {streams = IM.insert streamref (page,d >> return ()) (streams s)} + return (PDFReference streamref) + +-- | Returns a new unique identifier +supply :: PDF Int +supply = do + r <- gets supplySrc + modifyStrict $ \s -> s {supplySrc = r+1} + return r + +-- | Add an object to the PDF object dictionary and return a PDF reference +addObject :: (PdfObject a) => a -> PDF (PDFReference a) +addObject a = do + r <- supply + modifyStrict $ \s -> s {objects = IM.insert r (AnyPdfObject a) (objects s)} + return (PDFReference r) + + +-- | Update a referenced object with a new one +updateObject :: (PdfObject a) => PDFReference a -- ^ Reference to the initial object + -> a -- ^ New value + -> PDF () +updateObject (PDFReference i) obj = do + modifyStrict $ \s -> s {objects = IM.insert i (AnyPdfObject obj) (objects s)} + + + + + +standardViewerPrefs :: PDFViewerPreferences +standardViewerPrefs = PDFViewerPreferences False False False False False False UseNone + + + + + + + +-- | Record the page in the page catalog +recordPage :: PDFReference PDFPage -- ^ Reference to the page + -> PDFPage -- ^ Page content + -> Pages -- ^ Pages n the documents + -> Pages +recordPage pageref page (Pages lPages) = Pages (PT.insert pageref page lPages) + +-- | Find a page in the catalog +findPage :: PDFReference PDFPage -- ^ Reference to the page + -> Pages -- ^ Pages in the document + -> Maybe PDFPage -- ^ Page content if found +findPage page (Pages lPages) = PT.lookup page lPages + +-- | Add a node PDFTree object +nodePage :: Maybe (PDFReference PDFPages) -- ^ Parent node + -> PDFTree PDFPage -- ^ Left tree + -> PDFTree PDFPage -- ^ Right tree + -> PDF (Int,PDFReference PDFPages) -- ^ PDF reference to the new node pointing to the left and right ones +nodePage ref l r = do + n <- supply + -- Reserve an identifier for the root page object + let pRef = (PDFReference n) :: PDFReference PDFPages + (sl,lr) <- PT.fold2 (Just pRef) nodePage leafPage l + (sr,rr) <- PT.fold2 (Just pRef) nodePage leafPage r + let len = sl + sr + case (PT.isLeaf l,PT.isLeaf r) of + (False,False) -> updateObject pRef $ PDFPages len ref [Left lr,Left rr] + (True,False) -> updateObject pRef $ PDFPages len ref [Right (PT.keyOf l),Left rr] + (False,True) -> updateObject pRef $ PDFPages len ref [Left lr,Right (PT.keyOf r)] + (True,True) -> updateObject pRef $ PDFPages len ref [Right (PT.keyOf l),Right (PT.keyOf r)] + return (len,pRef) + + +-- | Add a page to the PDG object dictionary +leafPage :: Maybe (PDFReference PDFPages) -- ^ Page parent if any + -> Key PDFPage -- ^ Page reference + -> PDFPage -- ^ Page data + -> PDF (Int,PDFReference PDFPages) -- ^ Reference to a PDFPages objects +leafPage (Just ref) (PDFReference objectnb) (PDFPage _ a b c d e f) = do + modifyStrict $ \s -> s {objects = IM.insert objectnb (AnyPdfObject $ PDFPage (Just ref) a b c d e f) (objects s) } + return (1,ref) + +leafPage Nothing p@(PDFReference objectnb) (PDFPage _ a b c d e f) = do + n <- supply + -- Reserve an identifier for the root page object + let pRef = (PDFReference n) :: PDFReference PDFPages + updateObject pRef $ PDFPages 1 Nothing [Right p] + modifyStrict $ \s -> s {objects = IM.insert objectnb (AnyPdfObject $ PDFPage (Just pRef) a b c d e f) (objects s) } + return (1,pRef) + +-- | Add all pages to the PDF object dictionary +addPages :: PDF (PDFReference PDFPages) +addPages = do + Pages lPages <- gets pages + (_,r) <- PT.fold2 Nothing nodePage leafPage lPages + return r + +-- | Empty page catalog +noPages :: Pages +noPages = Pages (PT.empty) + + +-- insert a subtree to the right of the current node +insertRight :: a -> OutlineLoc a -> OutlineLoc a +insertRight _ (OutlineLoc _ Top) = error "Cannot insert right of the top node" +insertRight t' (OutlineLoc t c ) = let c' = Child { value = value c + , parent = parent c + , rights = rights c + , lefts = lefts c ++ [t] } + in OutlineLoc (Node t' []) c' + +insertDown :: a -> OutlineLoc a -> OutlineLoc a +insertDown t' (OutlineLoc (Node v cs) c) = let c' = Child { value = v + , parent = c + , rights = [] + , lefts = cs + } + in OutlineLoc (Node t' []) c' + +-- move up +up :: OutlineLoc a -> OutlineLoc a +up (OutlineLoc _ Top ) = error "Cannot go up from the top node" +up (OutlineLoc t (Child v c ls rs)) = let t' = Node v (ls ++ [t] ++ rs) + in OutlineLoc t' c + + +addOutlines :: Maybe Outline -> PDF (Maybe (PDFReference PDFOutline)) +addOutlines Nothing = return Nothing +addOutlines (Just r) = do + let (Node _ l) = toTree r + if null l + then return Nothing + else do + rootRef <- supply + (first,end) <- createOutline (PDFReference rootRef) l + let outlineCatalog = PDFOutline first end + updateObject (PDFReference rootRef) outlineCatalog + return (Just (PDFReference rootRef)) + + +createOutline :: PDFReference PDFOutlineEntry -> [Tree OutlineData] -> PDF (PDFReference PDFOutlineEntry,PDFReference PDFOutlineEntry) +createOutline r children = do + -- Get references for all these outlines + refs' <- mapM (const (supply >>= return . Just . PDFReference)) children + -- (previousRef, currentRef, currentNode, nextRef) + let refs = zip4 (Nothing : init refs') refs' children (tail refs' ++ [Nothing]) + current (_,c,_,_) = c + Just first = current (head refs) + Just end = current (last refs) + mapM_ (addEntry first end) refs + return (first,end) + where + addEntry _ _ (_,Nothing,_,_) = error "This pattern match in addEntry should never occur !" + addEntry _ _ (prev,Just current,Node (title,col,style,dest) c,next) = do + (f,e) <- if (null c) + then + return (Nothing,Nothing) + else + createOutline current c >>= \(x,y) -> return (Just x,Just y) + let o = PDFOutlineEntry title + r -- Parent + prev -- Prev + next + f + e + (-(length c)) + dest + (maybe (Rgb 0 0 0) id col) + (maybe Normal id style) + updateObject current o + + +toTree :: OutlineLoc a -> Tree a +toTree (OutlineLoc a Top) = a +toTree a = toTree (up a) + + +-- | Reference to the last created page +getCurrentPage :: PDF (Maybe (PDFReference PDFPage)) +getCurrentPage = gets currentPage + +-- | Record bound of an xobject +recordBound :: Int -- ^ Reference + -> PDFFloat -- ^ Width + -> PDFFloat -- ^ Height + -> PDF () +recordBound ref width height = modifyStrict $ \s -> s {xobjectBound = IM.insert ref (width,height) (xobjectBound s)} + diff --git a/Graphics/PDF/Pattern.hs b/Graphics/PDF/Pattern.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Pattern.hs @@ -0,0 +1,139 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Patterns +--------------------------------------------------------- + +module Graphics.PDF.Pattern( + -- * Pattern + TilingType(..) + , PDFColoredPattern + , PDFUncoloredPattern + , createColoredTiling + , createUncoloredTiling + , setColoredFillPattern + , setColoredStrokePattern + , setUncoloredFillPattern + , setUncoloredStrokePattern + ) where + +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import Graphics.PDF.Resources +import qualified Data.Map as M +import Graphics.PDF.Pages(recordBound,createContent) +import Control.Monad.State + +data PaintType = ColoredTiling + | UncoloredTiling + deriving(Eq,Enum) + +-- | Tiling type +data TilingType = ConstantSpacing + | NoDistortion + | ConstantSpacingAndFaster + deriving(Eq,Enum) + +-- | Create a colored tiling pattern +createColoredTiling :: PDFFloat -- ^ Left + -> PDFFloat -- ^ Bottom + -> PDFFloat -- ^ Right + -> PDFFloat -- ^ Top + -> PDFFloat -- ^ Horizontal step + -> PDFFloat -- ^ Vertical step + -> TilingType + -> Draw a -- ^ Drawing commands + -> PDF (PDFReference PDFColoredPattern) +createColoredTiling xa ya xb yb hstep vstep tt d = createTilingPattern xa ya xb yb hstep vstep ColoredTiling tt d >>= return . PDFReference + +-- | Create an uncolored tiling pattern +createUncoloredTiling :: PDFFloat -- ^ Left + -> PDFFloat -- ^ Bottom + -> PDFFloat -- ^ Right + -> PDFFloat -- ^ Top + -> PDFFloat -- ^ Horizontal step + -> PDFFloat -- ^ Vertical step + -> TilingType + -> Draw a -- ^ Drawing commands + -> PDF (PDFReference PDFUncoloredPattern) +createUncoloredTiling xa ya xb yb hstep vstep tt d = createTilingPattern xa ya xb yb hstep vstep UncoloredTiling tt d >>= return . PDFReference + +-- | Create a PDF tiling pattern +createTilingPattern :: PDFFloat -- ^ Left + -> PDFFloat -- ^ Bottom + -> PDFFloat -- ^ Right + -> PDFFloat -- ^ Top + -> PDFFloat -- ^ Horizontal step + -> PDFFloat -- ^ Vertical step + -> PaintType + -> TilingType + -> Draw a -- ^ Drawing commands + -> PDF Int +createTilingPattern xa ya xb yb hstep vstep pt tt d = + let a' = do modifyStrict $ \s -> s {otherRsrcs = PDFDictionary. M.fromList $ + [ (PDFName "Type",AnyPdfObject . PDFName $ "Pattern") + , (PDFName "PatternType",AnyPdfObject . PDFInteger $ 1) + , (PDFName "PaintType",AnyPdfObject . PDFInteger $ (fromEnum pt) + 1) + , (PDFName "TilingType",AnyPdfObject . PDFInteger $ (fromEnum tt) + 1) + , (PDFName "Matrix",AnyPdfObject . (map (AnyPdfObject . PDFInteger)) $ [1,0,0,1,0,0]) + , (PDFName "BBox",AnyPdfObject . map AnyPdfObject $ [xa,ya,xb,yb]) + , (PDFName "XStep",AnyPdfObject hstep) + , (PDFName "YStep",AnyPdfObject vstep) + ] + } + d + in do + PDFReference s <- createContent a' Nothing + recordBound s (xb-xa) (yb-ya) + return s + + +-- | Set the fill pattern +setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw () +setColoredFillPattern (PDFReference a) = do + patternMap <- gets patterns + (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap + modifyStrict $ \s -> s { patterns = newMap } + writeCmd ("\n/Pattern cs") + writeCmd ("\n/" ++ newName ++ " scn") + +-- | Set the stroke pattern +setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw () +setColoredStrokePattern (PDFReference a) = do + patternMap <- gets patterns + (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap + modifyStrict $ \s -> s { patterns = newMap } + writeCmd ("\n/Pattern CS") + writeCmd ("\n/" ++ newName ++ " SCN") + + + +-- | Set the fill pattern +setUncoloredFillPattern :: PDFReference PDFUncoloredPattern -> Color -> Draw () +setUncoloredFillPattern (PDFReference a) col = do + let (r,g,b) = getRgbColor col + colorMap <- gets colorSpaces + (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap + patternMap <- gets patterns + (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap + modifyStrict $ \s -> s { patterns = newMap } + writeCmd ("\n/" ++ newColorName ++ " cs") + writeCmd ("\n" ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ " /" ++ newName ++ " scn") + +-- | Set the stroke pattern +setUncoloredStrokePattern :: PDFReference PDFUncoloredPattern -> Color -> Draw () +setUncoloredStrokePattern (PDFReference a) col = do + let (r,g,b) = getRgbColor col + colorMap <- gets colorSpaces + (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap + patternMap <- gets patterns + (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap + modifyStrict $ \s -> s { patterns = newMap } + writeCmd ("\n/" ++ newColorName ++ " CS") + writeCmd ("\n" ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ " /" ++ newName ++ " SCN") diff --git a/Graphics/PDF/Resources.hs b/Graphics/PDF/Resources.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Resources.hs @@ -0,0 +1,156 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2006 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Resources +--------------------------------------------------------- +-- #hide +module Graphics.PDF.Resources( + PDFResource(..) + , addResource + , emptyRsrc + , StrokeAlpha(..) + , FillAlpha(..) + , PdfResourceObject(..) + , PDFFont(..) + , FontName(..) + , resourceToDict + , emptyResource + , PDFColoredPattern + , PDFUncoloredPattern + , AnyPdfPattern + , PDFColorSpace(..) + ) where + +import Graphics.PDF.LowLevel.Types +import qualified Data.Map as M + +-- Fonts +type FontSize = Int +data FontName = Helvetica + | Helvetica_Bold + | Helvetica_Oblique + | Helvetica_BoldOblique + | Times_Roman + | Times_Bold + | Times_Italic + | Times_BoldItalic + | Courier + | Courier_Bold + | Courier_Oblique + | Courier_BoldOblique + | Symbol + | ZapfDingbats + deriving(Eq,Ord,Enum) + +instance Show FontName where + show Helvetica = "Helvetica" + show Helvetica_Bold = "Helvetica-Bold" + show Helvetica_Oblique = "Helvetica-Oblique" + show Helvetica_BoldOblique = "Helvetica-BoldOblique" + show Times_Roman = "Times-Roman" + show Times_Bold = "Times-Bold" + show Times_Italic = "Times-Italic" + show Times_BoldItalic = "Times-BoldItalic" + show Courier = "Courier" + show Courier_Bold = "Courier-Bold" + show Courier_Oblique = "Courier-Oblique" + show Courier_BoldOblique = "Courier-BoldOblique" + show Symbol = "Symbol" + show ZapfDingbats = "ZapfDingbats" + +data PDFFont = PDFFont FontName FontSize deriving(Eq) + +instance Ord PDFFont where + compare (PDFFont na sa) (PDFFont nb sb) = if sa == sb then compare na nb else compare sa sb + +instance PdfResourceObject PDFFont where + toRsrc (PDFFont f _) = AnyPdfObject . PDFDictionary . M.fromList $ + [(PDFName "Type",AnyPdfObject . PDFName $ "Font") + , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1") + , (PDFName "BaseFont",AnyPdfObject . PDFName $ show f) + , (PDFName "Encoding",AnyPdfObject . PDFName $ "WinAnsiEncoding")] + +newtype StrokeAlpha = StrokeAlpha Double deriving(Eq,Ord) +instance PdfResourceObject StrokeAlpha where + toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject . PDFFloat $ a)] + +newtype FillAlpha = FillAlpha Double deriving(Eq,Ord) +instance PdfResourceObject FillAlpha where + toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject . PDFFloat $ a)] + +class PdfResourceObject a where + toRsrc :: a -> AnyPdfObject + + +-- | A PDF Resource +data PDFResource = PDFResource { + procSet :: !PDFArray + , resources :: M.Map PDFName PDFDictionary + } + + +emptyRsrc :: PDFResource +--emptyRsrc = PDFResource [AnyPdfObject . PDFName $ "PDF"] (M.empty) +emptyRsrc = PDFResource [] (M.empty) + +getResources :: M.Map PDFName PDFDictionary -> [(PDFName,AnyPdfObject)] +getResources = M.toList . M.map AnyPdfObject + +instance PdfObject PDFResource where + toPDF r = toPDF . resourceToDict $ r + +-- | Add a new G State to the G State dictionary for the given resource +addResource :: PDFName -- ^ GState dictionary + -> PDFName -- ^ GState name must be unique + -> AnyPdfObject -- ^ G State content + -> PDFResource -- ^ Old resource + -> PDFResource -- ^ New resource +addResource dict name newValue r = let addValue (Just (PDFDictionary a)) = Just . PDFDictionary $ M.insert name newValue a + addValue (Nothing) = Just . PDFDictionary $ M.insert name newValue M.empty + in + r {resources = M.alter addValue dict (resources r)} + +-- | Convert the resource to a PDf dictionary +resourceToDict :: PDFResource -> PDFDictionary +resourceToDict r = PDFDictionary . M.fromList $ + --[(PDFName "ProcSet",AnyPdfObject (procSet r))] ++ + getResources (resources r) + +emptyResource :: PDFResource -> Bool +emptyResource (PDFResource a b) = null a && M.null b + + +-- | A PDF Pattern +data PDFUncoloredPattern +data PDFColoredPattern +data AnyPdfPattern + + +-- | A PDF Color space +data PDFColorSpace = PatternRGB deriving(Eq,Ord) + +instance PdfResourceObject PDFColorSpace where + toRsrc PatternRGB = AnyPdfObject . map AnyPdfObject $ [PDFName "Pattern",PDFName "DeviceRGB"] + +instance PdfObject PDFColoredPattern where + toPDF _ = noPdfObject +instance PdfResourceObject (PDFReference PDFColoredPattern) where + toRsrc = AnyPdfObject + +instance PdfObject PDFUncoloredPattern where + toPDF _ = noPdfObject +instance PdfResourceObject (PDFReference PDFUncoloredPattern) where + toRsrc = AnyPdfObject + +instance PdfObject AnyPdfPattern where + toPDF _ = noPdfObject +instance PdfResourceObject (PDFReference AnyPdfPattern) where + toRsrc = AnyPdfObject + + diff --git a/Graphics/PDF/Shading.hs b/Graphics/PDF/Shading.hs --- a/Graphics/PDF/Shading.hs +++ b/Graphics/PDF/Shading.hs @@ -1,80 +1,39 @@ --- | Function used to create shading patterns -module Graphics.PDF.Shading - (-- * Shading - -- ** Data types - Shading(..) - -- ** Operators - , createShading, strokeShading, fillShading - ) - where - -import Graphics.PDF.LowLevel -import Text.Printf -import Graphics.PDF.Color - --- | Axial or radial shading -data Shading = Axial Color Color Float Float Float Float -- ^ Axial shading with start end color and the start and ending points - | Radial Color Color Float Float Float Float Float Float -- ^ Radial shading with start and end color, center and radius of start and end circle - -instance Show Shading where - show (Axial a b x0 y0 x1 y1) = printf "axial%s%s%f%f%f%f" (show a) (show b) x0 y0 x1 y1 - show (Radial a b x0 y0 r0 x1 y1 r1) = printf "axial%s%s%f%f%f%f%f%f" (show a) (show b) x0 y0 r0 x1 y1 r1 - --- | Interpolation function -interpole :: Int -> Float -> Float -> PdfObject -interpole n x y = pdfDictionary [ - ("FunctionType", PdfInt 2), - ("Domain", PdfArray [PdfFloat 0,PdfFloat 1]), - ("C0", PdfArray [PdfFloat x]), - ("C1", PdfArray [PdfFloat y]), - ("N", PdfInt n) - ] - --- | Create a shading dictionary -createShadingObject :: Shading -> CreatedObject -createShadingObject a@(Axial (Rgb ra ga ba) (Rgb rb gb bb) x0 y0 x1 y1) = (PdfAnyObject,(show a),pdfDictionary [("Type",PdfName "Shading"), - ("ShadingType",PdfInt 2), - ("ColorSpace",PdfName "DeviceRGB"), - ("Coords",PdfArray (map PdfFloat [x0,y0,x1,y1])), - ("Function",PdfArray [interpole 1 ra rb,interpole 1 ga gb,interpole 1 ba bb]) - ] - ) -createShadingObject a@(Radial (Rgb ra ga ba) (Rgb rb gb bb) x0 y0 r0 x1 y1 r1) = (PdfAnyObject,(show a),pdfDictionary [("Type",PdfName "Shading"), - ("ShadingType",PdfInt 3), - ("ColorSpace",PdfName "DeviceRGB"), - ("Coords",PdfArray (map PdfFloat [x0,y0,r0,x1,y1,r1])), - ("Function",PdfArray [interpole 1 ra rb,interpole 1 ga gb,interpole 1 ba bb]) - ] - ) -createShadingObject _ = error "Shading object only with RGB colors" - --- Name of a pattern -patternName :: Shading -> String -patternName s = "pattern" ++ (show s) - --- | Create a new shading made of several dictionaries -newPattern :: Shading -> [CreatedObject] -newPattern a = [(PdfAnyObject,patternName a,pdfDictionary [("Type",PdfName "Pattern"), - ("PatternType",PdfInt 2), - ("Shading",PdfUnknownPointer (show a)) - ] - ), - createShadingObject a, - (PdfPatternObject,patternName a, PdfUnknownPointer (patternName a)), - (PdfShading,show a, PdfUnknownPointer (show a)) - ] - --- | Create a new kind of shading -createShading :: Shading -> PdfCmd -createShading s = (PdfNone,newPattern s) - - --- | Select a shading for stroking (it must have been created before) -strokeShading :: Shading -> PdfCmd -strokeShading s = (PdfStrokePattern (patternName s),[]) - --- | Select a shading for filling (it must have been created before) -fillShading :: Shading -> PdfCmd -fillShading s = (PdfFillPattern (patternName s),[]) - - +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF shading +--------------------------------------------------------- +module Graphics.PDF.Shading( + -- * Shading + -- ** Type + PDFShading(..) + , paintWithShading + ) where + +import Graphics.PDF.Draw +import Graphics.PDF.LowLevel.Types +import Control.Monad.State(gets) +import Graphics.PDF.Shapes(setAsClipPath) + +-- | Set alpha value for transparency +applyShading :: PDFShading -> Draw () +applyShading shade = do + shadingMap <- gets shadings + (newName,newMap) <- setResource "Shading" shade shadingMap + modifyStrict $ \s -> s { shadings = newMap } + writeCmd ("\n/" ++ newName ++ " sh") + +paintWithShading :: PDFShading -- ^ Shading + -> Draw a -- ^ Shape to paint + -> Draw () +paintWithShading shade d = do + withNewContext $ do + d + setAsClipPath + applyShading shade diff --git a/Graphics/PDF/Shape.hs b/Graphics/PDF/Shape.hs deleted file mode 100644 --- a/Graphics/PDF/Shape.hs +++ /dev/null @@ -1,75 +0,0 @@ --- | Functions used to add shapes to a PDF documents - -module Graphics.PDF.Shape - (-- * Shapes - -- ** Drawing operators - line, rectangle, fillRectangle - -- ** Path operators - ,startPathAt,closePath,addLineToPath,addRectangleToPath,strokePath,fillPath, fillAndStrokePath, clipPath - -- ** Shape settings - , lineWidth, dashPattern - ) - where - -import Graphics.PDF.LowLevel - --- | Add a line to a PDF document -line :: Float -> Float -> Float -> Float -> PdfCmd -line xa ya xb yb = (PdfL xa ya xb yb,[]) - - --- | Change the line width used in a PDF document -lineWidth :: Float -> PdfCmd -lineWidth w = (PdfW w,[]) - --- | Add a rectangle to the PDF -rectangle :: Float -> Float -> Float -> Float -> PdfCmd -rectangle xa ya width height = (PdfRect xa ya width height,[]) - - --- | Add a filled a rectangle to the PDF -fillRectangle :: Float -> Float -> Float -> Float -> PdfCmd -fillRectangle xa ya width height = (PdfFillRect xa ya width height,[]) - - --- | Set the dash array and phase -dashPattern :: [Float] -> Float -> PdfCmd -dashPattern a phase = (PdfDash a phase,[]) - - --- | Start a new path -startPathAt :: Float -> Float -> PdfCmd -startPathAt xa ya = (PdfStartPath xa ya,[]) - - --- | Close path -closePath :: PdfCmd -closePath = (PdfClosePath,[]) - - --- | Add a line to the current path -addLineToPath :: Float -> Float -> PdfCmd -addLineToPath xa ya = (PdfAddLineToPath xa ya,[]) - - --- | Add a rectangle to the PDF -addRectangleToPath :: Float -> Float -> Float -> Float -> PdfCmd -addRectangleToPath xa ya width height = (PdfAddRectangleToPath xa ya width height,[]) - - --- | Stroke path -strokePath :: PdfCmd -strokePath = (PdfStroke,[]) - --- | Fill path -fillPath :: PdfCmd -fillPath = (PdfFill,[]) - - --- | Fill and stroke path -fillAndStrokePath :: PdfCmd -fillAndStrokePath = (PdfFillAndStroke,[]) - --- | Clip path -clipPath :: PdfCmd -clipPath = (PdfClip,[]) diff --git a/Graphics/PDF/Shapes.hs b/Graphics/PDF/Shapes.hs new file mode 100644 --- /dev/null +++ b/Graphics/PDF/Shapes.hs @@ -0,0 +1,264 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Shapes +--------------------------------------------------------- + +module Graphics.PDF.Shapes( + -- * Shapes + -- ** Types + Point + -- ** Lines + , moveto + , lineto + -- ** Paths + , beginPath + , closePath + , addBezierCubic + , addPolygonToPath + , addLineToPath + , strokePath + , fillPath + , fillAndStrokePath + , fillPathEO + , fillAndStrokePathEO + , setAsClipPath + , setAsClipPathEO + -- ** Usual shapes + , Shape(..) + , Line(..) + , Rectangle(..) + , Polygon(..) + , Arc(..) + , Ellipse(..) + , Circle(..) + , RoundRectangle(..) + -- ** Style + , CapStyle(..) + , JoinStyle(..) + , DashPattern(..) + , setWidth + , setLineCap + , setLineJoin + , setDash + , setNoDash + , setMiterLimit + ) where + +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import Data.List(intersperse) + +class Shape a where + addShape :: a -> Draw () + stroke :: a -> Draw () + fill :: a -> Draw () + fillAndStroke :: a -> Draw () + fillEO :: a -> Draw () + fillAndStrokeEO :: a -> Draw () + stroke r = do + addShape r + strokePath + fill r = do + addShape r + fillPath + fillAndStroke r = do + addShape r + fillAndStrokePath + fillEO r = do + addShape r + fillPathEO + fillAndStrokeEO r = do + addShape r + fillAndStrokePathEO + +data Line = Line PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) +instance Shape Line where + addShape (Line x0 y0 x1 y1)= do + moveto x0 y0 + lineto x1 y1 + fill _ = error "Can't fill a line !" + fillAndStroke _ = error "Can't fill a line !" + fillEO _ = error "Can't fill a line !" + fillAndStrokeEO _ = error "Can't fill a line !" + +data Rectangle = Rectangle PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) +instance Shape Rectangle where + addShape (Rectangle x0 y0 x1 y1) = do + let poly = [(x0,y0),(x1,y0),(x1,y1),(x0,y1)] + addPolygonToPath poly + closePath + +data Arc = Arc PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) +instance Shape Arc where + addShape (Arc x0 y0 x1 y1) = do + let height = y1 - y0 + width = x1 - x0 + kappa = 0.5522847498 + beginPath x0 y0 + addBezierCubic (x0+width*kappa) y0 x1 (y1-height*kappa) x1 y1 + +data Ellipse = Ellipse PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) +instance Shape Ellipse where + addShape (Ellipse x0 y0 x1 y1) = do + let xm = (x0+x1)/2.0 + ym = (y0+y1)/2.0 + k = 0.5522847498 + h = k*(abs (y1 - y0)/2.0) + w = k*(abs (x1 - x0)/2.0) + + beginPath xm y0 + addBezierCubic (xm + w) y0 x1 (ym - h) x1 ym + addBezierCubic x1 (ym + h) (xm + w) y1 xm y1 + addBezierCubic (xm - w) y1 x0 (ym + h) x0 ym + addBezierCubic x0 (ym - h) (xm - w) y0 xm y0 + +data RoundRectangle = RoundRectangle PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) +instance Shape RoundRectangle where + addShape (RoundRectangle rw rh x0 y0 x1 y1) = do + let k = 0.5522847498 + h = k*rw + w = k*rh + + beginPath (x0+rw) y0 + addLineToPath (x1-rw) y0 + addBezierCubic ((x1-rw) + w) y0 x1 (y0+rh - h) x1 (y0+rh) + addLineToPath x1 (y1-rh) + addBezierCubic x1 ((y1-rh) + h) (x1-rw + w) y1 (x1-rw) y1 + addLineToPath (x0+rw) y1 + addBezierCubic (x0 + rw - w) y1 x0 (y1-rh + h) x0 (y1-rh) + addLineToPath x0 (y0+rh) + addBezierCubic x0 (y0 + rh - h) (x0 + rw - w) y0 (x0 + rw) y0 + addLineToPath (x1-rw) y0 + +data Circle = Circle PDFFloat PDFFloat PDFFloat deriving(Eq) +instance Shape Circle where + addShape (Circle x0 y0 r) = stroke (Ellipse (x0-r) (y0-r) (x0+r) (y0+r) ) + +newtype Polygon = Polygon [Point] +instance Shape Polygon where + addShape (Polygon l) = addPolygonToPath l + + +-- | Set pen width +setWidth :: MonadPath m => PDFFloat -> m () +setWidth w = writeCmd $ "\n " ++ (show w) ++ " w" + +-- | Set pen width +setMiterLimit :: MonadPath m => PDFFloat -> m () +setMiterLimit w = writeCmd $ "\n " ++ (show w) ++ " M" + +-- | Line cap styles +data CapStyle = ButtCap + | RoundCap + | SquareCap + deriving(Eq,Enum) + +-- | Line join styles +data JoinStyle = MilterJoin + | RoundJoin + | BevelJoin + deriving(Eq,Enum) + +-- | Set line cap +setLineCap :: MonadPath m => CapStyle -> m () +setLineCap w = writeCmd $ "\n " ++ (show . fromEnum $ w) ++ " J" + +-- | Set line join +setLineJoin :: MonadPath m => JoinStyle -> m () +setLineJoin w = writeCmd $ "\n " ++ (show . fromEnum $ w) ++ " j" + +data DashPattern = DashPattern ![PDFFloat] PDFFloat deriving(Eq) + +-- | Set the dash pattern +setDash :: MonadPath m => DashPattern -> m() +setDash (DashPattern a p) = writeCmd $ "\n " ++ show a ++ " " ++ (show p) ++ " d" + +-- | No dash pattern +setNoDash :: MonadPath m => m () +setNoDash = setDash (DashPattern [] 0) + +-- | Begin a new path at position x y +beginPath :: PDFFloat -- ^ Horizontal coordinate + -> PDFFloat -- ^ Vertical coordinate + -> Draw () +beginPath = moveto + +-- | Close current path +closePath :: Draw () +closePath = writeCmd $ "\nh" + + +-- | Append a cubic Bezier curve to the current path. The curve extends +-- from the current point to the point (x3 , y3 ), using (x1 , y1 ) and +-- (x2, y2) as the Bezier control points +addBezierCubic :: PDFFloat -- ^ x1 + -> PDFFloat -- ^ y1 + -> PDFFloat -- ^ x2 + -> PDFFloat -- ^ y2 + -> PDFFloat -- ^ x3 + -> PDFFloat -- ^ y3 + -> Draw () +addBezierCubic x1 y1 x2 y2 x3 y3 = writeCmd $ "\n" ++ (concat . intersperse " ". map show $ [x1,y1,x2,y2,x3,y3]) ++ " c" + +-- | Move pen to a given point without drawing anything +moveto :: PDFFloat -- ^ Horizontal coordinate + -> PDFFloat -- ^ Vertical coordinate + -> Draw () +moveto x y = writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " m" + +-- | Draw a line from current point to the one specified by lineto +lineto :: PDFFloat -- ^ Horizontal coordinate + -> PDFFloat -- ^ Vertical coordinate + -> Draw () +lineto x y = writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " l s" + +-- | Add a line from current point to the one specified by lineto +addLineToPath :: PDFFloat -- ^ Horizontal coordinate + -> PDFFloat -- ^ Vertical coordinate + -> Draw () +addLineToPath x y = writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " l" + +-- | A point +type Point = (PDFFloat,PDFFloat) + +-- | Add a polygon to current path +addPolygonToPath :: [Point] + -> Draw () +addPolygonToPath l = do + (uncurry moveto) . head $ l + mapM_ (\(x,y) -> writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " l") (tail l) + +-- | Draw current path +strokePath :: Draw () +strokePath = writeCmd "\nS" + +-- | Fill current path +fillPath :: Draw () +fillPath = writeCmd "\nf" + +-- | Fill current path +fillAndStrokePath :: Draw () +fillAndStrokePath = writeCmd "\nB" + +-- | Set clipping path +setAsClipPathEO :: Draw () +setAsClipPathEO = writeCmd "\nW* n" + +-- | Set clipping path +setAsClipPath :: Draw () +setAsClipPath = writeCmd "\nW n" + +-- | Fill current path using even odd rule +fillPathEO :: Draw () +fillPathEO = writeCmd "\nf*" + +-- | Fill current path using even odd rule +fillAndStrokePathEO :: Draw () +fillAndStrokePathEO = writeCmd "\nB*" diff --git a/Graphics/PDF/Text.hs b/Graphics/PDF/Text.hs --- a/Graphics/PDF/Text.hs +++ b/Graphics/PDF/Text.hs @@ -1,50 +1,239 @@ --- | Function used to draw text +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- PDF Text +--------------------------------------------------------- -module Graphics.PDF.Text - (-- * Text - drawText, clipText,fillAndDrawText,fillText,charSpacing,wordSpacing,textLeading - , pdfString - ) - where - -import Graphics.PDF.LowLevel -import Text.Regex +module Graphics.PDF.Text( + -- * Text + -- ** Types + PDFFont(..) + , FontName(..) + , TextMode(..) + , PDFText + , UnscaledUnit + -- ** Functions + , drawText + , text + , toPDFString + , startNewLine + , displayText + , textStart + , setFont + , leading + , charSpace + , wordSpace + , textScale + , renderMode + , rise + , setTextMatrix + , textWidth + , getDescent + , getHeight + , textBox + ) where -leftPar = mkRegex "[(]" -rightPar = mkRegex "[)]" -backslash = mkRegex "[\\]" +import Graphics.PDF.LowLevel.Types +import Graphics.PDF.Draw +import Control.Monad.State +import Graphics.PDF.Resources +import qualified Data.ByteString.Lazy as B +import Control.Monad.Writer +import Control.Monad.Trans +import qualified Data.Set as Set +import Graphics.PDF.Coordinates +import Data.Word +import Graphics.PDF.LowLevel.Kern(kerns) +import qualified Data.Map as M(findWithDefault) +import Graphics.PDF.Shapes +import qualified Data.ByteString.Lazy.Char8 as B(words,unwords) --- | Create a pdf string -pdfString :: String -> [PdfString] -pdfString s = map (S . escape) . lines $ s - where - escape s = replace rightPar "\\)" . replace leftPar "\\(" . replace backslash "\\\\\\\\" $ s - replace reg repl s = subRegex reg s repl - --- | Stroke text at a given position and use the current font settings -drawText :: Float -> Float -> String -> PdfCmd -drawText px py s = (PdfText TextStroke px py (pdfString s),[]) +foreign import ccall "ctext.h c_getLeading" cgetLeading :: Int -> Int +foreign import ccall "ctext.h c_getAdvance" cgetAdvance :: Int -> Word8 -> Int +foreign import ccall "ctext.h c_getDescent" cgetDescent :: Int -> Int +foreign import ccall "ctext.h c_hasKern" hasKern :: Int -> Bool --- | Fill and stroke text at a given position and use the current font settings -fillAndDrawText :: Float -> Float -> String -> PdfCmd -fillAndDrawText px py s = (PdfText TextFillStroke px py (pdfString s),[]) +-- pixel size / 2048 gives factor --- | Fill text at a given position and use the current font settings -fillText :: Float -> Float -> String -> PdfCmd -fillText px py s = (PdfText TextFill px py (pdfString s),[]) +-- | Convert a dimension in font unit to device unit +trueSize :: Int -> Int -> PDFFloat +trueSize fontSize textSize = (fromIntegral (textSize*fontSize)) / 1000.0 + +getDescent :: PDFFont -> PDFFloat +getDescent (PDFFont n s) = trueSize s (cgetDescent (fromEnum n)) + +getHeight :: PDFFont -> PDFFloat +getHeight (PDFFont n s) = trueSize s (cgetLeading (fromEnum n)) + +-- | Get the kern value for a given font and pair of charcode +getKern :: (Int,Word8,Word8) -> Int +getKern k = M.findWithDefault 0 k kerns + +textWidth :: PDFFont -> PDFString -> PDFFloat +textWidth (PDFFont n s) (PDFString t) = let w = sum . map (cgetAdvance (fromEnum n)) . B.unpack $ t in + if hasKern (fromEnum n) + then + trueSize s (w + (sum . map getKern $ [(fromEnum n,ca,cb) | (ca,cb) <- B.zip t (B.tail t)])) + else + trueSize s w --- | Intersect clip region with text shape -clipText :: Float -> Float -> String -> PdfCmd -clipText px py s = (PdfText TextClip px py (pdfString s),[]) +type FontState = (Set.Set FontName) + +data TextParameter = TextParameter { tc :: !PDFFloat + , tw :: !PDFFloat + , tz :: !PDFFloat + , tl :: !PDFFloat + , ts :: !PDFFloat + , fontState :: FontState + } +defaultParameters :: TextParameter +defaultParameters = TextParameter 0 0 100 0 0 (Set.empty) + +-- | Tolerance value when text is too long. We accept to overflow a little +tolerance :: PDFFloat +tolerance = 0.2 + +-- | Format a text string inside a rectangle. Experimental and will be replaced by a better typesetting +-- system in a next version +textBox :: PDFFont -- ^ Font to use + -> PDFString -- ^ Text to draw + -> Rectangle -- ^ Where to draw + -> Draw () +textBox f@(PDFFont _ size) (PDFString s) (Rectangle xa _ xb yb) = do + let width = xb -xa + ws = textWidth f (toPDFString " ") + getLines _ l [] = [B.unwords . reverse $ l] + getLines c l (h:t) = let c' = c + ws + textWidth f (PDFString h) in + if c' > width + tolerance * (fromIntegral size) + then + (B.unwords . reverse $ l):getLines 0 [] (h:t) + else + getLines c' (h:l) t + drawText $ do + setFont f + leading $ getHeight f + textStart xa (yb + getDescent f) + startNewLine + mapM_ (\x -> displayText x >> startNewLine) (map PDFString . getLines 0 [] $ (B.words s)) --- | Set char spacing value -charSpacing :: Float -> PdfCmd -charSpacing value = (PdfCharSpacing value,[]) + + +-- | The text monad +newtype PDFText a = PDFText {unText :: WriterT B.ByteString (State TextParameter) a} +#ifndef __HADDOCK__ + deriving(Monad,Functor,MonadWriter B.ByteString) +#else +instance Monad PDFText +instance Functor PDFText +instance MonadWriter B.ByteString PDFText +#endif + +instance MonadPath PDFText --- | Set word spacing value -wordSpacing :: Float -> PdfCmd -wordSpacing value = (PdfWordSpacing value,[]) +-- | Unscaled unit (not scaled by the font size) +type UnscaledUnit = PDFFloat --- | Set text leading value (used for line separation when text is containing a \\n) -textLeading :: Float -> PdfCmd -textLeading value = (PdfLeading value,[]) +-- | Rendering mode for text display +data TextMode = FillText + | StrokeText + | FillAndStrokeText + | InvisibleText + | FillTextAndAddToClip + | StrokeTextAndAddToClip + | FillAndStrokeTextAndAddToClip + | AddToClip + deriving(Eq,Ord,Enum) + +-- | Select a font to use +setFont :: PDFFont -> PDFText () +setFont (PDFFont n size) = PDFText $ do + lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s)}) + writeCmd $ "\n/" ++ (show n) ++ " " ++ (show size) ++ " Tf" + +-- | Draw a text in the draw monad +drawText :: PDFText a + -> Draw a +drawText t = do + let ((a,w),s) = (runState . runWriterT . unText $ t) defaultParameters + mapM_ addFontRsrc (Set.elems (fontState s)) + writeCmd "\nBT" + tell w + writeCmd "\nET" + return a + where + addFontRsrc f = modifyStrict $ \s -> s { rsrc = addResource (PDFName "Font") (PDFName (show f)) (toRsrc (PDFFont f 0)) (rsrc s)} + +-- | Set position for the text beginning +textStart :: PDFFloat + -> PDFFloat + -> PDFText () +textStart x y = writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " Td" + +-- | Display some text +displayText :: PDFString + -> PDFText () +displayText t = do + tell . toPDF $ t + writeCmd " Tj" + + +-- | Start a new line (leading value must have been set) +startNewLine :: PDFText () +startNewLine = writeCmd "\nT*" + +-- | Set leading value +leading :: UnscaledUnit -> PDFText () +leading v = PDFText $ do + lift (modifyStrict $ \s -> s {tl = v}) + writeCmd $ "\n" ++ (show v) ++ " TL" + +-- | Set the additional char space +charSpace :: UnscaledUnit -> PDFText () +charSpace v = PDFText $ do + lift (modifyStrict $ \s -> s {tc = v}) + writeCmd $ "\n" ++ (show v) ++ " Tc" + +-- | Set the additional word space +wordSpace :: UnscaledUnit -> PDFText () +wordSpace v = PDFText $ do + lift (modifyStrict $ \s -> s {tw = v}) + writeCmd $ "\n" ++ (show v) ++ " Tw" + +-- | Set scaling factor for text +textScale :: PDFFloat -> PDFText () +textScale v = PDFText $ do + lift (modifyStrict $ \s -> s {tz = v}) + writeCmd $ "\n" ++ (show v) ++ " Tz" + +-- | Choose the text rendering mode +renderMode :: TextMode -> PDFText () +renderMode v = writeCmd $ "\n" ++ (show . fromEnum $ v) ++ " Tr" + +-- | Set the rise value +rise :: UnscaledUnit -> PDFText () +rise v = PDFText $ do + lift (modifyStrict $ \s -> s {ts = v}) + writeCmd $ "\n" ++ (show v) ++ " Ts" + +-- | Set the text transformation matrix +setTextMatrix :: Matrix -> PDFText() +setTextMatrix (Matrix a b c d e f) = + writeCmd $ "\n" ++ show (a) ++ " " ++ show (b) ++ " " ++ show (c) ++ " " ++ show (d) ++ " " ++ show (e) ++ " " ++ show (f) ++ " Tm" + +-- | Utility function to quickly display one line of text +text :: PDFFont + -> PDFFloat + -> PDFFloat + -> PDFString + -> PDFText () +text f x y t = do + setFont f + textStart x y + displayText t + diff --git a/HPDF.cabal b/HPDF.cabal --- a/HPDF.cabal +++ b/HPDF.cabal @@ -1,20 +1,48 @@ Name: HPDF -Version: 0.3 +Version: 1.0 License: LGPL -Copyright: Copyright (c) 2006, alpha +License-file:LICENSE +Copyright: Copyright (c) 2007, alpheccar category: Graphics -synopsis: PDF API for Haskell +synopsis: Generation of PDF documents maintainer: misc@NOSPAMalpheccar.org -homepage: http://www.alpheccar.org +homepage: http://www.alpheccar.org/en/posts/show/80 +build-depends: base, haskell98,mtl,encoding >= 0.1 ,zlib >= 0.3 +ghc-options: -Wall -funbox-strict-fields -fglasgow-exts -O2 +extensions: ForeignFunctionInterface, CPP +description: A PDF library allowing to generate multipage PDF documents with outlines, links ... +extra-source-files: + c/ctext.h + c/metrics.h + Test/AFMParser.hs + Test/logo.jpg + Test/Makefile + Test/Penrose.hs + Test/test.hs + README.txt +C-Sources: + c/metrics.c +Include-Dirs: c +Install-Includes: + ctext.h exposed-Modules: - Graphics.PDF, - Graphics.PDF.Geometry, - Graphics.PDF.Shape, - Graphics.PDF.Text, - Graphics.PDF.Font, - Graphics.PDF.Color, - Graphics.PDF.Shading, - Graphics.PDF.File, - Graphics.PDF.LowLevel -build-depends: base, haskell98,mtl,regex-compat -ghc-options: -Wall -O2 + Graphics.PDF + Graphics.PDF.Colors + Graphics.PDF.Coordinates + Graphics.PDF.Document + Graphics.PDF.Shapes + Graphics.PDF.Text + Graphics.PDF.Navigation + Graphics.PDF.Image + Graphics.PDF.Action + Graphics.PDF.Annotation + Graphics.PDF.Pattern + Graphics.PDF.Shading + Graphics.PDF.Demo +Other-Modules: + Graphics.PDF.LowLevel.Types + Graphics.PDF.Data.PDFTree + Graphics.PDF.Pages + Graphics.PDF.Resources + Graphics.PDF.Draw + Graphics.PDF.LowLevel.Kern diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +* Copyright (c) 2007, alpheccar.org +* All rights reserved. +* Redistribution and use in source and binary forms, with or without +* modification, are permitted provided that the following conditions are met: +* +* * Redistributions of source code must retain the above copyright +* notice, this list of conditions and the following disclaimer. +* * Redistributions in binary form must reproduce the above copyright +* notice, this list of conditions and the following disclaimer in the +* documentation and/or other materials provided with the distribution. +* * Neither the name of alpheccar.org nor the +* names of its contributors may be used to endorse or promote products +* derived from this software without specific prior written permission. +* +* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY +* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +* DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY +* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +* +* PDFTree.hs reusing the code from IntMap : Copyright Daan Leijen. See the comments in the file. + diff --git a/README.txt b/README.txt new file mode 100644 --- /dev/null +++ b/README.txt @@ -0,0 +1,17 @@ +TO BUILD AND INSTALL THE LIBRARY +================================ + +ghc-pkg unregister HPDF-0.x if you already installed an older version. +ghc-pkg list to check which version is already installed. + +runghc Setup.hs configure +runghc Setup.hs build +runghc Setup.hs haddock to generate again the HTML pages (optional - only if you have haddock installed) +runghc Setup.hs install (you may have to use sudo) +runghc Setup.hs clean (warning : will clean the HTML pages) + +TO TEST THE LIBRARY +===================== +cd Test +make demo : to build a demo pdf +./test : to run the demo diff --git a/Test/AFMParser.hs b/Test/AFMParser.hs new file mode 100644 --- /dev/null +++ b/Test/AFMParser.hs @@ -0,0 +1,312 @@ +module Main where + +import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Prim +import Text.ParserCombinators.Parsec.Char +import Data.Char(toUpper) +import System.Environment +import Data.Maybe(isJust,fromJust,mapMaybe) +import qualified Data.IntMap as IM +import Data.List(intersperse) +import qualified Data.Map as M + +capitalize :: String -> String +capitalize [] = [] +capitalize (h:t) = toUpper h : t + +line :: Parser () +line = do string "\r\n" + return () + +toEndOfLine :: Parser () +toEndOfLine = do many (noneOf "\r\n") + line + return () + +getString :: String -> Parser String +getString s = do + string s + spaces + c <- many1 (alphaNum <|> oneOf "-+") + line + return c + +getName :: String -> Parser String +getName s = do + string s + spaces + c <- alphaNum >> many (alphaNum <|> oneOf " -+") + line + return c + +getInt :: String -> Parser Int +getInt s = do c <- getString s + return $ read c + +getFloat :: String -> Parser Double +getFloat s = do string s + spaces + c <- many1 (alphaNum <|> oneOf ".-+") + line + return $ read c + +getBool :: String -> Parser Bool +getBool s = do c <- getString s + return $ read (capitalize c) + +data CharacterSet = ExtendedRoman + | Special + deriving(Eq,Read,Show) + +data Weight = Medium + | Bold + | Roman + deriving(Eq,Read,Show) + +getCharacterSet :: String -> Parser CharacterSet +getCharacterSet s = do c <- getString s + return $ read c + +getWeigth :: String -> Parser Weight +getWeigth s = do c <- getString s + return $ read c + + +array :: Parser [String] +array = sepEndBy (many1 (oneOf "-+0123456789")) (many1 (oneOf " ")) + +getArray :: String -> Parser [Double] +getArray s = do string s + spaces + c <- array + line + return . map read $ c + +comment :: String -> Parser () +comment s = do string s + toEndOfLine + +comments :: Parser () +comments = do many1 (comment "Comment") + return () + +data EncodingScheme = AdobeStandardEncoding + | FontSpecific + deriving(Eq,Read,Show) + +getEncoding :: String -> Parser EncodingScheme +getEncoding s = do c <- getString s + return $ read c + +number :: Parser Int +number = do c <- many1 (oneOf "-+0123456789") + return $ read c + +data Elem = C Int + | WX Int + | N String + | B [Double] + | L + deriving(Eq,Read,Show) + +metricElem :: Parser Elem +metricElem = do char 'C' + spaces + c <- number + return $ C c + <|> + do string "WX" + spaces + c <- number + return $ WX c + <|> + do char 'N' + spaces + c <- many1 alphaNum + return $ N c + <|> + do char 'B' + spaces + c <- array + return . B . map read $ c + <|> + do char 'L' + spaces + many1 letter + spaces + many1 letter + return L + +data Metric = Metric { charCode :: Int + , width :: Int + , name :: String + , bounds :: [Double] + } + deriving(Eq,Show) + +data Font = Font { metrics :: [Metric] + , underlinePosition :: Int + , underlineThickness :: Int + , ascent :: Int + , descent :: Int + , kernData :: Maybe [KX] + } + deriving(Eq,Show) + +isEncoded :: Metric -> Bool +isEncoded (Metric c _ _ _) = c /= (-1) + +mkMetric :: [Elem] -> Metric +mkMetric l = foldr addElem (Metric (-1) 0 "" []) l + where + addElem (C c) m = m {charCode=c} + addElem (WX c) m = m {width=c} + addElem (N s) m = m {name=s} + addElem (B l) m = m {bounds=l} + addElem _ m = m + +charMetric :: Parser Metric +charMetric = do + l <- sepEndBy metricElem (many1 (oneOf "; ")) + line + return . mkMetric $ l + +data KX = KX String String Int + deriving(Eq,Ord,Show) + +kernPair :: Parser KX +kernPair = do string "KPX" + spaces + namea <- many1 letter + spaces + nameb <- many1 letter + spaces + nb <- many1 (oneOf "-+0123456789") + line + return $ KX namea nameb (read nb) + +getKernData :: Parser (Maybe [KX]) +getKernData = do + { comment "StartKernData" + ; nbKerns <- getInt "StartKernPairs" + ; k <- many1 kernPair + ; comment "EndKernPairs" + ; comment "EndKernData" + ; return $ Just k + } + +afm :: Parser Font +afm = do { comment "StartFontMetrics" + ; comments + ; fontName <- getString "FontName" + ; fullName <- getName "FullName" + ; familyName <- getString "FamilyName" + ; weight <- getWeigth "Weight" + ; italicAngle <- getFloat "ItalicAngle" + ; isFixedPitch <- getBool "IsFixedPitch" + ; characterSet <- getCharacterSet "CharacterSet" + ; bbox <- getArray "FontBBox" + ; underlinePosition <- getInt "UnderlinePosition" + ; underlineThickness <- getInt "UnderlineThickness" + ; comment "Version" + ; comment "Notice" + ; encodingScheme <- getEncoding "EncodingScheme" + ; capHeight <- option 0 $ getInt "CapHeight" + ; xHeight <- option 0 $ getInt "XHeight" + ; ascender <- option 0 $ getInt "Ascender" + ; descender <- option 0 $ getInt "Descender" + ; stdHW <- getInt "StdHW" + ; stdVW <- getInt "StdVW" + ; startCharMetrics <- getInt "StartCharMetrics" + ; charMetrics <- many1 charMetric + ; comment "EndCharMetrics" + ; kerns <- option Nothing getKernData + ; comment "EndFontMetrics" + ; return $ Font (filter isEncoded charMetrics) underlinePosition underlineThickness ascender descender kerns + } + +allFonts :: [String] +allFonts = [ "Helvetica.afm" + , "Helvetica-Bold.afm" + , "Helvetica-Oblique.afm" + , "Helvetica-BoldOblique.afm" + , "Times-Roman.afm" + , "Times-Bold.afm" + , "Times-Italic.afm" + , "Times-BoldItalic.afm" + , "Courier.afm" + , "Courier-Bold.afm" + , "Courier-Oblique.afm" + , "Courier-BoldOblique.afm" + , "Symbol.afm" + , "ZapfDingbats.afm" + ] + +createFontList :: Font -> [(Int,Int)] +createFontList (Font m up ut asc desc k) = zip codes (map getWidth [32..255]) + where + codes = [32..255] + getWidth c = IM.findWithDefault spaceWidth c chars + spaceWidth = IM.findWithDefault 0 32 chars + chars = IM.fromList . map zipMetric $ m + zipMetric m@(Metric c w _ _) = (c,w) + +parseFont :: String -> IO (Maybe Font) +parseFont s = do + r <- parseFromFile afm $ "../Core14_AFMs/" ++ s + case r of + Left e -> error (show e) + Right r -> return $ Just r + +fontData :: Font -> [String] +fontData (Font _ up ut asc desc k) = [show up,show ut,show asc,show desc,maybe "0" (const "1") k] + +kernForFont :: (Int,Font) -> M.Map (Int,Int,Int) Int +kernForFont (i,(Font m _ _ _ _ Nothing)) = M.empty +kernForFont (i,(Font m _ _ _ _ (Just k))) = do + let names = M.fromList . map (\x -> (name x, charCode x)) $ m + k' = mapMaybe kernToList k + kernToList (KX na nb v) = + let ca = M.lookup na names + cb = M.lookup nb names in + case (ca,cb) of + (Just a,Just b) -> Just $ ((i,a,b),v) + (_,_) -> Nothing + M.fromList k' + + + +createKern :: [Font] -> IO () +createKern f = do + let allmaps = map kernForFont $ (zip [0..] f) + endkern = M.fromList $ [((i,j,0),0) | i <- [0..13],j <- [32..255]] + result = M.unions $ allmaps + putStrLn $ "-- #hide" + putStrLn $ "module Graphics.PDF.LowLevel.Kern(kerns) where" + putStrLn "" + putStrLn $ "import qualified Data.Map as M" + putStrLn $ "import Data.Word" + putStrLn $ "kerns :: M.Map (Int,Word8,Word8) Int" + putStrLn $ "kerns = M." ++ (show result) + +main :: IO () +main = do + r <- getArgs + maybeFonts <- mapM parseFont allFonts + let fonts = map fromJust . filter isJust $ maybeFonts + if null r + then do + let carray = map createFontList fonts + putStrLn "#ifndef _METRICS_H_" + putStrLn "#define _METRICS_H_" + putStrLn "static const unsigned long gmetric[]={" + mapM_ putStr . intersperse "\n," . map (\(c,w) -> show w) . concat $ carray + putStrLn "};" + putStrLn "static const long fmetric[]={" + mapM_ putStr . intersperse "\n," . concatMap fontData $ fonts + putStrLn "};" + putStrLn "#endif" + else do + createKern fonts + + diff --git a/Test/Makefile b/Test/Makefile new file mode 100644 --- /dev/null +++ b/Test/Makefile @@ -0,0 +1,27 @@ +debug: + ghc -o test -ffi -cpp -Wall -funbox-strict-fields -fglasgow-exts -O2 -hidir interfaces -odir bin -optc-I../c -i.. ../c/metrics.c --make test.hs + +demo: + ghc -o test --make test.hs + +buildafm: + ghc -o afm --make AFMParser.hs + +metrics: + @./afm Courier-Bold.afm + +clean: + rm -f test + rm -f afm + rm -f *.o + rm -f *.hi + rm -f *.exe + rm -f test.prof + rm -f *.pdf + rm -rf bin + rm -rf interfaces + rm -rf c + mkdir bin + mkdir c + mkdir interfaces + diff --git a/Test/Penrose.hs b/Test/Penrose.hs new file mode 100644 --- /dev/null +++ b/Test/Penrose.hs @@ -0,0 +1,113 @@ +module Penrose ( + penrose + )where + +import Graphics.PDF + +golden :: PDFFloat +golden = ((sqrt 5) + 1) / 2 + +phi :: PDFFloat +phi = 36 / 180 * pi + +width :: PDFFloat +width = 300 + +myBlue :: Color +myBlue = Rgb 0.8 0.8 1 + +myGreen :: Color +myGreen = Rgb 0.8 1 0.8 + +data Tile = A | B | A' | B' + +tilea :: PDFFloat -> Tile -> Int -> Draw () +tilea angle k n = withNewContext $ do + applyMatrix (translate width 0) + applyMatrix (rotate . Degree $ angle) + applyMatrix (scale (1/golden) (1/golden)) + divide (n-1) k + + +tileb :: PDFFloat -> Tile -> Int -> Draw () +tileb angle k n = withNewContext $ do + applyMatrix (translate (width*golden) 0) + applyMatrix (rotate . Degree $ angle) + applyMatrix (scale (1/golden) (1/golden)) + divide (n-1) k + + +divide :: Int -> Tile -> Draw () +divide n A | n == 0 = a width + | otherwise = do + tilea 108 A n + tilea 180 B' n + +divide n A' | n == 0 = a' width + | otherwise = do + tilea (-108) A' n + tilea 180 B n + +divide n B | n == 0 = b width + | otherwise = do + tileb 144 B n + tilea 108 A n + tilea 180 B' n + +divide n B' | n == 0 = b' width + | otherwise = do + tileb (-144) B' n + tilea (-108) A' n + tilea 180 B n + + +b :: PDFFloat -> Draw () +b s = do + setFillAlpha 0.8 + fillColor myBlue + strokeColor myBlue + let pol = [ (0,0) + , ((s*cos(phi)),(s*sin(phi))) + , ((s*golden),0) + ] + fillAndStroke (Polygon pol) + strokeColor black + stroke (Polygon pol) + + +b' :: PDFFloat -> Draw () +b' s = withNewContext $ do + applyMatrix (scale 1 (-1)) + b s + + +a :: PDFFloat -> Draw () +a s = do + setFillAlpha 0.8 + fillColor myGreen + strokeColor myGreen + let pol = [ (0,0) + , ((s*cos(phi)),(s*sin(phi))) + , (s,0) + ] + fillAndStroke (Polygon pol) + strokeColor black + stroke (Polygon pol) + +a' :: PDFFloat -> Draw () +a' s = withNewContext $ do + applyMatrix (scale 1 (-1)) + a s + +penrose :: PDF () +penrose = do + page <- addPage (Just (PDFRect 0 0 (round (1.5*width)) (round width))) + newSection (toPDFString "Penrose") Nothing Nothing $ do + drawWithPage page $ do + applyMatrix (translate 20 5) + applyMatrix (rotate . Degree $ 36) + divide 4 B + divide 4 B' + + + diff --git a/Test/logo.jpg b/Test/logo.jpg new file mode 100644 Binary files /dev/null and b/Test/logo.jpg differ diff --git a/Test/test.hs b/Test/test.hs new file mode 100644 --- /dev/null +++ b/Test/test.hs @@ -0,0 +1,158 @@ +--------------------------------------------------------- +-- | +-- Copyright : (c) alpha 2007 +-- License : BSD-style +-- +-- Maintainer : misc@NOSPAMalpheccar.org +-- Stability : experimental +-- Portability : portable +-- +-- Test +--------------------------------------------------------- + + +module Main where + + +import Graphics.PDF +import Penrose + + +fontDebug :: PDFFont -> PDFString -> Draw () +fontDebug f t = do + drawText $ do + setFont f + textStart 10 200.0 + leading $ getHeight f + renderMode FillText + displayText t + startNewLine + displayText $ toPDFString "Another little test" + strokeColor $ Rgb 1 0 0 + stroke $ Line 10 200 612 200 + fill $ Circle 10 200 10 + stroke $ Rectangle 10 (200.0 - (getDescent f)) (10.0 + textWidth f t) (200.0 - getDescent f + getHeight f) + + +geometryTest :: Draw () +geometryTest = do + strokeColor red + stroke $ Rectangle 0 0 200 100 + fillColor blue + fill $ Ellipse 100 100 300 200 + fillAndStroke $ RoundRectangle 32 32 200 200 600 400 + +lineStyle ::Draw () +lineStyle = do + withNewContext $ do + setWidth 2 + setDash $ DashPattern [3] 0 + geometryTest + + +shadingTest :: Draw () +shadingTest = do + paintWithShading (RadialShading 0 0 50 0 0 600 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Rectangle 0 0 300 300) + paintWithShading (AxialShading 300 300 600 400 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Ellipse 300 300 600 400) + + +patternTest :: PDFReference PDFPage -> PDF () +patternTest page = do + p <- createUncoloredTiling 0 0 100 50 100 50 ConstantSpacing pattern + cp <- createColoredTiling 0 0 100 50 100 50 ConstantSpacing cpattern + drawWithPage page $ do + strokeColor green + setUncoloredFillPattern p (Rgb 1 0 0) + fillAndStroke $ Ellipse 0 0 300 300 + setColoredFillPattern cp + fillAndStroke $ Ellipse 300 300 600 400 + + where + myDrawing = do + stroke (Line 0 0 100 100) + fill (Rectangle 100 100 200 200) + pattern = do + stroke (Ellipse 0 0 100 50) + cpattern = do + strokeColor (Rgb 0 0 1) + stroke (Ellipse 0 0 100 50) + +testAnnotation :: Draw () +testAnnotation = do + strokeColor red + newAnnotation (URLLink (toPDFString "Go to my blog") [0,0,100,100] "http://www.alpheccar.org" True) + drawText $ text (PDFFont Times_Roman 12) 10 30 (toPDFString "Go to my blog") + stroke $ Rectangle 0 0 100 100 + newAnnotation (TextAnnotation (toPDFString "Key annotation") [100,100,130,130] Key) + +textTest :: Draw () +textTest = do + strokeColor red + fillColor blue + fontDebug (PDFFont Times_Roman 48) (toPDFString "This is a test !") + + +testImage :: PDFReference PDFPage -> PDF () +testImage page = do + Right jpg <- createPDFJpeg "logo.jpg" + drawWithPage page $ do + withNewContext $ do + setFillAlpha 0.4 + drawXObject jpg + withNewContext $ do + applyMatrix $ rotate (Degree 20) + applyMatrix $ translate 200 200 + applyMatrix $ scale 2 2 + drawXObject jpg + +testAll :: PDF () +testAll = do + page <- addPage Nothing + newSection (toPDFString "Shapes") Nothing Nothing $ do + + newSection (toPDFString "Geometry") Nothing Nothing $ do + drawWithPage page $ do + geometryTest + + page <- addPage Nothing + newSection (toPDFString "Line style") Nothing Nothing $ do + drawWithPage page $ do + lineStyle + page <- addPage Nothing + newSection (toPDFString "Object reuse") Nothing Nothing $ do + r <- createPDFXForm 0 0 200 200 lineStyle + drawWithPage page $ do + drawXObject r + + page <- addPage Nothing + newSectionWithPage (toPDFString "Painting") Nothing Nothing page $ do + newSection (toPDFString "Patterns") Nothing Nothing $ do + patternTest page + page <- addPage Nothing + newSection (toPDFString "Shading") Nothing Nothing $ do + drawWithPage page $ do + shadingTest + page <- addPage Nothing + newSection (toPDFString "Media") Nothing Nothing $ do + newSection (toPDFString "image") Nothing Nothing $ do + testImage page + + page <- addPage Nothing + newSection (toPDFString "Annotations") Nothing Nothing $ do + drawWithPage page $ do + testAnnotation + page <- addPage Nothing + newSection (toPDFString "Text") Nothing Nothing $ do + drawWithPage page $ do + textTest + newSection (toPDFString "Fun") Nothing Nothing $ do + penrose + + + +main :: IO() +main = do + let rect = PDFRect 0 0 600 400 + runPdf "demo.pdf" (standardDocInfo { author=toPDFString $ "alpheccar"}) rect $ do + testAll + diff --git a/c/ctext.h b/c/ctext.h new file mode 100644 --- /dev/null +++ b/c/ctext.h @@ -0,0 +1,7 @@ +#ifndef _CTEXT_H_ +#define _CTEXT_H_ +extern short c_getAdvance(unsigned short,unsigned char); +extern short c_getLeading(unsigned short); +extern short c_getDescent(unsigned short); +extern int c_hasKern(unsigned short); +#endif diff --git a/c/metrics.c b/c/metrics.c new file mode 100644 --- /dev/null +++ b/c/metrics.c @@ -0,0 +1,28 @@ +#include "metrics.h" +#include "ctext.h" +#include + +#define GFONTSIZE (255-32+1) +#define FFONTSIZE (5) + +short c_getAdvance(unsigned short font,unsigned char c) +{ + if (c<32) + return(0); + return(gmetric[font*GFONTSIZE+c-32]); +} + +short c_getLeading(unsigned short font) +{ + return(fmetric[font*FFONTSIZE+2]-fmetric[font*FFONTSIZE+3]); +} + +short c_getDescent(unsigned short font) +{ + return(-fmetric[font*FFONTSIZE+3]); +} + +int c_hasKern(unsigned short font) +{ + return(fmetric[font*FFONTSIZE+4]); +} diff --git a/c/metrics.h b/c/metrics.h new file mode 100644 --- /dev/null +++ b/c/metrics.h @@ -0,0 +1,3211 @@ +#ifndef _METRICS_H_ +#define _METRICS_H_ +static const unsigned long gmetric[]={ +278 +,278 +,355 +,556 +,556 +,889 +,667 +,222 +,333 +,333 +,389 +,584 +,278 +,333 +,278 +,278 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,278 +,278 +,584 +,584 +,584 +,556 +,1015 +,667 +,667 +,722 +,722 +,667 +,611 +,778 +,722 +,278 +,500 +,667 +,556 +,833 +,722 +,778 +,667 +,778 +,722 +,667 +,611 +,722 +,667 +,944 +,667 +,667 +,611 +,278 +,278 +,278 +,469 +,556 +,222 +,556 +,556 +,500 +,556 +,556 +,278 +,556 +,556 +,222 +,222 +,500 +,222 +,833 +,556 +,556 +,556 +,556 +,333 +,500 +,278 +,556 +,500 +,722 +,500 +,500 +,500 +,334 +,260 +,334 +,584 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,333 +,556 +,556 +,167 +,556 +,556 +,556 +,556 +,191 +,333 +,556 +,333 +,333 +,500 +,500 +,278 +,556 +,556 +,556 +,278 +,278 +,537 +,350 +,222 +,333 +,333 +,556 +,1000 +,1000 +,278 +,611 +,278 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,278 +,333 +,333 +,278 +,333 +,333 +,333 +,1000 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,1000 +,278 +,370 +,278 +,278 +,278 +,278 +,556 +,778 +,1000 +,365 +,278 +,278 +,278 +,278 +,278 +,889 +,278 +,278 +,278 +,278 +,278 +,278 +,222 +,611 +,944 +,611 +,278 +,278 +,278 +,278 +,278 +,333 +,474 +,556 +,556 +,889 +,722 +,278 +,333 +,333 +,389 +,584 +,278 +,333 +,278 +,278 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,333 +,333 +,584 +,584 +,584 +,611 +,975 +,722 +,722 +,722 +,722 +,667 +,611 +,778 +,722 +,278 +,556 +,722 +,611 +,833 +,722 +,778 +,667 +,778 +,722 +,667 +,611 +,722 +,667 +,944 +,667 +,667 +,611 +,333 +,278 +,333 +,584 +,556 +,278 +,556 +,611 +,556 +,611 +,556 +,333 +,611 +,611 +,278 +,278 +,556 +,278 +,889 +,611 +,611 +,611 +,611 +,389 +,556 +,333 +,611 +,556 +,778 +,556 +,556 +,500 +,389 +,280 +,389 +,584 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,333 +,556 +,556 +,167 +,556 +,556 +,556 +,556 +,238 +,500 +,556 +,333 +,333 +,611 +,611 +,278 +,556 +,556 +,556 +,278 +,278 +,556 +,350 +,278 +,500 +,500 +,556 +,1000 +,1000 +,278 +,611 +,278 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,278 +,333 +,333 +,278 +,333 +,333 +,333 +,1000 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,1000 +,278 +,370 +,278 +,278 +,278 +,278 +,611 +,778 +,1000 +,365 +,278 +,278 +,278 +,278 +,278 +,889 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,611 +,944 +,611 +,278 +,278 +,278 +,278 +,278 +,278 +,355 +,556 +,556 +,889 +,667 +,222 +,333 +,333 +,389 +,584 +,278 +,333 +,278 +,278 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,278 +,278 +,584 +,584 +,584 +,556 +,1015 +,667 +,667 +,722 +,722 +,667 +,611 +,778 +,722 +,278 +,500 +,667 +,556 +,833 +,722 +,778 +,667 +,778 +,722 +,667 +,611 +,722 +,667 +,944 +,667 +,667 +,611 +,278 +,278 +,278 +,469 +,556 +,222 +,556 +,556 +,500 +,556 +,556 +,278 +,556 +,556 +,222 +,222 +,500 +,222 +,833 +,556 +,556 +,556 +,556 +,333 +,500 +,278 +,556 +,500 +,722 +,500 +,500 +,500 +,334 +,260 +,334 +,584 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,333 +,556 +,556 +,167 +,556 +,556 +,556 +,556 +,191 +,333 +,556 +,333 +,333 +,500 +,500 +,278 +,556 +,556 +,556 +,278 +,278 +,537 +,350 +,222 +,333 +,333 +,556 +,1000 +,1000 +,278 +,611 +,278 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,278 +,333 +,333 +,278 +,333 +,333 +,333 +,1000 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,1000 +,278 +,370 +,278 +,278 +,278 +,278 +,556 +,778 +,1000 +,365 +,278 +,278 +,278 +,278 +,278 +,889 +,278 +,278 +,278 +,278 +,278 +,278 +,222 +,611 +,944 +,611 +,278 +,278 +,278 +,278 +,278 +,333 +,474 +,556 +,556 +,889 +,722 +,278 +,333 +,333 +,389 +,584 +,278 +,333 +,278 +,278 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,556 +,333 +,333 +,584 +,584 +,584 +,611 +,975 +,722 +,722 +,722 +,722 +,667 +,611 +,778 +,722 +,278 +,556 +,722 +,611 +,833 +,722 +,778 +,667 +,778 +,722 +,667 +,611 +,722 +,667 +,944 +,667 +,667 +,611 +,333 +,278 +,333 +,584 +,556 +,278 +,556 +,611 +,556 +,611 +,556 +,333 +,611 +,611 +,278 +,278 +,556 +,278 +,889 +,611 +,611 +,611 +,611 +,389 +,556 +,333 +,611 +,556 +,778 +,556 +,556 +,500 +,389 +,280 +,389 +,584 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,333 +,556 +,556 +,167 +,556 +,556 +,556 +,556 +,238 +,500 +,556 +,333 +,333 +,611 +,611 +,278 +,556 +,556 +,556 +,278 +,278 +,556 +,350 +,278 +,500 +,500 +,556 +,1000 +,1000 +,278 +,611 +,278 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,278 +,333 +,333 +,278 +,333 +,333 +,333 +,1000 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,1000 +,278 +,370 +,278 +,278 +,278 +,278 +,611 +,778 +,1000 +,365 +,278 +,278 +,278 +,278 +,278 +,889 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,611 +,944 +,611 +,278 +,278 +,278 +,278 +,250 +,333 +,408 +,500 +,500 +,833 +,778 +,333 +,333 +,333 +,500 +,564 +,250 +,333 +,250 +,278 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,278 +,278 +,564 +,564 +,564 +,444 +,921 +,722 +,667 +,667 +,722 +,611 +,556 +,722 +,722 +,333 +,389 +,722 +,611 +,889 +,722 +,722 +,556 +,722 +,667 +,556 +,611 +,722 +,722 +,944 +,722 +,722 +,611 +,333 +,278 +,333 +,469 +,500 +,333 +,444 +,500 +,444 +,500 +,444 +,333 +,500 +,500 +,278 +,278 +,500 +,278 +,778 +,500 +,500 +,500 +,500 +,333 +,389 +,278 +,500 +,500 +,722 +,500 +,500 +,444 +,480 +,200 +,480 +,541 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,333 +,500 +,500 +,167 +,500 +,500 +,500 +,500 +,180 +,444 +,500 +,333 +,333 +,556 +,556 +,250 +,500 +,500 +,500 +,250 +,250 +,453 +,350 +,333 +,444 +,444 +,500 +,1000 +,1000 +,250 +,444 +,250 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,250 +,333 +,333 +,250 +,333 +,333 +,333 +,1000 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,889 +,250 +,276 +,250 +,250 +,250 +,250 +,611 +,722 +,889 +,310 +,250 +,250 +,250 +,250 +,250 +,667 +,250 +,250 +,250 +,278 +,250 +,250 +,278 +,500 +,722 +,500 +,250 +,250 +,250 +,250 +,250 +,333 +,555 +,500 +,500 +,1000 +,833 +,333 +,333 +,333 +,500 +,570 +,250 +,333 +,250 +,278 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,333 +,333 +,570 +,570 +,570 +,500 +,930 +,722 +,667 +,722 +,722 +,667 +,611 +,778 +,778 +,389 +,500 +,778 +,667 +,944 +,722 +,778 +,611 +,778 +,722 +,556 +,667 +,722 +,722 +,1000 +,722 +,722 +,667 +,333 +,278 +,333 +,581 +,500 +,333 +,500 +,556 +,444 +,556 +,444 +,333 +,500 +,556 +,278 +,333 +,556 +,278 +,833 +,556 +,500 +,556 +,556 +,444 +,389 +,333 +,556 +,500 +,722 +,500 +,500 +,444 +,394 +,220 +,394 +,520 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,333 +,500 +,500 +,167 +,500 +,500 +,500 +,500 +,278 +,500 +,500 +,333 +,333 +,556 +,556 +,250 +,500 +,500 +,500 +,250 +,250 +,540 +,350 +,333 +,500 +,500 +,500 +,1000 +,1000 +,250 +,500 +,250 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,250 +,333 +,333 +,250 +,333 +,333 +,333 +,1000 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,1000 +,250 +,300 +,250 +,250 +,250 +,250 +,667 +,778 +,1000 +,330 +,250 +,250 +,250 +,250 +,250 +,722 +,250 +,250 +,250 +,278 +,250 +,250 +,278 +,500 +,722 +,556 +,250 +,250 +,250 +,250 +,250 +,333 +,420 +,500 +,500 +,833 +,778 +,333 +,333 +,333 +,500 +,675 +,250 +,333 +,250 +,278 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,333 +,333 +,675 +,675 +,675 +,500 +,920 +,611 +,611 +,667 +,722 +,611 +,611 +,722 +,722 +,333 +,444 +,667 +,556 +,833 +,667 +,722 +,611 +,722 +,611 +,500 +,556 +,722 +,611 +,833 +,611 +,556 +,556 +,389 +,278 +,389 +,422 +,500 +,333 +,500 +,500 +,444 +,500 +,444 +,278 +,500 +,500 +,278 +,278 +,444 +,278 +,722 +,500 +,500 +,500 +,500 +,389 +,389 +,278 +,500 +,444 +,667 +,444 +,444 +,389 +,400 +,275 +,400 +,541 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,389 +,500 +,500 +,167 +,500 +,500 +,500 +,500 +,214 +,556 +,500 +,333 +,333 +,500 +,500 +,250 +,500 +,500 +,500 +,250 +,250 +,523 +,350 +,333 +,556 +,556 +,500 +,889 +,1000 +,250 +,500 +,250 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,250 +,333 +,333 +,250 +,333 +,333 +,333 +,889 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,889 +,250 +,276 +,250 +,250 +,250 +,250 +,556 +,722 +,944 +,310 +,250 +,250 +,250 +,250 +,250 +,667 +,250 +,250 +,250 +,278 +,250 +,250 +,278 +,500 +,667 +,500 +,250 +,250 +,250 +,250 +,250 +,389 +,555 +,500 +,500 +,833 +,778 +,333 +,333 +,333 +,500 +,570 +,250 +,333 +,250 +,278 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,333 +,333 +,570 +,570 +,570 +,500 +,832 +,667 +,667 +,667 +,722 +,667 +,667 +,722 +,778 +,389 +,500 +,667 +,611 +,889 +,722 +,722 +,611 +,722 +,667 +,556 +,611 +,722 +,667 +,889 +,667 +,611 +,611 +,333 +,278 +,333 +,570 +,500 +,333 +,500 +,500 +,444 +,500 +,444 +,333 +,500 +,556 +,278 +,278 +,500 +,278 +,778 +,556 +,500 +,500 +,500 +,389 +,389 +,278 +,556 +,444 +,667 +,500 +,444 +,389 +,348 +,220 +,348 +,570 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,389 +,500 +,500 +,167 +,500 +,500 +,500 +,500 +,278 +,500 +,500 +,333 +,333 +,556 +,556 +,250 +,500 +,500 +,500 +,250 +,250 +,500 +,350 +,333 +,500 +,500 +,500 +,1000 +,1000 +,250 +,500 +,250 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,333 +,250 +,333 +,333 +,250 +,333 +,333 +,333 +,1000 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,944 +,250 +,266 +,250 +,250 +,250 +,250 +,611 +,722 +,944 +,300 +,250 +,250 +,250 +,250 +,250 +,722 +,250 +,250 +,250 +,278 +,250 +,250 +,278 +,500 +,722 +,500 +,250 +,250 +,250 +,250 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,600 +,250 +,333 +,713 +,500 +,549 +,833 +,778 +,439 +,333 +,333 +,500 +,549 +,250 +,549 +,250 +,278 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,500 +,278 +,278 +,549 +,549 +,549 +,444 +,549 +,722 +,667 +,722 +,612 +,611 +,763 +,603 +,722 +,333 +,631 +,722 +,686 +,889 +,722 +,722 +,768 +,741 +,556 +,592 +,611 +,690 +,439 +,768 +,645 +,795 +,611 +,333 +,863 +,333 +,658 +,500 +,500 +,631 +,549 +,549 +,494 +,439 +,521 +,411 +,603 +,329 +,603 +,549 +,549 +,576 +,521 +,549 +,549 +,521 +,549 +,603 +,439 +,576 +,713 +,686 +,493 +,686 +,494 +,480 +,200 +,480 +,549 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,250 +,750 +,620 +,247 +,549 +,167 +,713 +,500 +,753 +,753 +,753 +,753 +,1042 +,987 +,603 +,987 +,603 +,400 +,549 +,411 +,549 +,549 +,713 +,494 +,460 +,549 +,549 +,549 +,549 +,1000 +,603 +,1000 +,658 +,823 +,686 +,795 +,987 +,768 +,768 +,823 +,768 +,768 +,713 +,713 +,713 +,713 +,713 +,713 +,713 +,768 +,713 +,790 +,790 +,890 +,823 +,549 +,250 +,713 +,603 +,603 +,1042 +,987 +,603 +,987 +,603 +,494 +,329 +,790 +,790 +,786 +,713 +,384 +,384 +,384 +,384 +,384 +,384 +,494 +,494 +,494 +,494 +,250 +,329 +,274 +,686 +,686 +,686 +,384 +,384 +,384 +,384 +,384 +,384 +,494 +,494 +,494 +,250 +,278 +,974 +,961 +,974 +,980 +,719 +,789 +,790 +,791 +,690 +,960 +,939 +,549 +,855 +,911 +,933 +,911 +,945 +,974 +,755 +,846 +,762 +,761 +,571 +,677 +,763 +,760 +,759 +,754 +,494 +,552 +,537 +,577 +,692 +,786 +,788 +,788 +,790 +,793 +,794 +,816 +,823 +,789 +,841 +,823 +,833 +,816 +,831 +,923 +,744 +,723 +,749 +,790 +,792 +,695 +,776 +,768 +,792 +,759 +,707 +,708 +,682 +,701 +,826 +,815 +,789 +,789 +,707 +,687 +,696 +,689 +,786 +,787 +,713 +,791 +,785 +,791 +,873 +,761 +,762 +,762 +,759 +,759 +,892 +,892 +,788 +,784 +,438 +,138 +,277 +,415 +,392 +,392 +,668 +,668 +,278 +,390 +,390 +,317 +,317 +,276 +,276 +,509 +,509 +,410 +,410 +,234 +,234 +,334 +,334 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,278 +,732 +,544 +,544 +,910 +,667 +,760 +,760 +,776 +,595 +,694 +,626 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,788 +,894 +,838 +,1016 +,458 +,748 +,924 +,748 +,918 +,927 +,928 +,928 +,834 +,873 +,828 +,924 +,924 +,917 +,930 +,931 +,463 +,883 +,836 +,836 +,867 +,867 +,696 +,696 +,874 +,278 +,874 +,760 +,946 +,771 +,865 +,771 +,888 +,967 +,888 +,831 +,873 +,927 +,970 +,918 +,278}; +static const long fmetric[]={ +-100 +,50 +,718 +,-207 +,1 +,-100 +,50 +,718 +,-207 +,1 +,-100 +,50 +,718 +,-207 +,1 +,-100 +,50 +,718 +,-207 +,1 +,-100 +,50 +,683 +,-217 +,1 +,-100 +,50 +,683 +,-217 +,1 +,-100 +,50 +,683 +,-217 +,1 +,-100 +,50 +,683 +,-217 +,1 +,-100 +,50 +,629 +,-157 +,0 +,-100 +,50 +,629 +,-157 +,0 +,-100 +,50 +,629 +,-157 +,0 +,-100 +,50 +,629 +,-157 +,0 +,-100 +,50 +,0 +,0 +,0 +,-100 +,50 +,0 +,0 +,0}; +#endif