---------------------------------------------------------
-- |
-- 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 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
    String
newName <-
        String
-> (DrawState -> Map StrokeAlpha String)
-> (Map StrokeAlpha String -> DrawState -> DrawState)
-> StrokeAlpha
-> Draw String
forall a.
(Ord a, PdfResourceObject a) =>
String
-> (DrawState -> Map a String)
-> (Map a String -> DrawState -> DrawState)
-> a
-> Draw String
registerResource String
"ExtGState"
            DrawState -> Map StrokeAlpha String
strokeAlphas (\Map StrokeAlpha String
newMap DrawState
s -> DrawState
s { strokeAlphas = newMap })
            (Double -> StrokeAlpha
StrokeAlpha Double
alpha)
    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
    String
newName <-
        String
-> (DrawState -> Map FillAlpha String)
-> (Map FillAlpha String -> DrawState -> DrawState)
-> FillAlpha
-> Draw String
forall a.
(Ord a, PdfResourceObject a) =>
String
-> (DrawState -> Map a String)
-> (Map a String -> DrawState -> DrawState)
-> a
-> Draw String
registerResource String
"ExtGState"
            DrawState -> Map FillAlpha String
fillAlphas (\Map FillAlpha String
newMap DrawState
s -> DrawState
s { fillAlphas = newMap })
            (Double -> FillAlpha
FillAlpha Double
alpha)
    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 :: forall (m :: * -> *). MonadPath m => 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 :: forall (m :: * -> *). MonadPath m => 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" 
                    ]