Colors.hs

---------------------------------------------------------
-- |
-- 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"