module Graphics.PDF.Colors(
Color(..)
, setRGBColorSpace
, fillColor
, strokeColor
, setStrokeAlpha
, setFillAlpha
, hsvToRgb
, 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
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"
]
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"
]
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"
fillColor :: MonadPath m => 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"
]
strokeColor :: MonadPath m => 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"
]