module Data.Prizm.Color.SRGB
( clamp
, parse
, showRGB
, toXYZMatrix
, transform
) where
import Control.Applicative
import Data.Convertible.Base
import Data.Monoid
import Data.Prizm.Color.Matrices.RGB
import Data.Prizm.Color.Transform
import Data.Prizm.Types
import Data.String
import qualified Data.Text as T
import Data.Text.Read as R
import Data.Word
import Numeric (showHex)
instance PresetColor RGB where
white = RGB 255 255 255
black = RGB 0 0 0
transform :: Integer -> Double
transform v | dv > 0.04045 = (((dv + 0.055) / ap) ** 2.4) * 100
| otherwise = (dv / 12.92) * 100
where dv = fromIntegral v / 255
ap = 1.0 + 0.055
clamp :: Word8 -> Word8
clamp i = max (min i 255) 0
showRGB :: RGB -> Hex
showRGB c =
(("#"++) . showHex2 r' . showHex2 g' . showHex2 b') ""
where
(RGB r' g' b') = c
showHex2 x | x <= 0xf = ("0"++) . showHex x
| otherwise = showHex x
parse :: T.Text -> RGB
parse t =
case T.uncons t of
Just ('#', cs) | T.all isHex cs ->
case T.unpack cs of
[a, b, c, d, e, f, _g, _h] -> RGB (hex a b) (hex c d) (hex e f)
[a, b, c, d, e, f ] -> RGB (hex a b) (hex c d) (hex e f)
[a, b, c, _d ] -> RGB (hex a a) (hex b b) (hex c c)
[a, b, c ] -> RGB (hex a a) (hex b b) (hex c c)
_ -> err
_ -> err
where
hex a b = either err fst (R.hexadecimal (T.singleton a <> T.singleton b))
isHex a = (a >= 'a' && a <= 'f') || (a >= 'A' && a <= 'F') || (a >= '0' && a <= '9')
err = error "Invalid color string"
instance Convertible RGB CIEXYZ where
safeConvert = Right . (toXYZMatrix d65SRGB)
instance Convertible RGB Hex where
safeConvert = Right . showRGB
instance Convertible Hex RGB where
safeConvert = Right . parse . fromString
toXYZMatrix :: RGBtoXYZ -> RGB -> CIEXYZ
toXYZMatrix (RGBtoXYZ m) (RGB r g b) =
let t = ZipList ((transform . fromIntegral) <$> (clamp <$> [r,g,b]))
[x,y,z] = (roundN 3) <$> ((zipTransform t) <$> m)
in CIEXYZ x y z