---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- 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
import Control.Monad.Writer
import Graphics.PDF.LowLevel.Serializer
            
black :: Color
black :: Color
black = Double -> Double -> Double -> Color
Rgb Double
0 Double
0 Double
0  

white :: Color
white :: Color
white = Double -> Double -> Double -> Color
Rgb Double
1 Double
1 Double
1

red :: Color
red :: Color
red = Double -> Double -> Double -> Color
Rgb Double
1 Double
0 Double
0

green :: Color
green :: Color
green = Double -> Double -> Double -> Color
Rgb Double
0 Double
1 Double
0

blue :: Color
blue :: Color
blue = Double -> Double -> Double -> Color
Rgb Double
0 Double
0 Double
1
            

       
-- | Set alpha value for transparency
setStrokeAlpha :: Double -> Draw ()
setStrokeAlpha :: Double -> Draw ()
setStrokeAlpha Double
alpha = do
    Map StrokeAlpha String
alphaMap <- (DrawState -> Map StrokeAlpha String)
-> Draw (Map StrokeAlpha String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map StrokeAlpha String
strokeAlphas
    (String
newName,Map StrokeAlpha String
newMap) <- String
-> StrokeAlpha
-> Map StrokeAlpha String
-> Draw (String, Map StrokeAlpha String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"ExtGState" (Double -> StrokeAlpha
StrokeAlpha Double
alpha) Map StrokeAlpha String
alphaMap
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { strokeAlphas :: Map StrokeAlpha String
strokeAlphas = Map StrokeAlpha String
newMap }
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" gs"
                    ]
        
-- | Set alpha value for transparency
setFillAlpha :: Double -> Draw ()
setFillAlpha :: Double -> Draw ()
setFillAlpha Double
alpha = do
    Map FillAlpha String
alphaMap <- (DrawState -> Map FillAlpha String) -> Draw (Map FillAlpha String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map FillAlpha String
fillAlphas
    (String
newName,Map FillAlpha String
newMap) <- String
-> FillAlpha
-> Map FillAlpha String
-> Draw (String, Map FillAlpha String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"ExtGState" (Double -> FillAlpha
FillAlpha Double
alpha) Map FillAlpha String
alphaMap
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { fillAlphas :: Map FillAlpha String
fillAlphas = Map FillAlpha String
newMap }
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" gs"
                    ]
    
-- | Init the PDF color space to RGB.
setRGBColorSpace :: Draw ()
setRGBColorSpace :: Draw ()
setRGBColorSpace = Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ()) -> (String -> Builder) -> String -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Draw ()) -> String -> Draw ()
forall a b. (a -> b) -> a -> b
$ String
"\n/DeviceRGB CS\n/DeviceRGB cs\n"



-- | Select the filling color
fillColor :: MonadPath m => Color -- ^ Filling color
          -> m ()
fillColor :: Color -> m ()
fillColor (Rgb Double
r Double
g Double
b) = do
    Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> m ()) -> ([Builder] -> Builder) -> [Builder] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> m ()) -> [Builder] -> m ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n"
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
r
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
g
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
b
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" rg" 
                    ]
                    
fillColor (Hsv Double
h Double
s Double
v) = do
        let (Double
r,Double
g,Double
b) = (Double, Double, Double) -> (Double, Double, Double)
hsvToRgb (Double
h,Double
s,Double
v)
        Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> m ()) -> ([Builder] -> Builder) -> [Builder] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> m ()) -> [Builder] -> m ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n"
                        , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
r
                        , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                        , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
g
                        , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                        , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
b
                        , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" rg" 
                        ]

-- | Select the drawing color
strokeColor :: MonadPath m => Color -- ^ Drawing color
            -> m ()
strokeColor :: Color -> m ()
strokeColor (Rgb Double
r Double
g Double
b) = do
    Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> m ()) -> ([Builder] -> Builder) -> [Builder] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> m ()) -> [Builder] -> m ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n"
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
r
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
g
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
b
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" RG" 
                    ]
strokeColor (Hsv Double
h Double
s Double
v) = do
    let (Double
r,Double
g,Double
b) = (Double, Double, Double) -> (Double, Double, Double)
hsvToRgb (Double
h,Double
s,Double
v)
    Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> m ()) -> ([Builder] -> Builder) -> [Builder] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> m ()) -> [Builder] -> m ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n"
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
r
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
g
                    , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                    , Double -> Builder
forall a. PdfObject a => a -> Builder
toPDF Double
b
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" RG" 
                    ]