module Helm.Color (
Color(..),
Gradient(..),
rgba,
rgb,
hsva,
hsv,
blend,
complement,
linear,
radial
) where
import GHC.Generics
data Color = Color !Double !Double !Double !Double deriving (Show, Eq, Ord, Read, Generic)
rgb :: Double -> Double -> Double -> Color
rgb r g b = rgba r g b 1
rgba :: Double -> Double -> Double -> Double -> Color
rgba r g b a
| r < 0 || r > 1 ||
g < 0 || g > 1 ||
b < 0 || b > 1 ||
a < 0 || a > 1 = error "Helm.Color.rgba: color components must be between 0 and 1"
| otherwise = Color r g b a
blend :: [Color] -> Color
blend colors =
(\(Color r g b a) -> Color (r / denom) (g / denom) (b / denom) (a / denom)) $ foldl blend' black colors
where
black = rgb 0 0 0
denom = fromIntegral $ length colors
blend' :: Color -> Color -> Color
blend' (Color r1 g1 b1 a1) (Color r2 g2 b2 a2) = Color (r1 + r2) (g1 + g2) (b1 + b2) (a1 + a2)
complement :: Color -> Color
complement (Color r g b a) = hsva (fromIntegral ((round (h + 180) :: Int) `mod` 360)) (s / mx) mx a
where
mx = r `max` g `max` b
mn = r `min` g `min` b
s = mx mn
h | mx == r = (g b) / s * 60
| mx == g = (b r) / s * 60 + 120
| mx == b = (r g) / s * 60 + 240
| otherwise = undefined
hsva :: Double -> Double -> Double -> Double -> Color
hsva h s v a
| h'' == 0 = rgba v t p a
| h'' == 1 = rgba q v p a
| h'' == 2 = rgba p v t a
| h'' == 3 = rgba p q v a
| h'' == 4 = rgba t p v a
| h'' == 5 = rgba v p q a
| otherwise = undefined
where
h' = h / 60
h'' = floor h' `mod` 6 :: Int
f = h' fromIntegral h''
p = v * (1 s)
q = v * (1 f * s)
t = v * (1 (1 f) * s)
hsv :: Double -> Double -> Double -> Color
hsv h s v = hsva h s v 1
data Gradient
= Linear !(Double, Double) !(Double, Double) ![(Double, Color)]
| Radial !(Double, Double) !Double !(Double, Double) !Double ![(Double, Color)]
deriving (Show, Eq, Ord, Read)
linear :: (Double, Double) -> (Double, Double) -> [(Double, Color)] -> Gradient
linear = Linear
radial :: (Double, Double) -> Double -> (Double, Double) -> Double -> [(Double, Color)] -> Gradient
radial = Radial