HPDF 0.3 → 1.0
raw patch · 36 files changed
+7380/−936 lines, 36 filesdep +encodingdep +zlibdep −regex-compatbinary-added
Dependencies added: encoding, zlib
Dependencies removed: regex-compat
Files
- Graphics/PDF.hs +206/−51
- Graphics/PDF/Action.hs +73/−0
- Graphics/PDF/Annotation.hs +122/−0
- Graphics/PDF/Color.hs +0/−60
- Graphics/PDF/Colors.hs +93/−0
- Graphics/PDF/Coordinates.hs +90/−0
- Graphics/PDF/Data/PDFTree.hs +204/−0
- Graphics/PDF/Demo.hs +151/−0
- Graphics/PDF/Document.hs +134/−0
- Graphics/PDF/Draw.hs +623/−0
- Graphics/PDF/File.hs +0/−174
- Graphics/PDF/Font.hs +0/−61
- Graphics/PDF/Geometry.hs +0/−71
- Graphics/PDF/Image.hs +288/−0
- Graphics/PDF/LowLevel.hs +0/−308
- Graphics/PDF/LowLevel/Kern.hs +7/−0
- Graphics/PDF/LowLevel/Types.hs +223/−0
- Graphics/PDF/Navigation.hs +129/−0
- Graphics/PDF/Pages.hs +266/−0
- Graphics/PDF/Pattern.hs +139/−0
- Graphics/PDF/Resources.hs +156/−0
- Graphics/PDF/Shading.hs +39/−80
- Graphics/PDF/Shape.hs +0/−75
- Graphics/PDF/Shapes.hs +264/−0
- Graphics/PDF/Text.hs +230/−41
- HPDF.cabal +43/−15
- LICENSE +27/−0
- README.txt +17/−0
- Test/AFMParser.hs +312/−0
- Test/Makefile +27/−0
- Test/Penrose.hs +113/−0
- Test/logo.jpg binary
- Test/test.hs +158/−0
- c/ctext.h +7/−0
- c/metrics.c +28/−0
- c/metrics.h +3211/−0
Graphics/PDF.hs view
@@ -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]+ }+
+ Graphics/PDF/Action.hs view
@@ -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
+ Graphics/PDF/Annotation.hs view
@@ -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 ()
− Graphics/PDF/Color.hs
@@ -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,[])--
+ Graphics/PDF/Colors.hs view
@@ -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" +
+ Graphics/PDF/Coordinates.hs view
@@ -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
+ Graphics/PDF/Data/PDFTree.hs view
@@ -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+ ++
+ Graphics/PDF/Demo.hs view
@@ -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 ""+
+ Graphics/PDF/Document.hs view
@@ -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}
+ Graphics/PDF/Draw.hs view
@@ -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
− Graphics/PDF/File.hs
@@ -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-
− Graphics/PDF/Font.hs
@@ -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-
− Graphics/PDF/Geometry.hs
@@ -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 )-
+ Graphics/PDF/Image.hs view
@@ -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
− Graphics/PDF/LowLevel.hs
@@ -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)- --
+ Graphics/PDF/LowLevel/Kern.hs view
@@ -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)]
+ Graphics/PDF/LowLevel/Types.hs view
@@ -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
@@ -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}
+ Graphics/PDF/Pages.hs view
@@ -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)}+
+ Graphics/PDF/Pattern.hs view
@@ -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")
+ Graphics/PDF/Resources.hs view
@@ -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++
Graphics/PDF/Shading.hs view
@@ -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
− Graphics/PDF/Shape.hs
@@ -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,[])
+ Graphics/PDF/Shapes.hs view
@@ -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*"
Graphics/PDF/Text.hs view
@@ -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+
HPDF.cabal view
@@ -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
+ LICENSE view
@@ -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.+
+ README.txt view
@@ -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
+ Test/AFMParser.hs view
@@ -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+ +
+ Test/Makefile view
@@ -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+
+ Test/Penrose.hs view
@@ -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'+++
+ Test/logo.jpg view
binary file changed (absent → 2745 bytes)
+ Test/test.hs view
@@ -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+
+ c/ctext.h view
@@ -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
+ c/metrics.c view
@@ -0,0 +1,28 @@+#include "metrics.h"+#include "ctext.h"+#include <stdio.h>++#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]);+}
+ c/metrics.h view
@@ -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