Shading.hs

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