\section{Color}
\begin{code}
module RSAGL.Color
(RGB(..),
RGBA(..),
rgba,
rgba256,
ColorClass(..),
addRGB,
scaleRGB,
rgbToOpenGL,
rgbaToOpenGL)
where
import Control.Parallel.Strategies
import Graphics.Rendering.OpenGL.GL.VertexSpec
import RSAGL.AbstractVector
\end{code}
\texttt{addColor} paints a color on top of another color using the additive color system. For example, \texttt{red `addColor` green == yellow}.
\texttt{filterColor} paints a color on top of another color using the subtractive color system (actually, multiplicative). For example, \texttt{yellow `filterColor` green == green}, but \texttt{red `filterColor` green == black}.
\texttt{rgb256} works for colors specified in hexadecimal. For example, X11 ForestGreen is \texttt{rgb256 0x22 0x8B 0x22}.
\begin{code}
data RGB = RGB { rgb_red, rgb_green, rgb_blue :: !Float }
deriving (Eq,Show)
data RGBA = RGBA { rgba_a :: !Float, rgba_rgb :: !RGB }
deriving (Eq,Show)
instance NFData RGB where
instance NFData RGBA where
class (AbstractVector c) => ColorClass c where
rgb :: Float -> Float -> Float -> c
rgb256 :: (Integral i) => i -> i -> i -> c
alpha :: Float -> c -> RGBA
alpha256 :: (Integral i) => i -> c -> RGBA
clampColor :: c -> c
mapRGB :: (Float -> Float) -> c -> c
zipColor :: (Float -> Float -> Float) -> c -> c -> c
brightness :: c -> Float
colorToOpenGL :: c -> IO ()
toRGBA :: c -> RGBA
instance ColorClass RGB where
rgb = RGB
rgb256 r g b = rgb (i2f256 r) (i2f256 g) (i2f256 b)
alpha = RGBA
alpha256 a = alpha (i2f256 a)
clampColor = mapRGB (min 1 . max 0)
mapRGB f (RGB r g b) = RGB (f r) (f g) (f b)
zipColor f (RGB r1 g1 b1) (RGB r2 g2 b2) = RGB (f r1 r2) (f g1 g2) (f b1 b2)
brightness (RGB r g b) = 0.2126 * r + 0.7152 * g + 0.0722 * b
colorToOpenGL = rgbToOpenGL
toRGBA = RGBA 1
instance ColorClass RGBA where
rgb = rgba 1.0
rgb256 = rgba256 255
alpha x (RGBA a rgb_color) = RGBA (x*a) rgb_color
alpha256 i (RGBA a rgb_color) = RGBA ((i2f256 i)*a) rgb_color
clampColor (RGBA a rgb_color) = RGBA (min 1 $ max 0 a) $ clampColor rgb_color
mapRGB f (RGBA a rgb_color) = RGBA a $ mapRGB f rgb_color
zipColor f (RGBA a1 c1) (RGBA a2 c2) = RGBA (f a1 a2) (zipColor f c1 c2)
brightness (RGBA a rgb_color) = brightness rgb_color * a
colorToOpenGL = rgbaToOpenGL
toRGBA = id
i2f256 :: (Integral i) => i -> Float
i2f256 = (/ 255) . fromIntegral
rgba :: Float -> Float -> Float -> Float -> RGBA
rgba r g b a = alpha a $ (rgb r g b :: RGB)
rgba256 :: (Integral i) => i -> i -> i -> i -> RGBA
rgba256 r g b a = alpha256 a $ (rgb256 r g b :: RGB)
addRGB :: RGB -> RGB -> RGB
addRGB = addColor
addColor :: (ColorClass c) => c -> c -> c
addColor = zipColor (+)
subColor :: (ColorClass c) => c -> c -> c
subColor = zipColor ()
scaleRGB :: (ColorClass c) => Float -> c -> c
scaleRGB x = mapRGB (*x)
scaleRGBA :: Float -> RGBA -> RGBA
scaleRGBA x c = c { rgba_a = x * rgba_a c,
rgba_rgb = scaleRGB x (rgba_rgb c) }
rgbToOpenGL :: RGB -> IO ()
rgbToOpenGL (RGB r g b) = color $! Color4 r g b 1
rgbaToOpenGL :: RGBA -> IO ()
rgbaToOpenGL (RGBA a (RGB r g b)) = color $! Color4 r g b a
instance AbstractZero RGB where
zero = rgb 0 0 0
instance AbstractAdd RGB RGB where
add = addColor
instance AbstractSubtract RGB RGB where
sub = subColor
instance AbstractScale RGB where
scalarMultiply d = scaleRGB (realToFrac d)
instance AbstractVector RGB
instance AbstractZero RGBA where
zero = rgba 0 0 0 0
instance AbstractAdd RGBA RGBA where
add = addColor
instance AbstractSubtract RGBA RGBA where
sub = subColor
instance AbstractScale RGBA where
scalarMultiply d = scaleRGBA (realToFrac d)
instance AbstractVector RGBA
\end{code}