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

import Graphics.Color.Space.Internal

-- | @[x=0.44757, y=0.40745]@ - 2° Observer - Wikipedia
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.44757 e
0.40745

-- | @[x=0.34842, y=0.35161]@ - 2° Observer - Wikipedia
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.34842 e
0.35161

-- | @[x=0.31006, y=0.31616]@ - 2° Observer - Wikipedia
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.31006 e
0.31616

-- | @[x=0.34567, y=0.35850]@ - 2° Observer - Wikipedia
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.34567 e
0.35850

-- | @[x=0.33242, y=0.34743]@ - 2° Observer - Wikipedia
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.33242 e
0.34743

-- | @[x=0.31271, y=0.32901]@ - 2° Observer - Wikipedia
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.31271 e
0.32902

-- | @[x=0.29902, y=0.31485]@ - 2° Observer - Wikipedia
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.29902 e
0.31485

-- | @[x=1\/3, y=1\/3]@ - 2° Observer - Wikipedia
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.31310, y=0.33727]@ - 2° Observer - Wikipedia
instance Illuminant 'F1  where
  type Temperature 'F1 = 6430
  whitePoint :: WhitePoint 'F1 e
whitePoint = e -> e -> WhitePoint 'F1 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31310 e
0.33727

-- | @[x=0.37208, y=0.375129@ - 2° Observer - Wikipedia
instance Illuminant 'F2  where
  type Temperature 'F2 = 4230
  whitePoint :: WhitePoint 'F2 e
whitePoint = e -> e -> WhitePoint 'F2 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37208 e
0.37529

-- | @[x=0.40910, y=0.39430]@ - 2° Observer - Wikipedia
instance Illuminant 'F3  where
  type Temperature 'F3 = 3450
  whitePoint :: WhitePoint 'F3 e
whitePoint = e -> e -> WhitePoint 'F3 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.40910 e
0.39430

-- | @[x=0.44018, y=0.40329]@ - 2° Observer - Wikipedia
instance Illuminant 'F4  where
  type Temperature 'F4 = 2940
  whitePoint :: WhitePoint 'F4 e
whitePoint = e -> e -> WhitePoint 'F4 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44018 e
0.40329

-- | @[x=0.31379, y=0.34531]@ - 2° Observer - Wikipedia
instance Illuminant 'F5  where
  type Temperature 'F5 = 6350
  whitePoint :: WhitePoint 'F5 e
whitePoint = e -> e -> WhitePoint 'F5 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31379 e
0.34531

-- | @[x=0.37790, y=0.38835]@ - 2° Observer - Wikipedia
instance Illuminant 'F6  where
  type Temperature 'F6 = 4150
  whitePoint :: WhitePoint 'F6 e
whitePoint = e -> e -> WhitePoint 'F6 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37790 e
0.38835

-- | @[x=0.31292, y=0.32933]@ - 2° Observer - Wikipedia
instance Illuminant 'F7  where
  type Temperature 'F7 = 6500
  whitePoint :: WhitePoint 'F7 e
whitePoint = e -> e -> WhitePoint 'F7 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31292 e
0.32933

-- | @[x=0.34588, y=0.35875]@ - 2° Observer - Wikipedia
instance Illuminant 'F8  where
  type Temperature 'F8 = 5000
  whitePoint :: WhitePoint 'F8 e
whitePoint = e -> e -> WhitePoint 'F8 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34588 e
0.35875

-- | @[x=0.37417, y=0.37281]@ - 2° Observer - Wikipedia
instance Illuminant 'F9  where
  type Temperature 'F9 = 4150
  whitePoint :: WhitePoint 'F9 e
whitePoint = e -> e -> WhitePoint 'F9 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37417 e
0.37281

-- | @[x=0.34609, y=0.35986]@ - 2° Observer - Wikipedia
instance Illuminant 'F10 where
  type Temperature 'F10 = 5000
  whitePoint :: WhitePoint 'F10 e
whitePoint = e -> e -> WhitePoint 'F10 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34609 e
0.35986

-- | @[x=0.38052, y=0.37713]@ - 2° Observer - Wikipedia
instance Illuminant 'F11 where
  type Temperature 'F11 = 4000
  whitePoint :: WhitePoint 'F11 e
whitePoint = e -> e -> WhitePoint 'F11 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38052 e
0.37713

-- | @[x=0.43695, y=0.40441]@ - 2° Observer - Wikipedia
instance Illuminant 'F12 where
  type Temperature 'F12 = 3000
  whitePoint :: WhitePoint 'F12 e
whitePoint = e -> e -> WhitePoint 'F12 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.43695 e
0.40441


-- | 2° observer [Standard
-- Illuminants](https://en.wikipedia.org/wiki/Standard_illuminant#White_point) listed on
-- Wikipedia. Despite the fact that they have slightly different chromaticity coordinates
-- than the actual CIE1931 standard papers, these are very commmonly used values. For
-- better interoperability it is better to use the actual
-- `Graphics.Color.Illuminant.CIE1931.CIE1931` illuminants.
--
-- @since 0.1.1
data Degree2
  = A
  -- ^ Incandescent / Tungsten
  | B
  -- ^ Direct sunlight at noon (obsolete)
  | C
  -- ^ Average / North sky Daylight (obsolete)
  | D50
  -- ^  Horizon Light.
  | D55
  -- ^ Mid-morning / Mid-afternoon Daylight
  | D65
  -- ^ Noon Daylight
  | D75
  -- ^ Overcast dayligh / North sky Daylight
  | E
  -- ^ Equal energy
  | F1
  -- ^ Daylight Fluorescent
  | F2
  -- ^ 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
  | F3
  -- ^ White Fluorescent
  | F4
  -- ^ Warm White Fluorescent
  | F5
  -- ^ Daylight Fluorescent
  | F6
  -- ^ Lite White Fluorescent
  | F7
  -- ^ Represents a broadband fluorescent lamp, which approximates CIE illuminant `D65`
  -- (6500° Kelvin, CRI 90).
  --
  -- /Note/ - Takes precedence over other F illuminants
  | F8
  -- ^ `D50` simulator, Sylvania F40 Design 50 (F40DSGN50)
  | F9
  -- ^ Cool White Deluxe Fluorescent
  | F10
  -- ^ Philips TL85, Ultralume 50
  | F11
  -- ^ 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
  | F12
  -- ^ Philips TL83, Ultralume 30
  deriving (Degree2 -> Degree2 -> Bool
(Degree2 -> Degree2 -> Bool)
-> (Degree2 -> Degree2 -> Bool) -> Eq Degree2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Degree2 -> Degree2 -> Bool
$c/= :: Degree2 -> Degree2 -> Bool
== :: Degree2 -> Degree2 -> Bool
$c== :: Degree2 -> Degree2 -> Bool
Eq, Int -> Degree2 -> ShowS
[Degree2] -> ShowS
Degree2 -> String
(Int -> Degree2 -> ShowS)
-> (Degree2 -> String) -> ([Degree2] -> ShowS) -> Show Degree2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Degree2] -> ShowS
$cshowList :: [Degree2] -> ShowS
show :: Degree2 -> String
$cshow :: Degree2 -> String
showsPrec :: Int -> Degree2 -> ShowS
$cshowsPrec :: Int -> Degree2 -> ShowS
Show, ReadPrec [Degree2]
ReadPrec Degree2
Int -> ReadS Degree2
ReadS [Degree2]
(Int -> ReadS Degree2)
-> ReadS [Degree2]
-> ReadPrec Degree2
-> ReadPrec [Degree2]
-> Read Degree2
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Degree2]
$creadListPrec :: ReadPrec [Degree2]
readPrec :: ReadPrec Degree2
$creadPrec :: ReadPrec Degree2
readList :: ReadS [Degree2]
$creadList :: ReadS [Degree2]
readsPrec :: Int -> ReadS Degree2
$creadsPrec :: Int -> ReadS Degree2
Read, Int -> Degree2
Degree2 -> Int
Degree2 -> [Degree2]
Degree2 -> Degree2
Degree2 -> Degree2 -> [Degree2]
Degree2 -> Degree2 -> Degree2 -> [Degree2]
(Degree2 -> Degree2)
-> (Degree2 -> Degree2)
-> (Int -> Degree2)
-> (Degree2 -> Int)
-> (Degree2 -> [Degree2])
-> (Degree2 -> Degree2 -> [Degree2])
-> (Degree2 -> Degree2 -> [Degree2])
-> (Degree2 -> Degree2 -> Degree2 -> [Degree2])
-> Enum Degree2
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 :: Degree2 -> Degree2 -> Degree2 -> [Degree2]
$cenumFromThenTo :: Degree2 -> Degree2 -> Degree2 -> [Degree2]
enumFromTo :: Degree2 -> Degree2 -> [Degree2]
$cenumFromTo :: Degree2 -> Degree2 -> [Degree2]
enumFromThen :: Degree2 -> Degree2 -> [Degree2]
$cenumFromThen :: Degree2 -> Degree2 -> [Degree2]
enumFrom :: Degree2 -> [Degree2]
$cenumFrom :: Degree2 -> [Degree2]
fromEnum :: Degree2 -> Int
$cfromEnum :: Degree2 -> Int
toEnum :: Int -> Degree2
$ctoEnum :: Int -> Degree2
pred :: Degree2 -> Degree2
$cpred :: Degree2 -> Degree2
succ :: Degree2 -> Degree2
$csucc :: Degree2 -> Degree2
Enum, Degree2
Degree2 -> Degree2 -> Bounded Degree2
forall a. a -> a -> Bounded a
maxBound :: Degree2
$cmaxBound :: Degree2
minBound :: Degree2
$cminBound :: Degree2
Bounded)