{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Illuminant.CIE1964
( CIE1964(..)
) where
import Graphics.Color.Space.Internal (Illuminant(..), WhitePoint(..))
import qualified Graphics.Color.Illuminant.CIE1931 as I2
instance Illuminant 'A where
type Temperature 'A = 2856
whitePoint :: WhitePoint 'A e
whitePoint = e -> e -> WhitePoint 'A e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.45117 e
0.40594
colorTemperature :: CCT 'A
colorTemperature = Int -> Double -> CCT 'A
forall k (i :: k). Int -> Double -> CCT i
I2.rectifyColorTemperature Int
2848 Double
1.4350
instance Illuminant 'B where
type Temperature 'B = 4874
whitePoint :: WhitePoint 'B e
whitePoint = e -> e -> WhitePoint 'B e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34980 e
0.35270
instance Illuminant 'C where
type Temperature 'C = 6774
whitePoint :: WhitePoint 'C e
whitePoint = e -> e -> WhitePoint 'C e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31039 e
0.31905
instance Illuminant 'D50 where
type Temperature 'D50 = 5003
whitePoint :: WhitePoint 'D50 e
whitePoint = e -> e -> WhitePoint 'D50 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34773 e
0.35952
colorTemperature :: CCT 'D50
colorTemperature = Int -> Double -> CCT 'D50
forall k (i :: k). Int -> Double -> CCT i
I2.rectifyColorTemperature Int
5000 Double
1.4380
instance Illuminant 'D55 where
type Temperature 'D55 = 5503
whitePoint :: WhitePoint 'D55 e
whitePoint = e -> e -> WhitePoint 'D55 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.33412 e
0.34877
colorTemperature :: CCT 'D55
colorTemperature = Int -> Double -> CCT 'D55
forall k (i :: k). Int -> Double -> CCT i
I2.rectifyColorTemperature Int
5500 Double
1.4380
instance Illuminant 'D60 where
type Temperature 'D60 = 6003
whitePoint :: WhitePoint 'D60 e
whitePoint = e -> e -> WhitePoint 'D60 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.32299 e
0.33928
colorTemperature :: CCT 'D60
colorTemperature = Int -> Double -> CCT 'D60
forall k (i :: k). Int -> Double -> CCT i
I2.rectifyColorTemperature Int
6000 Double
1.4380
instance Illuminant 'D65 where
type Temperature 'D65 = 6504
whitePoint :: WhitePoint 'D65 e
whitePoint = e -> e -> WhitePoint 'D65 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31381 e
0.33098
colorTemperature :: CCT 'D65
colorTemperature = Int -> Double -> CCT 'D65
forall k (i :: k). Int -> Double -> CCT i
I2.rectifyColorTemperature Int
6500 Double
1.4380
instance Illuminant 'D75 where
type Temperature 'D75 = 7504
whitePoint :: WhitePoint 'D75 e
whitePoint = e -> e -> WhitePoint 'D75 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.29968 e
0.31740
colorTemperature :: CCT 'D75
colorTemperature = Int -> Double -> CCT 'D75
forall k (i :: k). Int -> Double -> CCT i
I2.rectifyColorTemperature Int
7500 Double
1.4380
instance Illuminant 'E where
type Temperature 'E = 5454
whitePoint :: WhitePoint 'E e
whitePoint = e -> e -> WhitePoint 'E e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint (e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
3) (e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
3)
instance Illuminant 'FL1 where
type Temperature 'FL1 = 6430
whitePoint :: WhitePoint 'FL1 e
whitePoint = e -> e -> WhitePoint 'FL1 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31811 e
0.33559
instance Illuminant 'FL2 where
type Temperature 'FL2 = 4230
whitePoint :: WhitePoint 'FL2 e
whitePoint = e -> e -> WhitePoint 'FL2 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37925 e
0.36733
instance Illuminant 'FL3 where
type Temperature 'FL3 = 3450
whitePoint :: WhitePoint 'FL3 e
whitePoint = e -> e -> WhitePoint 'FL3 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.41761 e
0.38324
instance Illuminant 'FL4 where
type Temperature 'FL4 = 2940
whitePoint :: WhitePoint 'FL4 e
whitePoint = e -> e -> WhitePoint 'FL4 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44920 e
0.39074
instance Illuminant 'FL5 where
type Temperature 'FL5 = 6350
whitePoint :: WhitePoint 'FL5 e
whitePoint = e -> e -> WhitePoint 'FL5 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31975 e
0.34246
instance Illuminant 'FL6 where
type Temperature 'FL6 = 4150
whitePoint :: WhitePoint 'FL6 e
whitePoint = e -> e -> WhitePoint 'FL6 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38660 e
0.37847
instance Illuminant 'FL7 where
type Temperature 'FL7 = 6500
whitePoint :: WhitePoint 'FL7 e
whitePoint = e -> e -> WhitePoint 'FL7 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31569 e
0.32960
instance Illuminant 'FL8 where
type Temperature 'FL8 = 5000
whitePoint :: WhitePoint 'FL8 e
whitePoint = e -> e -> WhitePoint 'FL8 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34902 e
0.35939
instance Illuminant 'FL9 where
type Temperature 'FL9 = 4150
whitePoint :: WhitePoint 'FL9 e
whitePoint = e -> e -> WhitePoint 'FL9 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37829 e
0.37045
instance Illuminant 'FL10 where
type Temperature 'FL10 = 5000
whitePoint :: WhitePoint 'FL10 e
whitePoint = e -> e -> WhitePoint 'FL10 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.35090 e
0.35444
instance Illuminant 'FL11 where
type Temperature 'FL11 = 4000
whitePoint :: WhitePoint 'FL11 e
whitePoint = e -> e -> WhitePoint 'FL11 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38541 e
0.37123
instance Illuminant 'FL12 where
type Temperature 'FL12 = 3000
whitePoint :: WhitePoint 'FL12 e
whitePoint = e -> e -> WhitePoint 'FL12 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44256 e
0.39717
data CIE1964
= A
| B
| C
| D50
| D55
| D60
| D65
| D75
| E
| FL1
| FL2
| FL3
| FL4
| FL5
| FL6
| FL7
| FL8
| FL9
| FL10
| FL11
| FL12
deriving (CIE1964 -> CIE1964 -> Bool
(CIE1964 -> CIE1964 -> Bool)
-> (CIE1964 -> CIE1964 -> Bool) -> Eq CIE1964
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CIE1964 -> CIE1964 -> Bool
$c/= :: CIE1964 -> CIE1964 -> Bool
== :: CIE1964 -> CIE1964 -> Bool
$c== :: CIE1964 -> CIE1964 -> Bool
Eq, Int -> CIE1964 -> ShowS
[CIE1964] -> ShowS
CIE1964 -> String
(Int -> CIE1964 -> ShowS)
-> (CIE1964 -> String) -> ([CIE1964] -> ShowS) -> Show CIE1964
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIE1964] -> ShowS
$cshowList :: [CIE1964] -> ShowS
show :: CIE1964 -> String
$cshow :: CIE1964 -> String
showsPrec :: Int -> CIE1964 -> ShowS
$cshowsPrec :: Int -> CIE1964 -> ShowS
Show, ReadPrec [CIE1964]
ReadPrec CIE1964
Int -> ReadS CIE1964
ReadS [CIE1964]
(Int -> ReadS CIE1964)
-> ReadS [CIE1964]
-> ReadPrec CIE1964
-> ReadPrec [CIE1964]
-> Read CIE1964
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CIE1964]
$creadListPrec :: ReadPrec [CIE1964]
readPrec :: ReadPrec CIE1964
$creadPrec :: ReadPrec CIE1964
readList :: ReadS [CIE1964]
$creadList :: ReadS [CIE1964]
readsPrec :: Int -> ReadS CIE1964
$creadsPrec :: Int -> ReadS CIE1964
Read, Int -> CIE1964
CIE1964 -> Int
CIE1964 -> [CIE1964]
CIE1964 -> CIE1964
CIE1964 -> CIE1964 -> [CIE1964]
CIE1964 -> CIE1964 -> CIE1964 -> [CIE1964]
(CIE1964 -> CIE1964)
-> (CIE1964 -> CIE1964)
-> (Int -> CIE1964)
-> (CIE1964 -> Int)
-> (CIE1964 -> [CIE1964])
-> (CIE1964 -> CIE1964 -> [CIE1964])
-> (CIE1964 -> CIE1964 -> [CIE1964])
-> (CIE1964 -> CIE1964 -> CIE1964 -> [CIE1964])
-> Enum CIE1964
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CIE1964 -> CIE1964 -> CIE1964 -> [CIE1964]
$cenumFromThenTo :: CIE1964 -> CIE1964 -> CIE1964 -> [CIE1964]
enumFromTo :: CIE1964 -> CIE1964 -> [CIE1964]
$cenumFromTo :: CIE1964 -> CIE1964 -> [CIE1964]
enumFromThen :: CIE1964 -> CIE1964 -> [CIE1964]
$cenumFromThen :: CIE1964 -> CIE1964 -> [CIE1964]
enumFrom :: CIE1964 -> [CIE1964]
$cenumFrom :: CIE1964 -> [CIE1964]
fromEnum :: CIE1964 -> Int
$cfromEnum :: CIE1964 -> Int
toEnum :: Int -> CIE1964
$ctoEnum :: Int -> CIE1964
pred :: CIE1964 -> CIE1964
$cpred :: CIE1964 -> CIE1964
succ :: CIE1964 -> CIE1964
$csucc :: CIE1964 -> CIE1964
Enum, CIE1964
CIE1964 -> CIE1964 -> Bounded CIE1964
forall a. a -> a -> Bounded a
maxBound :: CIE1964
$cmaxBound :: CIE1964
minBound :: CIE1964
$cminBound :: CIE1964
Bounded)