{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Color.Space.RGB.ITU.Rec601
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Space.RGB.ITU.Rec601
  ( pattern BT601_525
  , BT601_525
  , pattern BT601_625
  , BT601_625
  , D65
  ) where

import Data.Typeable
import Foreign.Storable
import Graphics.Color.Illuminant.ITU.Rec601
import Graphics.Color.Model.Internal
import qualified Graphics.Color.Model.RGB as CM
import Graphics.Color.Space.Internal
import Graphics.Color.Space.RGB.Internal
import Graphics.Color.Space.RGB.ITU.Rec470 (BT470_625)
import Graphics.Color.Space.RGB.Luma



------------------------------------
-- ITU-R BT.601 (525) --------------
------------------------------------

-- | [ITU-R BT.601](https://en.wikipedia.org/wiki/Rec._601) (525) color space
data BT601_525 (l :: Linearity)

newtype instance Color (BT601_525 l) e = BT601_525 (Color CM.RGB e)

-- | ITU-R BT.601 (525) color space
deriving instance Eq e => Eq (Color (BT601_525 l) e)
-- | ITU-R BT.601 (525) color space
deriving instance Ord e => Ord (Color (BT601_525 l) e)
-- | ITU-R BT.601 (525) color space
deriving instance Functor (Color (BT601_525 l))
-- | ITU-R BT.601 (525) color space
deriving instance Applicative (Color (BT601_525 l))
-- | ITU-R BT.601 (525) color space
deriving instance Foldable (Color (BT601_525 l))
-- | ITU-R BT.601 (525) color space
deriving instance Traversable (Color (BT601_525 l))
-- | ITU-R BT.601 (525) color space
deriving instance Storable e => Storable (Color (BT601_525 l) e)

-- | ITU-R BT.601 (525) color space
instance  (Typeable l, Elevator e) => Show (Color (BT601_525 l) e) where
  showsPrec :: Int -> Color (BT601_525 l) e -> ShowS
showsPrec Int
_ = Color (BT601_525 l) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | ITU-R BT.601 (525) color space
instance  (Typeable l, Elevator e) => ColorModel (BT601_525 l) e where
  type Components (BT601_525 l) e = (e, e, e)
  toComponents :: Color (BT601_525 l) e -> Components (BT601_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 (BT601_525 l) e -> Color RGB e)
-> Color (BT601_525 l) e
-> (e, e, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT601_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 (BT601_525 l) e -> Color (BT601_525 l) e
fromComponents = Color RGB e -> Color (BT601_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 (BT601_525 l) e)
-> ((e, e, e) -> Color RGB e) -> (e, e, e) -> Color (BT601_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 #-}

-- | ITU-R BT.601 (525) linear color space
instance Elevator e => ColorSpace (BT601_525 'Linear) D65 e where
  type BaseModel (BT601_525 'Linear) = CM.RGB
  toBaseSpace :: Color (BT601_525 'Linear) e
-> Color (BaseSpace (BT601_525 'Linear)) e
toBaseSpace = Color (BT601_525 'Linear) e
-> Color (BaseSpace (BT601_525 'Linear)) e
forall a. a -> a
id
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (BT601_525 'Linear)) e
-> Color (BT601_525 'Linear) e
fromBaseSpace = Color (BaseSpace (BT601_525 'Linear)) e
-> Color (BT601_525 'Linear) e
forall a. a -> a
id
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (BT601_525 'Linear) e -> Color (Y D65) a
luminance = Color (BT601_525 '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 (BT601_525 'Linear) a -> Color (Y D65) a)
-> (Color (BT601_525 'Linear) e -> Color (BT601_525 'Linear) a)
-> Color (BT601_525 'Linear) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_525 'Linear) e -> Color (BT601_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 (BT601_525 'Linear) e -> Color (XYZ D65) a
toColorXYZ = Color (BT601_525 '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 (BT601_525 'Linear) a -> Color (XYZ D65) a)
-> (Color (BT601_525 'Linear) e -> Color (BT601_525 'Linear) a)
-> Color (BT601_525 'Linear) e
-> Color (XYZ D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_525 'Linear) e -> Color (BT601_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 D65) a -> Color (BT601_525 'Linear) e
fromColorXYZ = (a -> e)
-> Color (BT601_525 'Linear) a -> Color (BT601_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 (BT601_525 'Linear) a -> Color (BT601_525 'Linear) e)
-> (Color (XYZ D65) a -> Color (BT601_525 'Linear) a)
-> Color (XYZ D65) a
-> Color (BT601_525 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ D65) a -> Color (BT601_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 #-}


-- | ITU-R BT.601 (525) linear color space
instance Elevator e => ColorSpace (BT601_525 'NonLinear) D65 e where
  type BaseModel (BT601_525 'NonLinear) = CM.RGB
  toBaseSpace :: Color (BT601_525 'NonLinear) e
-> Color (BaseSpace (BT601_525 'NonLinear)) e
toBaseSpace = Color (BT601_525 'NonLinear) e
-> Color (BaseSpace (BT601_525 'NonLinear)) e
forall a. a -> a
id
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (BT601_525 'NonLinear)) e
-> Color (BT601_525 'NonLinear) e
fromBaseSpace = Color (BaseSpace (BT601_525 'NonLinear)) e
-> Color (BT601_525 'NonLinear) e
forall a. a -> a
id
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (BT601_525 'NonLinear) e -> Color (Y D65) a
luminance = Color (BT601_525 '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 (BT601_525 'NonLinear) a -> Color (Y D65) a)
-> (Color (BT601_525 'NonLinear) e
    -> Color (BT601_525 'NonLinear) a)
-> Color (BT601_525 'NonLinear) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_525 'NonLinear) e -> Color (BT601_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 (BT601_525 'NonLinear) e -> Color (XYZ D65) a
toColorXYZ = Color (BT601_525 '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 (BT601_525 'NonLinear) a -> Color (XYZ D65) a)
-> (Color (BT601_525 'NonLinear) e
    -> Color (BT601_525 'NonLinear) a)
-> Color (BT601_525 'NonLinear) e
-> Color (XYZ D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_525 'NonLinear) e -> Color (BT601_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 D65) a -> Color (BT601_525 'NonLinear) e
fromColorXYZ = (a -> e)
-> Color (BT601_525 'NonLinear) a -> Color (BT601_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 (BT601_525 'NonLinear) a -> Color (BT601_525 'NonLinear) e)
-> (Color (XYZ D65) a -> Color (BT601_525 'NonLinear) a)
-> Color (XYZ D65) a
-> Color (BT601_525 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ D65) a -> Color (BT601_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 #-}

-- | ITU-R BT.601 (525) color space
instance RedGreenBlue BT601_525 D65 where
  gamut :: Gamut BT601_525 D65 e
gamut = Primary D65 e
-> Primary D65 e -> Primary D65 e -> Gamut BT601_525 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.630 e
0.340)
                (e -> e -> Primary D65 e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.310 e
0.595)
                (e -> e -> Primary D65 e
forall k e (i :: k). e -> e -> Primary i e
Primary e
0.155 e
0.070)
  transfer :: e -> e
transfer = e -> e
forall a. (Ord a, Floating a) => a -> a
transferRec601
  {-# INLINE transfer #-}
  itransfer :: e -> e
itransfer = e -> e
forall a. (Ord a, Floating a) => a -> a
itransferRec601
  {-# INLINE itransfer #-}

------------------------------------
-- ITU-R BT.601 (625) --------------
------------------------------------

-- | [ITU-R BT.601](https://en.wikipedia.org/wiki/Rec._601) (625) color space
data BT601_625 (l :: Linearity)

newtype instance Color (BT601_625 l) e = BT601_625 (Color CM.RGB e)

-- | ITU-R BT.601 (625) color space
deriving instance Eq e => Eq (Color (BT601_625 l) e)
-- | ITU-R BT.601 (625) color space
deriving instance Ord e => Ord (Color (BT601_625 l) e)
-- | ITU-R BT.601 (625) color space
deriving instance Functor (Color (BT601_625 l))
-- | ITU-R BT.601 (625) color space
deriving instance Applicative (Color (BT601_625 l))
-- | ITU-R BT.601 (625) color space
deriving instance Foldable (Color (BT601_625 l))
-- | ITU-R BT.601 (625) color space
deriving instance Traversable (Color (BT601_625 l))
-- | ITU-R BT.601 (625) color space
deriving instance Storable e => Storable (Color (BT601_625 l) e)

-- | ITU-R BT.601 (625) color space
instance (Typeable l, Elevator e) => Show (Color (BT601_625 l) e) where
  showsPrec :: Int -> Color (BT601_625 l) e -> ShowS
showsPrec Int
_ = Color (BT601_625 l) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | ITU-R BT.601 (625) color space
instance (Typeable l, Elevator e) => ColorModel (BT601_625 l) e where
  type Components (BT601_625 l) e = (e, e, e)
  toComponents :: Color (BT601_625 l) e -> Components (BT601_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 (BT601_625 l) e -> Color RGB e)
-> Color (BT601_625 l) e
-> (e, e, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT601_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 (BT601_625 l) e -> Color (BT601_625 l) e
fromComponents = Color RGB e -> Color (BT601_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 (BT601_625 l) e)
-> ((e, e, e) -> Color RGB e) -> (e, e, e) -> Color (BT601_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 #-}

-- | ITU-R BT.601 (625) linear color space
instance Elevator e => ColorSpace (BT601_625 'Linear) D65 e where
  type BaseModel (BT601_625 'Linear) = CM.RGB
  toBaseSpace :: Color (BT601_625 'Linear) e
-> Color (BaseSpace (BT601_625 'Linear)) e
toBaseSpace = Color (BT601_625 'Linear) e
-> Color (BaseSpace (BT601_625 'Linear)) e
forall a. a -> a
id
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (BT601_625 'Linear)) e
-> Color (BT601_625 'Linear) e
fromBaseSpace = Color (BaseSpace (BT601_625 'Linear)) e
-> Color (BT601_625 'Linear) e
forall a. a -> a
id
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (BT601_625 'Linear) e -> Color (Y D65) a
luminance = Color (BT601_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 (BT601_625 'Linear) a -> Color (Y D65) a)
-> (Color (BT601_625 'Linear) e -> Color (BT601_625 'Linear) a)
-> Color (BT601_625 'Linear) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_625 'Linear) e -> Color (BT601_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 (BT601_625 'Linear) e -> Color (XYZ D65) a
toColorXYZ = Color (BT601_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 (BT601_625 'Linear) a -> Color (XYZ D65) a)
-> (Color (BT601_625 'Linear) e -> Color (BT601_625 'Linear) a)
-> Color (BT601_625 'Linear) e
-> Color (XYZ D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_625 'Linear) e -> Color (BT601_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 (BT601_625 'Linear) e
fromColorXYZ = (a -> e)
-> Color (BT601_625 'Linear) a -> Color (BT601_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 (BT601_625 'Linear) a -> Color (BT601_625 'Linear) e)
-> (Color (XYZ D65) a -> Color (BT601_625 'Linear) a)
-> Color (XYZ D65) a
-> Color (BT601_625 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ D65) a -> Color (BT601_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 #-}

-- | ITU-R BT.601 (625) color space
instance Elevator e => ColorSpace (BT601_625 'NonLinear) D65 e where
  type BaseModel (BT601_625 'NonLinear) = CM.RGB
  toBaseSpace :: Color (BT601_625 'NonLinear) e
-> Color (BaseSpace (BT601_625 'NonLinear)) e
toBaseSpace = Color (BT601_625 'NonLinear) e
-> Color (BaseSpace (BT601_625 'NonLinear)) e
forall a. a -> a
id
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (BT601_625 'NonLinear)) e
-> Color (BT601_625 'NonLinear) e
fromBaseSpace = Color (BaseSpace (BT601_625 'NonLinear)) e
-> Color (BT601_625 'NonLinear) e
forall a. a -> a
id
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (BT601_625 'NonLinear) e -> Color (Y D65) a
luminance = Color (BT601_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 (BT601_625 'NonLinear) a -> Color (Y D65) a)
-> (Color (BT601_625 'NonLinear) e
    -> Color (BT601_625 'NonLinear) a)
-> Color (BT601_625 'NonLinear) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_625 'NonLinear) e -> Color (BT601_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 (BT601_625 'NonLinear) e -> Color (XYZ D65) a
toColorXYZ = Color (BT601_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 (BT601_625 'NonLinear) a -> Color (XYZ D65) a)
-> (Color (BT601_625 'NonLinear) e
    -> Color (BT601_625 'NonLinear) a)
-> Color (BT601_625 'NonLinear) e
-> Color (XYZ D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> a)
-> Color (BT601_625 'NonLinear) e -> Color (BT601_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 (BT601_625 'NonLinear) e
fromColorXYZ = (a -> e)
-> Color (BT601_625 'NonLinear) a -> Color (BT601_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 (BT601_625 'NonLinear) a -> Color (BT601_625 'NonLinear) e)
-> (Color (XYZ D65) a -> Color (BT601_625 'NonLinear) a)
-> Color (XYZ D65) a
-> Color (BT601_625 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ D65) a -> Color (BT601_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 #-}

-- | ITU-R BT.601 (625) color space
instance RedGreenBlue BT601_625 D65 where
  gamut :: Gamut BT601_625 D65 e
gamut = Gamut BT470_625 D65 e -> Gamut BT601_625 D65 e
forall k1 k2 (cs' :: Linearity -> *) (i' :: k1) e
       (cs :: Linearity -> *) (i :: k2).
Gamut cs' i' e -> Gamut cs i e
coerceGamut (forall i e.
(RedGreenBlue BT470_625 i, RealFloat e) =>
Gamut BT470_625 i e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Gamut cs i e
gamut @_ @BT470_625)
  transfer :: e -> e
transfer = e -> e
forall a. (Ord a, Floating a) => a -> a
transferRec601
  {-# INLINE transfer #-}
  itransfer :: e -> e
itransfer = e -> e
forall a. (Ord a, Floating a) => a -> a
itransferRec601
  {-# INLINE itransfer #-}

instance Luma BT601_525 where
  rWeight :: Weight BT601_525 e
rWeight = Weight BT601_525 e
0.299
  gWeight :: Weight BT601_525 e
gWeight = Weight BT601_525 e
0.587
  bWeight :: Weight BT601_525 e
bWeight = Weight BT601_525 e
0.114

instance Luma BT601_625 where
  rWeight :: Weight BT601_625 e
rWeight = Weight BT601_625 e
0.299
  gWeight :: Weight BT601_625 e
gWeight = Weight BT601_625 e
0.587
  bWeight :: Weight BT601_625 e
bWeight = Weight BT601_625 e
0.114


-- | Rec.601 transfer function "gamma". This is a helper function, therefore `ecctf` should be used
-- instead.
--
-- \[
-- \gamma(L) = \begin{cases}
--     4.500 L & L \le 0.018 \\
--     1.099 L^{0.45} - 0.099 & \text{otherwise}
--   \end{cases}
-- \]
--
-- @since 0.1.0
transferRec601 :: (Ord a, Floating a) => a -> a
transferRec601 :: a -> a
transferRec601 a
l
  | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.018 = a
4.5 a -> a -> a
forall a. Num a => a -> a -> a
* a
l
  | Bool
otherwise = a
1.099 a -> a -> a
forall a. Num a => a -> a -> a
* (a
l a -> a -> a
forall a. Floating a => a -> a -> a
** a
0.45 {- ~ 1 / 2.2 -}) a -> a -> a
forall a. Num a => a -> a -> a
- a
0.099
{-# INLINE transferRec601 #-}

-- | Rec.601 inverse transfer function "gamma". This is a helper function, therefore `dcctf` should
-- be used instead.
--
-- \[
-- \gamma^{-1}(E) = \begin{cases}
--     E / 4.5 & E \leq gamma(0.018) \\
--     \left(\tfrac{E + 0.099}{1.099}\right)^{\frac{1}{0.45}} & \text{otherwise}
--   \end{cases}
-- \]
--
itransferRec601 :: (Ord a, Floating a) => a -> a
itransferRec601 :: a -> a
itransferRec601 a
e
  | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
forall a. (Ord a, Floating a) => a
inv0018 = a
e a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
4.5
  | Bool
otherwise = ((a
e a -> a -> a
forall a. Num a => a -> a -> a
+ a
0.099) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1.099) a -> a -> a
forall a. Floating a => a -> a -> a
** (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0.45)
{-# INLINE itransferRec601 #-}

inv0018 :: (Ord a, Floating a) => a
inv0018 :: a
inv0018 = a -> a
forall a. (Ord a, Floating a) => a -> a
transferRec601 a
0.018 -- ~ 0.081