-- | 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),[])