{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Color.Illuminant.CIE1964
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Illuminant.CIE1964
  ( CIE1964(..)
  ) where

import Graphics.Color.Space.Internal (Illuminant(..), WhitePoint(..))
import qualified Graphics.Color.Illuminant.CIE1931 as I2


-- | @[x=0.45117, y=0.40594]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.34980, y=0.35270]@ - CIE 1964 10° Observer -
-- /https://www.colour-science.org/
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

-- | @[x=0.31039, y=0.31905]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.34773, y=0.35952]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.33412, y=0.34877]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.32299, y=0.33928]@ - CIE 1964 10° Observer -
-- /https://www.colour-science.org (rounded to 5 decimal points)/
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

-- | @[x=0.31381, y=0.33098]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.29968, y=0.31740]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=1\/3, y=1\/3]@ - CIE 1964 10° Observer -
-- /https://www.colour-science.org/
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)

-- | @[x=0.31811, y=0.33559]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.37925, y=0.36733]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.41761, y=0.38324]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.44920, y=0.39074]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.31975, y=0.34246]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.38660, y=0.37847]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.31569, y=0.32960]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.34902, y=0.35939]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.37829, y=0.37045]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.35090, y=0.35444]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.38541, y=0.37123]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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

-- | @[x=0.44256, y=0.39717]@ - CIE 1964 10° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
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


-- | CIE 1964 10° observer illuminants
--
-- References:
--
-- * [CIE15: Technical Report: Colorimetry, 3rd edition](https://web.archive.org/web/20190510201823/https://www.cdvplus.cz/file/3-publikace-cie15-2004/)

data CIE1964
  = A
  -- ^ Incandescent / Tungsten
  | B
  -- ^ Direct sunlight at noon (obsolete)
  | C
  -- ^ Average / North sky Daylight (obsolete)
  | D50
  -- ^  Horizon Light.
  | D55
  -- ^ Mid-morning / Mid-afternoon Daylight
  | D60
  | D65
  -- ^ Noon Daylight
  | D75
  -- ^ Overcast dayligh / North sky Daylight
  | E
  -- ^ Equal energy
  | FL1
  -- ^ Daylight Fluorescent
  | FL2
  -- ^ The fluorescent illuminant in most common use, represents cool white fluorescent
  -- (4100° Kelvin, CRI 60). Non-standard names include F, F02, Fcw, CWF, CWF2.
  --
  -- /Note/ - Takes precedence over other F illuminants
  | FL3
  -- ^ White Fluorescent
  | FL4
  -- ^ Warm White Fluorescent
  | FL5
  -- ^ Daylight Fluorescent
  | FL6
  -- ^ Lite White Fluorescent
  | FL7
  -- ^ Represents a broadband fluorescent lamp, which approximates CIE illuminant `D65`
  -- (6500° Kelvin, CRI 90).
  --
  -- /Note/ - Takes precedence over other F illuminants
  | FL8
  -- ^ `D50` simulator, Sylvania F40 Design 50 (F40DSGN50)
  | FL9
  -- ^ Cool White Deluxe Fluorescent
  | FL10
  -- ^ Philips TL85, Ultralume 50
  | FL11
  -- ^ Philips TL84, SP41, Ultralume 40
  --
  -- Represents a narrow tri-band fluorescent of 4000° Kelvin color temperature, CRI 83.
  --
  -- /Note/ - Takes precedence over other F illuminants
  | FL12
  -- ^ Philips TL83, Ultralume 30
  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)