{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Space.RGB.ITU.Rec470
( pattern BT470_525
, BT470_525
, C
, pattern BT470_625
, BT470_625
, D65
) where
import Data.Typeable
import Foreign.Storable
import Graphics.Color.Illuminant.ITU.Rec470
import qualified Graphics.Color.Model.RGB as CM
import Graphics.Color.Space.Internal
import Graphics.Color.Space.RGB.Internal
data BT470_525 (l :: Linearity)
newtype instance Color (BT470_525 l) e = BT470_525 (Color CM.RGB e)
deriving instance Eq e => Eq (Color (BT470_525 l) e)
deriving instance Ord e => Ord (Color (BT470_525 l) e)
deriving instance Functor (Color (BT470_525 l))
deriving instance Applicative (Color (BT470_525 l))
deriving instance Foldable (Color (BT470_525 l))
deriving instance Traversable (Color (BT470_525 l))
deriving instance Storable e => Storable (Color (BT470_525 l) e)
instance (Typeable l, Elevator e) => Show (Color (BT470_525 l) e) where
showsPrec :: Int -> Color (BT470_525 l) e -> ShowS
showsPrec Int
_ = Color (BT470_525 l) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel
instance (Typeable l, Elevator e) => ColorModel (BT470_525 l) e where
type Components (BT470_525 l) e = (e, e, e)
toComponents :: Color (BT470_525 l) e -> Components (BT470_525 l) e
toComponents = Color RGB e -> (e, e, e)
forall cs e. ColorModel cs e => Color cs e -> Components cs e
toComponents (Color RGB e -> (e, e, e))
-> (Color (BT470_525 l) e -> Color RGB e)
-> Color (BT470_525 l) e
-> (e, e, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT470_525 l) e -> Color RGB e
forall k (cs :: Linearity -> *) (i :: k) (l :: Linearity) e.
RedGreenBlue cs i =>
Color (cs l) e -> Color RGB e
unColorRGB
{-# INLINE toComponents #-}
fromComponents :: Components (BT470_525 l) e -> Color (BT470_525 l) e
fromComponents = Color RGB e -> Color (BT470_525 l) e
forall k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
Color RGB e -> Color (cs l) e
mkColorRGB (Color RGB e -> Color (BT470_525 l) e)
-> ((e, e, e) -> Color RGB e) -> (e, e, e) -> Color (BT470_525 l) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, e, e) -> Color RGB e
forall cs e. ColorModel cs e => Components cs e -> Color cs e
fromComponents
{-# INLINE fromComponents #-}
instance Elevator e => ColorSpace (BT470_525 'Linear) C e where
type BaseModel (BT470_525 'Linear) = CM.RGB
toBaseSpace :: Color (BT470_525 'Linear) e
-> Color (BaseSpace (BT470_525 'Linear)) e
toBaseSpace = Color (BT470_525 'Linear) e
-> Color (BaseSpace (BT470_525 'Linear)) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: Color (BaseSpace (BT470_525 'Linear)) e
-> Color (BT470_525 'Linear) e
fromBaseSpace = Color (BaseSpace (BT470_525 'Linear)) e
-> Color (BT470_525 'Linear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: Color (BT470_525 'Linear) e -> Color (Y C) a
luminance = Color (BT470_525 'Linear) a -> Color (Y C) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'Linear) e -> Color (Y i) e
rgbLinearLuminance (Color (BT470_525 'Linear) a -> Color (Y C) a)
-> (Color (BT470_525 'Linear) e -> Color (BT470_525 'Linear) a)
-> Color (BT470_525 'Linear) e
-> Color (Y C) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_525 'Linear) e -> Color (BT470_525 'Linear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
toColorXYZ :: Color (BT470_525 'Linear) e -> Color (XYZ C) a
toColorXYZ = Color (BT470_525 'Linear) a -> Color (XYZ C) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'Linear) e -> Color (XYZ i) e
rgbLinear2xyz (Color (BT470_525 'Linear) a -> Color (XYZ C) a)
-> (Color (BT470_525 'Linear) e -> Color (BT470_525 'Linear) a)
-> Color (BT470_525 'Linear) e
-> Color (XYZ C) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_525 'Linear) e -> Color (BT470_525 'Linear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: Color (XYZ C) a -> Color (BT470_525 'Linear) e
fromColorXYZ = (a -> e)
-> Color (BT470_525 'Linear) a -> Color (BT470_525 'Linear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => a -> e
fromRealFloat (Color (BT470_525 'Linear) a -> Color (BT470_525 'Linear) e)
-> (Color (XYZ C) a -> Color (BT470_525 'Linear) a)
-> Color (XYZ C) a
-> Color (BT470_525 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ C) a -> Color (BT470_525 'Linear) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (XYZ i) e -> Color (cs 'Linear) e
xyz2rgbLinear
{-# INLINE fromColorXYZ #-}
instance Elevator e => ColorSpace (BT470_525 'NonLinear) C e where
type BaseModel (BT470_525 'NonLinear) = CM.RGB
toBaseSpace :: Color (BT470_525 'NonLinear) e
-> Color (BaseSpace (BT470_525 'NonLinear)) e
toBaseSpace = Color (BT470_525 'NonLinear) e
-> Color (BaseSpace (BT470_525 'NonLinear)) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: Color (BaseSpace (BT470_525 'NonLinear)) e
-> Color (BT470_525 'NonLinear) e
fromBaseSpace = Color (BaseSpace (BT470_525 'NonLinear)) e
-> Color (BT470_525 'NonLinear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: Color (BT470_525 'NonLinear) e -> Color (Y C) a
luminance = Color (BT470_525 'NonLinear) a -> Color (Y C) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (Y i) e
rgbLuminance (Color (BT470_525 'NonLinear) a -> Color (Y C) a)
-> (Color (BT470_525 'NonLinear) e
-> Color (BT470_525 'NonLinear) a)
-> Color (BT470_525 'NonLinear) e
-> Color (Y C) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_525 'NonLinear) e -> Color (BT470_525 'NonLinear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
toColorXYZ :: Color (BT470_525 'NonLinear) e -> Color (XYZ C) a
toColorXYZ = Color (BT470_525 'NonLinear) a -> Color (XYZ C) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (XYZ i) e
rgb2xyz (Color (BT470_525 'NonLinear) a -> Color (XYZ C) a)
-> (Color (BT470_525 'NonLinear) e
-> Color (BT470_525 'NonLinear) a)
-> Color (BT470_525 'NonLinear) e
-> Color (XYZ C) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_525 'NonLinear) e -> Color (BT470_525 'NonLinear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: Color (XYZ C) a -> Color (BT470_525 'NonLinear) e
fromColorXYZ = (a -> e)
-> Color (BT470_525 'NonLinear) a -> Color (BT470_525 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => a -> e
fromRealFloat (Color (BT470_525 'NonLinear) a -> Color (BT470_525 'NonLinear) e)
-> (Color (XYZ C) a -> Color (BT470_525 'NonLinear) a)
-> Color (XYZ C) a
-> Color (BT470_525 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ C) a -> Color (BT470_525 'NonLinear) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (XYZ i) e -> Color (cs 'NonLinear) e
xyz2rgb
{-# INLINE fromColorXYZ #-}
instance RedGreenBlue BT470_525 C where
gamut :: Gamut BT470_525 C e
gamut = Primary C e -> Primary C e -> Primary C e -> Gamut BT470_525 C e
forall k (cs :: Linearity -> *) (i :: k) e.
Primary i e -> Primary i e -> Primary i e -> Gamut cs i e
Gamut (e -> e -> Primary C e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.67 e
0.33)
(e -> e -> Primary C e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.21 e
0.71)
(e -> e -> Primary C e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.14 e
0.08)
transfer :: e -> e
transfer = e -> e -> e
forall a. Floating a => a -> a -> a
gamma (e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
2.2)
{-# INLINE transfer #-}
itransfer :: e -> e
itransfer = e -> e -> e
forall a. Floating a => a -> a -> a
gamma e
2.2
{-# INLINE itransfer #-}
data BT470_625 (l :: Linearity)
newtype instance Color (BT470_625 l) e = BT470_625 (Color CM.RGB e)
deriving instance Eq e => Eq (Color (BT470_625 l) e)
deriving instance Ord e => Ord (Color (BT470_625 l) e)
deriving instance Functor (Color (BT470_625 l))
deriving instance Applicative (Color (BT470_625 l))
deriving instance Foldable (Color (BT470_625 l))
deriving instance Traversable (Color (BT470_625 l))
deriving instance Storable e => Storable (Color (BT470_625 l) e)
instance (Typeable l, Elevator e) => Show (Color (BT470_625 l) e) where
showsPrec :: Int -> Color (BT470_625 l) e -> ShowS
showsPrec Int
_ = Color (BT470_625 l) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel
instance (Typeable l, Elevator e) => ColorModel (BT470_625 l) e where
type Components (BT470_625 l) e = (e, e, e)
toComponents :: Color (BT470_625 l) e -> Components (BT470_625 l) e
toComponents = Color RGB e -> (e, e, e)
forall cs e. ColorModel cs e => Color cs e -> Components cs e
toComponents (Color RGB e -> (e, e, e))
-> (Color (BT470_625 l) e -> Color RGB e)
-> Color (BT470_625 l) e
-> (e, e, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT470_625 l) e -> Color RGB e
forall k (cs :: Linearity -> *) (i :: k) (l :: Linearity) e.
RedGreenBlue cs i =>
Color (cs l) e -> Color RGB e
unColorRGB
{-# INLINE toComponents #-}
fromComponents :: Components (BT470_625 l) e -> Color (BT470_625 l) e
fromComponents = Color RGB e -> Color (BT470_625 l) e
forall k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
Color RGB e -> Color (cs l) e
mkColorRGB (Color RGB e -> Color (BT470_625 l) e)
-> ((e, e, e) -> Color RGB e) -> (e, e, e) -> Color (BT470_625 l) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, e, e) -> Color RGB e
forall cs e. ColorModel cs e => Components cs e -> Color cs e
fromComponents
{-# INLINE fromComponents #-}
instance Elevator e => ColorSpace (BT470_625 'Linear) D65 e where
type BaseModel (BT470_625 'Linear) = CM.RGB
toBaseSpace :: Color (BT470_625 'Linear) e
-> Color (BaseSpace (BT470_625 'Linear)) e
toBaseSpace = Color (BT470_625 'Linear) e
-> Color (BaseSpace (BT470_625 'Linear)) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: Color (BaseSpace (BT470_625 'Linear)) e
-> Color (BT470_625 'Linear) e
fromBaseSpace = Color (BaseSpace (BT470_625 'Linear)) e
-> Color (BT470_625 'Linear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: Color (BT470_625 'Linear) e -> Color (Y D65) a
luminance = Color (BT470_625 'Linear) a -> Color (Y D65) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'Linear) e -> Color (Y i) e
rgbLinearLuminance (Color (BT470_625 'Linear) a -> Color (Y D65) a)
-> (Color (BT470_625 'Linear) e -> Color (BT470_625 'Linear) a)
-> Color (BT470_625 'Linear) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_625 'Linear) e -> Color (BT470_625 'Linear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
toColorXYZ :: Color (BT470_625 'Linear) e -> Color (XYZ D65) a
toColorXYZ = Color (BT470_625 'Linear) a -> Color (XYZ D65) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'Linear) e -> Color (XYZ i) e
rgbLinear2xyz (Color (BT470_625 'Linear) a -> Color (XYZ D65) a)
-> (Color (BT470_625 'Linear) e -> Color (BT470_625 'Linear) a)
-> Color (BT470_625 'Linear) e
-> Color (XYZ D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_625 'Linear) e -> Color (BT470_625 'Linear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: Color (XYZ D65) a -> Color (BT470_625 'Linear) e
fromColorXYZ = (a -> e)
-> Color (BT470_625 'Linear) a -> Color (BT470_625 'Linear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => a -> e
fromRealFloat (Color (BT470_625 'Linear) a -> Color (BT470_625 'Linear) e)
-> (Color (XYZ D65) a -> Color (BT470_625 'Linear) a)
-> Color (XYZ D65) a
-> Color (BT470_625 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ D65) a -> Color (BT470_625 'Linear) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (XYZ i) e -> Color (cs 'Linear) e
xyz2rgbLinear
{-# INLINE fromColorXYZ #-}
instance Elevator e => ColorSpace (BT470_625 'NonLinear) D65 e where
type BaseModel (BT470_625 'NonLinear) = CM.RGB
toBaseSpace :: Color (BT470_625 'NonLinear) e
-> Color (BaseSpace (BT470_625 'NonLinear)) e
toBaseSpace = Color (BT470_625 'NonLinear) e
-> Color (BaseSpace (BT470_625 'NonLinear)) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: Color (BaseSpace (BT470_625 'NonLinear)) e
-> Color (BT470_625 'NonLinear) e
fromBaseSpace = Color (BaseSpace (BT470_625 'NonLinear)) e
-> Color (BT470_625 'NonLinear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: Color (BT470_625 'NonLinear) e -> Color (Y D65) a
luminance = Color (BT470_625 'NonLinear) a -> Color (Y D65) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (Y i) e
rgbLuminance (Color (BT470_625 'NonLinear) a -> Color (Y D65) a)
-> (Color (BT470_625 'NonLinear) e
-> Color (BT470_625 'NonLinear) a)
-> Color (BT470_625 'NonLinear) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_625 'NonLinear) e -> Color (BT470_625 'NonLinear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
toColorXYZ :: Color (BT470_625 'NonLinear) e -> Color (XYZ D65) a
toColorXYZ = Color (BT470_625 'NonLinear) a -> Color (XYZ D65) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (XYZ i) e
rgb2xyz (Color (BT470_625 'NonLinear) a -> Color (XYZ D65) a)
-> (Color (BT470_625 'NonLinear) e
-> Color (BT470_625 'NonLinear) a)
-> Color (BT470_625 'NonLinear) e
-> Color (XYZ D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT470_625 'NonLinear) e -> Color (BT470_625 'NonLinear) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: Color (XYZ D65) a -> Color (BT470_625 'NonLinear) e
fromColorXYZ = (a -> e)
-> Color (BT470_625 'NonLinear) a -> Color (BT470_625 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => a -> e
fromRealFloat (Color (BT470_625 'NonLinear) a -> Color (BT470_625 'NonLinear) e)
-> (Color (XYZ D65) a -> Color (BT470_625 'NonLinear) a)
-> Color (XYZ D65) a
-> Color (BT470_625 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ D65) a -> Color (BT470_625 'NonLinear) a
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e,
ColorSpace (cs 'Linear) i e, RealFloat e) =>
Color (XYZ i) e -> Color (cs 'NonLinear) e
xyz2rgb
{-# INLINE fromColorXYZ #-}
instance RedGreenBlue BT470_625 D65 where
gamut :: Gamut BT470_625 D65 e
gamut = Primary D65 e
-> Primary D65 e -> Primary D65 e -> Gamut BT470_625 D65 e
forall k (cs :: Linearity -> *) (i :: k) e.
Primary i e -> Primary i e -> Primary i e -> Gamut cs i e
Gamut (e -> e -> Primary D65 e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.64 e
0.33)
(e -> e -> Primary D65 e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.29 e
0.60)
(e -> e -> Primary D65 e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.15 e
0.06)
transfer :: e -> e
transfer = e -> e -> e
forall a. Floating a => a -> a -> a
gamma (e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
2.8)
{-# INLINE transfer #-}
itransfer :: e -> e
itransfer = e -> e -> e
forall a. Floating a => a -> a -> a
gamma e
2.8
{-# INLINE itransfer #-}
gamma :: Floating a => a -> a -> a
gamma :: a -> a -> a
gamma a
p a
v = a
v a -> a -> a
forall a. Floating a => a -> a -> a
** a
p
{-# INLINE gamma #-}