module Graphics.PDF.Shading
(
Shading(..)
, createShading, strokeShading, fillShading
)
where
import Graphics.PDF.LowLevel
import Text.Printf
import Graphics.PDF.Color
data Shading = Axial Color Color Float Float Float Float
| Radial Color Color Float Float Float Float Float Float
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
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)
]
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"
patternName :: Shading -> String
patternName s = "pattern" ++ (show s)
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))
]
createShading :: Shading -> PdfCmd
createShading s = (PdfNone,newPattern s)
strokeShading :: Shading -> PdfCmd
strokeShading s = (PdfStrokePattern (patternName s),[])
fillShading :: Shading -> PdfCmd
fillShading s = (PdfFillPattern (patternName s),[])