module Data.Colour.CIE
(Colour
,cieXYZ, cieXYZView, luminance
,toCIEXYZ
,Chromaticity
,mkChromaticity, chromaCoords
,chromaX, chromaY, chromaZ
,chromaConvert
,chromaColour
,lightness, cieLABView, cieLAB
)
where
import Data.List
import Data.Colour
import Data.Colour.RGB
import Data.Colour.SRGB.Linear
import Data.Colour.CIE.Chromaticity
import Data.Colour.Matrix
cieXYZ :: (Fractional a) => a -> a -> a -> Colour a
cieXYZ :: a -> a -> a -> Colour a
cieXYZ x :: a
x y :: a
y z :: a
z = a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
rgb a
r a
g a
b
where
[r :: a
r,g :: a
g,b :: a
b] = [[a]] -> [a] -> [a]
forall b. Num b => [[b]] -> [b] -> [b]
mult [[a]]
matrix [a
x,a
y,a
z]
matrix :: [[a]]
matrix = ([Rational] -> [a]) -> [[Rational]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> a) -> [Rational] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Rational -> a
forall a. Fractional a => Rational -> a
fromRational) [[Rational]]
xyz2rgb709
cieXYZView :: (Fractional a) => Colour a -> (a,a,a)
cieXYZView :: Colour a -> (a, a, a)
cieXYZView c :: Colour a
c = (a
x,a
y,a
z)
where
RGB r :: a
r g :: a
g b :: a
b = Colour a -> RGB a
forall a. Fractional a => Colour a -> RGB a
toRGB Colour a
c
[x :: a
x,y :: a
y,z :: a
z] = [[a]] -> [a] -> [a]
forall b. Num b => [[b]] -> [b] -> [b]
mult [[a]]
matrix [a
r,a
g,a
b]
matrix :: [[a]]
matrix = ([Rational] -> [a]) -> [[Rational]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> a) -> [Rational] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Rational -> a
forall a. Fractional a => Rational -> a
fromRational) [[Rational]]
rgb7092xyz
{-# DEPRECATED toCIEXYZ "`toCIEXYZ' has been renamed `cieXYZView'" #-}
toCIEXYZ :: Colour a -> (a, a, a)
toCIEXYZ x :: Colour a
x = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
cieXYZView Colour a
x
luminance :: (Fractional a) => Colour a -> a
luminance :: Colour a -> a
luminance c :: Colour a
c = a
y
where
(x :: a
x,y :: a
y,z :: a
z) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
toCIEXYZ Colour a
c
instance AffineSpace Chromaticity where
affineCombo :: [(a, Chromaticity a)] -> Chromaticity a -> Chromaticity a
affineCombo l :: [(a, Chromaticity a)]
l z :: Chromaticity a
z =
(Chromaticity a -> Chromaticity a -> Chromaticity a)
-> [Chromaticity a] -> Chromaticity a
forall a. (a -> a -> a) -> [a] -> a
foldl1' Chromaticity a -> Chromaticity a -> Chromaticity a
forall a.
Num a =>
Chromaticity a -> Chromaticity a -> Chromaticity a
chromaAdd [a -> Chromaticity a -> Chromaticity a
forall a. Num a => a -> Chromaticity a -> Chromaticity a
chromaScale a
w Chromaticity a
a | (w :: a
w,a :: Chromaticity a
a) <- (1a -> a -> a
forall a. Num a => a -> a -> a
-a
total,Chromaticity a
z)(a, Chromaticity a)
-> [(a, Chromaticity a)] -> [(a, Chromaticity a)]
forall a. a -> [a] -> [a]
:[(a, Chromaticity a)]
l]
where
total :: a
total = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ((a, Chromaticity a) -> a) -> [(a, Chromaticity a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Chromaticity a) -> a
forall a b. (a, b) -> a
fst [(a, Chromaticity a)]
l
(Chroma x0 :: a
x0 y0 :: a
y0) chromaAdd :: Chromaticity a -> Chromaticity a -> Chromaticity a
`chromaAdd` (Chroma x1 :: a
x1 y1 :: a
y1) = a -> a -> Chromaticity a
forall a. a -> a -> Chromaticity a
Chroma (a
x0a -> a -> a
forall a. Num a => a -> a -> a
+a
x1) (a
y0a -> a -> a
forall a. Num a => a -> a -> a
+a
y1)
s :: a
s chromaScale :: a -> Chromaticity a -> Chromaticity a
`chromaScale` (Chroma x :: a
x y :: a
y) = a -> a -> Chromaticity a
forall a. a -> a -> Chromaticity a
Chroma (a
sa -> a -> a
forall a. Num a => a -> a -> a
*a
x) (a
sa -> a -> a
forall a. Num a => a -> a -> a
*a
y)
chromaColour :: (Fractional a) =>
Chromaticity a
-> a
-> Colour a
chromaColour :: Chromaticity a -> a -> Colour a
chromaColour ch :: Chromaticity a
ch y :: a
y = a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
cieXYZ (a
sa -> a -> a
forall a. Num a => a -> a -> a
*a
ch_x) a
y (a
sa -> a -> a
forall a. Num a => a -> a -> a
*a
ch_z)
where
(ch_x :: a
ch_x, ch_y :: a
ch_y, ch_z :: a
ch_z) = Chromaticity a -> (a, a, a)
forall a. Fractional a => Chromaticity a -> (a, a, a)
chromaCoords Chromaticity a
ch
s :: a
s = a
ya -> a -> a
forall a. Fractional a => a -> a -> a
/a
ch_y
lightness :: (Ord a, Floating a) => Chromaticity a
-> Colour a -> a
lightness :: Chromaticity a -> Colour a -> a
lightness white_ch :: Chromaticity a
white_ch c :: Colour a
c | (6a -> a -> a
forall a. Fractional a => a -> a -> a
/29)a -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^3 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y' = 116a -> a -> a
forall a. Num a => a -> a -> a
*a
y'a -> a -> a
forall a. Floating a => a -> a -> a
**(1a -> a -> a
forall a. Fractional a => a -> a -> a
/3) a -> a -> a
forall a. Num a => a -> a -> a
- 16
| Bool
otherwise = (29a -> a -> a
forall a. Fractional a => a -> a -> a
/3)a -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^3a -> a -> a
forall a. Num a => a -> a -> a
*a
y'
where
white :: Colour a
white = Chromaticity a -> a -> Colour a
forall a. Fractional a => Chromaticity a -> a -> Colour a
chromaColour Chromaticity a
white_ch 1.0
y' :: a
y' = (Colour a -> a
forall a. Fractional a => Colour a -> a
luminance Colour a
ca -> a -> a
forall a. Fractional a => a -> a -> a
/Colour a -> a
forall a. Fractional a => Colour a -> a
luminance Colour a
white)
cieLABView :: (Ord a, Floating a) => Chromaticity a
-> Colour a -> (a,a,a)
cieLABView :: Chromaticity a -> Colour a -> (a, a, a)
cieLABView white_ch :: Chromaticity a
white_ch c :: Colour a
c = (Chromaticity a -> Colour a -> a
forall a. (Ord a, Floating a) => Chromaticity a -> Colour a -> a
lightness Chromaticity a
white_ch Colour a
c, a
a, a
b)
where
white :: Colour a
white = Chromaticity a -> a -> Colour a
forall a. Fractional a => Chromaticity a -> a -> Colour a
chromaColour Chromaticity a
white_ch 1.0
(x :: a
x,y :: a
y,z :: a
z) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
toCIEXYZ Colour a
c
(xn :: a
xn,yn :: a
yn,zn :: a
zn) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
toCIEXYZ Colour a
white
(fx :: a
fx, fy :: a
fy, fz :: a
fz) = (a -> a
forall a. (Floating a, Ord a) => a -> a
f (a
xa -> a -> a
forall a. Fractional a => a -> a -> a
/a
xn), a -> a
forall a. (Floating a, Ord a) => a -> a
f (a
ya -> a -> a
forall a. Fractional a => a -> a -> a
/a
yn), a -> a
forall a. (Floating a, Ord a) => a -> a
f (a
za -> a -> a
forall a. Fractional a => a -> a -> a
/a
zn))
a :: a
a = 500a -> a -> a
forall a. Num a => a -> a -> a
*(a
fx a -> a -> a
forall a. Num a => a -> a -> a
- a
fy)
b :: a
b = 200a -> a -> a
forall a. Num a => a -> a -> a
*(a
fy a -> a -> a
forall a. Num a => a -> a -> a
- a
fz)
f :: a -> a
f x :: a
x | (6a -> a -> a
forall a. Fractional a => a -> a -> a
/29)a -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^3 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x = a
xa -> a -> a
forall a. Floating a => a -> a -> a
**(1a -> a -> a
forall a. Fractional a => a -> a -> a
/3)
| Bool
otherwise = 841a -> a -> a
forall a. Fractional a => a -> a -> a
/108a -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ 4a -> a -> a
forall a. Fractional a => a -> a -> a
/29
cieLAB :: (Ord a, Floating a) => Chromaticity a
-> a
-> a
-> a
-> Colour a
cieLAB :: Chromaticity a -> a -> a -> a -> Colour a
cieLAB white_ch :: Chromaticity a
white_ch l :: a
l a :: a
a b :: a
b = a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
cieXYZ (a
xna -> a -> a
forall a. Num a => a -> a -> a
*a -> a
transform a
fx)
(a
yna -> a -> a
forall a. Num a => a -> a -> a
*a -> a
transform a
fy)
(a
zna -> a -> a
forall a. Num a => a -> a -> a
*a -> a
transform a
fz)
where
white :: Colour a
white = Chromaticity a -> a -> Colour a
forall a. Fractional a => Chromaticity a -> a -> Colour a
chromaColour Chromaticity a
white_ch 1.0
(xn :: a
xn,yn :: a
yn,zn :: a
zn) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
toCIEXYZ Colour a
white
fx :: a
fx = a
fy a -> a -> a
forall a. Num a => a -> a -> a
+ a
aa -> a -> a
forall a. Fractional a => a -> a -> a
/500
fy :: a
fy = (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ 16)a -> a -> a
forall a. Fractional a => a -> a -> a
/116
fz :: a
fz = a
fy a -> a -> a
forall a. Num a => a -> a -> a
- a
ba -> a -> a
forall a. Fractional a => a -> a -> a
/200
delta :: a
delta = 6a -> a -> a
forall a. Fractional a => a -> a -> a
/29
transform :: a -> a
transform fa :: a
fa | a
fa a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
delta = a
faa -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^3
| Bool
otherwise = (a
fa a -> a -> a
forall a. Num a => a -> a -> a
- 16a -> a -> a
forall a. Fractional a => a -> a -> a
/116)a -> a -> a
forall a. Num a => a -> a -> a
*3a -> a -> a
forall a. Num a => a -> a -> a
*a
deltaa -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^2
cieLuv :: (Ord a, Floating a) => Chromaticity a
-> Colour a -> (a,a,a)
cieLuv :: Chromaticity a -> Colour a -> (a, a, a)
cieLuv white_ch :: Chromaticity a
white_ch c :: Colour a
c = (a
l, 13a -> a -> a
forall a. Num a => a -> a -> a
*a
la -> a -> a
forall a. Num a => a -> a -> a
*(a
u'a -> a -> a
forall a. Num a => a -> a -> a
-a
un'), 13a -> a -> a
forall a. Num a => a -> a -> a
*a
la -> a -> a
forall a. Num a => a -> a -> a
*(a
v'a -> a -> a
forall a. Num a => a -> a -> a
-a
vn'))
where
white :: Colour a
white = Chromaticity a -> a -> Colour a
forall a. Fractional a => Chromaticity a -> a -> Colour a
chromaColour Chromaticity a
white_ch 1.0
(u' :: a
u', v' :: a
v') = Colour a -> (a, a)
forall a. (Ord a, Floating a) => Colour a -> (a, a)
u'v' Colour a
c
(un' :: a
un', vn' :: a
vn') = Colour a -> (a, a)
forall a. (Ord a, Floating a) => Colour a -> (a, a)
u'v' Colour a
white
l :: a
l = Chromaticity a -> Colour a -> a
forall a. (Ord a, Floating a) => Chromaticity a -> Colour a -> a
lightness Chromaticity a
white_ch Colour a
c
u'v' :: (Ord a, Floating a) => Colour a -> (a,a)
u'v' :: Colour a -> (a, a)
u'v' c :: Colour a
c = (4a -> a -> a
forall a. Num a => a -> a -> a
*a
xa -> a -> a
forall a. Fractional a => a -> a -> a
/(a
xa -> a -> a
forall a. Num a => a -> a -> a
+15a -> a -> a
forall a. Num a => a -> a -> a
*a
ya -> a -> a
forall a. Num a => a -> a -> a
+3a -> a -> a
forall a. Num a => a -> a -> a
*a
z), 9a -> a -> a
forall a. Num a => a -> a -> a
*a
ya -> a -> a
forall a. Fractional a => a -> a -> a
/(a
xa -> a -> a
forall a. Num a => a -> a -> a
+15a -> a -> a
forall a. Num a => a -> a -> a
*a
ya -> a -> a
forall a. Num a => a -> a -> a
+3a -> a -> a
forall a. Num a => a -> a -> a
*a
z))
where
(x :: a
x,y :: a
y,z :: a
z) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
toCIEXYZ Colour a
c
rgb7092xyz :: [[Rational]]
rgb7092xyz = (RGBGamut -> [[Rational]]
rgb2xyz RGBGamut
sRGBGamut)
xyz2rgb709 :: [[Rational]]
xyz2rgb709 = [[Rational]] -> [[Rational]]
forall a. Fractional a => [[a]] -> [[a]]
inverse [[Rational]]
rgb7092xyz