module Data.Prizm.Color.CIE.XYZ
(
toRGB
, toRGBMatrix
, toLAB
, toLCH
, toHex
, fromRGB
, fromHex
, fromLAB
, fromLCH
) where
import Control.Applicative
import Data.Prizm.Types
import Data.Prizm.Color.Transform
import Data.Prizm.Color.Matrices.XYZ
import Data.Prizm.Color.CIE (v1, v2, refWhite)
import qualified Data.Prizm.Color.SRGB as S
import qualified Data.Prizm.Color.CIE.LAB as LB
import qualified Data.Prizm.Color.CIE.LCH as LC
transformRGB :: Double -> Integer
transformRGB v | v > 0.0031308 = min (round ((1.055 * (v ** (1 / 2.4)) 0.055) * 255)) 255
| otherwise = min (round ((12.92 * v) * 255)) 255
transformLAB :: Double -> Double
transformLAB v | v > v1 = v ** (1/3)
| otherwise = (v2 * v) + (16 / 116)
toRGB :: CIEXYZ Double -> RGB Integer
toRGB = (toRGBMatrix d65SRGB)
toRGBMatrix :: XYZtoRGB -> CIEXYZ Double -> RGB Integer
toRGBMatrix (XYZtoRGB m) (CIEXYZ x y z) =
let t = ZipList ((/100) <$> [x,y,z])
[r,g,b] = (transformRGB) <$> ((zipTransform t) <$> m)
in (S.clamp) <$> RGB r g b
fromRGB :: RGB Integer -> CIEXYZ Double
fromRGB = S.toXYZ
toHex :: CIEXYZ Double -> Hex
toHex = S.toHex . toRGB
fromHex :: Hex -> CIEXYZ Double
fromHex = S.toXYZ . S.fromHex
toLAB :: CIEXYZ Double -> CIELAB Double
toLAB (CIEXYZ x y z) =
let v = getZipList $ ZipList ((/) <$> [x,y,z]) <*> ZipList refWhite
[tx,ty,tz] = (transformLAB) <$> v
l = (116 * ty) 16
a = 500 * (tx ty)
b = 200 * (ty tz)
in CIELAB l a b
fromLAB :: CIELAB Double -> CIEXYZ Double
fromLAB = LB.toXYZ
toLCH :: CIEXYZ Double -> CIELCH Double
toLCH = LB.toLCH . toLAB
fromLCH :: CIELCH Double -> CIEXYZ Double
fromLCH = LC.toXYZ