{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module      : Graphics.Color.Space.RGB.Alternative.YCbCr
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Space.RGB.Alternative.YCbCr
  ( pattern ColorY'CbCr
  , pattern ColorY'CbCrA
  , Y'CbCr
  , Color(Y'CbCr)
  , ycbcr2srgb
  , srgb2ycbcr
  , toColorY'CbCr
  , fromColorY'CbCr
  , module Graphics.Color.Space.RGB.Luma
  ) where

import Data.Coerce
import Data.Kind
import Data.Proxy
import Data.Typeable
import Foreign.Storable
import Graphics.Color.Model.Internal
import qualified Graphics.Color.Model.YCbCr as CM
import Graphics.Color.Space.Internal
import Graphics.Color.Space.RGB.Internal
import Graphics.Color.Space.RGB.ITU.Rec601
import Graphics.Color.Space.RGB.ITU.Rec709
import Graphics.Color.Space.RGB.Luma
import Graphics.Color.Space.RGB.SRGB

-- | `Y'CbCr` representation for some non-linear (@`RedGreenBlue` cs i@) color space
data Y'CbCr (cs :: Linearity -> Type)

-- | Constructor  for `Y'CbCr` color space
newtype instance Color (Y'CbCr cs) e = Y'CbCr (Color CM.YCbCr e)

deriving instance Eq e => Eq (Color (Y'CbCr cs) e)
deriving instance Ord e => Ord (Color (Y'CbCr cs) e)
deriving instance Functor (Color (Y'CbCr cs))
deriving instance Applicative (Color (Y'CbCr cs))
deriving instance Foldable (Color (Y'CbCr cs))
deriving instance Traversable (Color (Y'CbCr cs))
deriving instance Storable e => Storable (Color (Y'CbCr cs) e)

instance (Typeable cs, ColorModel (cs 'NonLinear) e, Elevator e) => Show (Color (Y'CbCr cs) e) where
  showsPrec :: Int -> Color (Y'CbCr cs) e -> ShowS
showsPrec Int
_ = Color (Y'CbCr cs) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | Constructor for an RGB color space in an alternative Y'CbCr color model
pattern ColorY'CbCr :: e -> e -> e -> Color (Y'CbCr cs) e
pattern $bColorY'CbCr :: e -> e -> e -> Color (Y'CbCr cs) e
$mColorY'CbCr :: forall r e (cs :: Linearity -> *).
Color (Y'CbCr cs) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
ColorY'CbCr y cb cr = Y'CbCr (CM.ColorYCbCr y cb cr)
{-# COMPLETE ColorY'CbCr #-}

-- | Constructor for @Y'CbCr@ with alpha channel.
pattern ColorY'CbCrA :: e -> e -> e -> e -> Color (Alpha (Y'CbCr cs)) e
pattern $bColorY'CbCrA :: e -> e -> e -> e -> Color (Alpha (Y'CbCr cs)) e
$mColorY'CbCrA :: forall r e (cs :: Linearity -> *).
Color (Alpha (Y'CbCr cs)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
ColorY'CbCrA y cb cr a = Alpha (Y'CbCr (CM.ColorYCbCr y cb cr)) a
{-# COMPLETE ColorY'CbCrA #-}


instance (Typeable cs, ColorModel (cs 'NonLinear) e, Elevator e) => ColorModel (Y'CbCr cs) e where
  type Components (Y'CbCr cs) e = (e, e, e)
  toComponents :: Color (Y'CbCr cs) e -> Components (Y'CbCr cs) e
toComponents (ColorY'CbCr e
y e
cb e
cr) = (e
y, e
cb, e
cr)
  {-# INLINE toComponents #-}
  fromComponents :: Components (Y'CbCr cs) e -> Color (Y'CbCr cs) e
fromComponents (y, cb, cr) = e -> e -> e -> Color (Y'CbCr cs) e
forall e (cs :: Linearity -> *). e -> e -> e -> Color (Y'CbCr cs) e
ColorY'CbCr e
y e
cb e
cr
  {-# INLINE fromComponents #-}
  showsColorModelName :: Proxy (Color (Y'CbCr cs) e) -> ShowS
showsColorModelName Proxy (Color (Y'CbCr cs) e)
_ =
    (String
"Y'CbCr-" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Color (cs 'NonLinear) e) -> ShowS
forall cs e. ColorModel cs e => Proxy (Color cs e) -> ShowS
showsColorModelName (Proxy (Color (cs 'NonLinear) e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Color (cs 'NonLinear) e))

instance Elevator e => ColorSpace (Y'CbCr SRGB) D65 e where
  type BaseModel (Y'CbCr SRGB) = CM.YCbCr
  type BaseSpace (Y'CbCr SRGB) = SRGB 'NonLinear
  toBaseSpace :: Color (Y'CbCr SRGB) e -> Color (BaseSpace (Y'CbCr SRGB)) e
toBaseSpace = (Float -> e)
-> Color (SRGB 'NonLinear) Float -> Color (SRGB 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => a -> e
fromRealFloat (Color (SRGB 'NonLinear) Float -> Color (SRGB 'NonLinear) e)
-> (Color (Y'CbCr SRGB) e -> Color (SRGB 'NonLinear) Float)
-> Color (Y'CbCr SRGB) e
-> Color (SRGB 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr SRGB) Float -> Color (SRGB 'NonLinear) Float
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (Y'CbCr cs) e -> Color (cs 'NonLinear) e
ycbcr2srgb (Color (Y'CbCr SRGB) Float -> Color (SRGB 'NonLinear) Float)
-> (Color (Y'CbCr SRGB) e -> Color (Y'CbCr SRGB) Float)
-> Color (Y'CbCr SRGB) e
-> Color (SRGB 'NonLinear) Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Float) -> Color (Y'CbCr SRGB) e -> Color (Y'CbCr SRGB) Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Float
forall e. Elevator e => e -> Float
toFloat
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (Y'CbCr SRGB)) e -> Color (Y'CbCr SRGB) e
fromBaseSpace = (Float -> e) -> Color (Y'CbCr SRGB) Float -> Color (Y'CbCr SRGB) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => a -> e
fromRealFloat (Color (Y'CbCr SRGB) Float -> Color (Y'CbCr SRGB) e)
-> (Color (SRGB 'NonLinear) e -> Color (Y'CbCr SRGB) Float)
-> Color (SRGB 'NonLinear) e
-> Color (Y'CbCr SRGB) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (SRGB 'NonLinear) Float -> Color (Y'CbCr SRGB) Float
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (Y'CbCr cs) e
srgb2ycbcr (Color (SRGB 'NonLinear) Float -> Color (Y'CbCr SRGB) Float)
-> (Color (SRGB 'NonLinear) e -> Color (SRGB 'NonLinear) Float)
-> Color (SRGB 'NonLinear) e
-> Color (Y'CbCr SRGB) Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Float)
-> Color (SRGB 'NonLinear) e -> Color (SRGB 'NonLinear) Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Float
forall e. Elevator e => e -> Float
toFloat
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (Y'CbCr SRGB) e -> Color (Y D65) a
luminance = Color (SRGB 'NonLinear) e -> Color (Y D65) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (Y i) a
luminance (Color (SRGB 'NonLinear) e -> Color (Y D65) a)
-> (Color (Y'CbCr SRGB) e -> Color (SRGB 'NonLinear) e)
-> Color (Y'CbCr SRGB) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr SRGB) e -> Color (SRGB 'NonLinear) e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color cs e -> Color (BaseSpace cs) e
toBaseSpace
  {-# INLINE luminance #-}

instance Elevator e => ColorSpace (Y'CbCr BT601_525) D65 e where
  type BaseModel (Y'CbCr BT601_525) = CM.YCbCr
  type BaseSpace (Y'CbCr BT601_525) = BT601_525 'NonLinear
  toBaseSpace :: Color (Y'CbCr BT601_525) e
-> Color (BaseSpace (Y'CbCr BT601_525)) e
toBaseSpace = (Double -> e)
-> Color (BT601_525 'NonLinear) Double
-> Color (BT601_525 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (BT601_525 'NonLinear) Double
 -> Color (BT601_525 'NonLinear) e)
-> (Color (Y'CbCr BT601_525) e
    -> Color (BT601_525 'NonLinear) Double)
-> Color (Y'CbCr BT601_525) e
-> Color (BT601_525 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr BT601_525) e -> Color (BT601_525 'NonLinear) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (Y'CbCr cs) e' -> Color (cs 'NonLinear) e
fromColorY'CbCr
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (Y'CbCr BT601_525)) e
-> Color (Y'CbCr BT601_525) e
fromBaseSpace = (Double -> e)
-> Color (Y'CbCr BT601_525) Double -> Color (Y'CbCr BT601_525) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (Y'CbCr BT601_525) Double -> Color (Y'CbCr BT601_525) e)
-> (Color (BT601_525 'NonLinear) e
    -> Color (Y'CbCr BT601_525) Double)
-> Color (BT601_525 'NonLinear) e
-> Color (Y'CbCr BT601_525) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT601_525 'NonLinear) e -> Color (Y'CbCr BT601_525) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (cs 'NonLinear) e' -> Color (Y'CbCr cs) e
toColorY'CbCr
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (Y'CbCr BT601_525) e -> Color (Y D65) a
luminance = Color (BT601_525 'NonLinear) e -> Color (Y D65) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (Y i) a
luminance (Color (BT601_525 'NonLinear) e -> Color (Y D65) a)
-> (Color (Y'CbCr BT601_525) e -> Color (BT601_525 'NonLinear) e)
-> Color (Y'CbCr BT601_525) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr BT601_525) e -> Color (BT601_525 'NonLinear) e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color cs e -> Color (BaseSpace cs) e
toBaseSpace
  {-# INLINE luminance #-}

instance Elevator e => ColorSpace (Y'CbCr BT601_625) D65 e where
  type BaseModel (Y'CbCr BT601_625) = CM.YCbCr
  type BaseSpace (Y'CbCr BT601_625) = BT601_625 'NonLinear
  toBaseSpace :: Color (Y'CbCr BT601_625) e
-> Color (BaseSpace (Y'CbCr BT601_625)) e
toBaseSpace = (Double -> e)
-> Color (BT601_625 'NonLinear) Double
-> Color (BT601_625 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (BT601_625 'NonLinear) Double
 -> Color (BT601_625 'NonLinear) e)
-> (Color (Y'CbCr BT601_625) e
    -> Color (BT601_625 'NonLinear) Double)
-> Color (Y'CbCr BT601_625) e
-> Color (BT601_625 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr BT601_625) e -> Color (BT601_625 'NonLinear) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (Y'CbCr cs) e' -> Color (cs 'NonLinear) e
fromColorY'CbCr
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (Y'CbCr BT601_625)) e
-> Color (Y'CbCr BT601_625) e
fromBaseSpace = (Double -> e)
-> Color (Y'CbCr BT601_625) Double -> Color (Y'CbCr BT601_625) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (Y'CbCr BT601_625) Double -> Color (Y'CbCr BT601_625) e)
-> (Color (BT601_625 'NonLinear) e
    -> Color (Y'CbCr BT601_625) Double)
-> Color (BT601_625 'NonLinear) e
-> Color (Y'CbCr BT601_625) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT601_625 'NonLinear) e -> Color (Y'CbCr BT601_625) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (cs 'NonLinear) e' -> Color (Y'CbCr cs) e
toColorY'CbCr
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (Y'CbCr BT601_625) e -> Color (Y D65) a
luminance = Color (BT601_625 'NonLinear) e -> Color (Y D65) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (Y i) a
luminance (Color (BT601_625 'NonLinear) e -> Color (Y D65) a)
-> (Color (Y'CbCr BT601_625) e -> Color (BT601_625 'NonLinear) e)
-> Color (Y'CbCr BT601_625) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr BT601_625) e -> Color (BT601_625 'NonLinear) e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color cs e -> Color (BaseSpace cs) e
toBaseSpace
  {-# INLINE luminance #-}

instance Elevator e => ColorSpace (Y'CbCr BT709) D65 e where
  type BaseModel (Y'CbCr BT709) = CM.YCbCr
  type BaseSpace (Y'CbCr BT709) = BT709 'NonLinear
  toBaseSpace :: Color (Y'CbCr BT709) e -> Color (BaseSpace (Y'CbCr BT709)) e
toBaseSpace = (Double -> e)
-> Color (BT709 'NonLinear) Double -> Color (BT709 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (BT709 'NonLinear) Double -> Color (BT709 'NonLinear) e)
-> (Color (Y'CbCr BT709) e -> Color (BT709 'NonLinear) Double)
-> Color (Y'CbCr BT709) e
-> Color (BT709 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr BT709) e -> Color (BT709 'NonLinear) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (Y'CbCr cs) e' -> Color (cs 'NonLinear) e
fromColorY'CbCr
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (Y'CbCr BT709)) e -> Color (Y'CbCr BT709) e
fromBaseSpace = (Double -> e)
-> Color (Y'CbCr BT709) Double -> Color (Y'CbCr BT709) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (Y'CbCr BT709) Double -> Color (Y'CbCr BT709) e)
-> (Color (BT709 'NonLinear) e -> Color (Y'CbCr BT709) Double)
-> Color (BT709 'NonLinear) e
-> Color (Y'CbCr BT709) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (BT709 'NonLinear) e -> Color (Y'CbCr BT709) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (cs 'NonLinear) e' -> Color (Y'CbCr cs) e
toColorY'CbCr
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (Y'CbCr BT709) e -> Color (Y D65) a
luminance = Color (BT709 'NonLinear) e -> Color (Y D65) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (Y i) a
luminance (Color (BT709 'NonLinear) e -> Color (Y D65) a)
-> (Color (Y'CbCr BT709) e -> Color (BT709 'NonLinear) e)
-> Color (Y'CbCr BT709) e
-> Color (Y D65) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr BT709) e -> Color (BT709 'NonLinear) e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color cs e -> Color (BaseSpace cs) e
toBaseSpace
  {-# INLINE luminance #-}

instance (Typeable cs, Luma (cs i), ColorSpace (cs i 'NonLinear) i e, RedGreenBlue (cs i) i) =>
         ColorSpace (Y'CbCr (cs i)) i e where
  type BaseModel (Y'CbCr (cs i)) = CM.YCbCr
  type BaseSpace (Y'CbCr (cs i)) = cs i 'NonLinear
  toBaseSpace :: Color (Y'CbCr (cs i)) e -> Color (BaseSpace (Y'CbCr (cs i))) e
toBaseSpace = (Double -> e)
-> Color (cs i 'NonLinear) Double -> Color (cs i 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (cs i 'NonLinear) Double -> Color (cs i 'NonLinear) e)
-> (Color (Y'CbCr (cs i)) e -> Color (cs i 'NonLinear) Double)
-> Color (Y'CbCr (cs i)) e
-> Color (cs i 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr (cs i)) e -> Color (cs i 'NonLinear) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (Y'CbCr cs) e' -> Color (cs 'NonLinear) e
fromColorY'CbCr
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (Y'CbCr (cs i))) e -> Color (Y'CbCr (cs i)) e
fromBaseSpace = (Double -> e)
-> Color (Y'CbCr (cs i)) Double -> Color (Y'CbCr (cs i)) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (Y'CbCr (cs i)) Double -> Color (Y'CbCr (cs i)) e)
-> (Color (cs i 'NonLinear) e -> Color (Y'CbCr (cs i)) Double)
-> Color (cs i 'NonLinear) e
-> Color (Y'CbCr (cs i)) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs i 'NonLinear) e -> Color (Y'CbCr (cs i)) Double
forall k (cs :: Linearity -> *) (i :: k) e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
 RealFloat e) =>
Color (cs 'NonLinear) e' -> Color (Y'CbCr cs) e
toColorY'CbCr
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (Y'CbCr (cs i)) e -> Color (Y i) a
luminance = Color (cs i 'NonLinear) e -> Color (Y i) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (Y i) a
luminance (Color (cs i 'NonLinear) e -> Color (Y i) a)
-> (Color (Y'CbCr (cs i)) e -> Color (cs i 'NonLinear) e)
-> Color (Y'CbCr (cs i)) e
-> Color (Y i) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr (cs i)) e -> Color (cs i 'NonLinear) e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color cs e -> Color (BaseSpace cs) e
toBaseSpace
  {-# INLINE luminance #-}


-- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871
--
-- @since 0.1.3
ycbcr2srgb ::
     (RedGreenBlue cs i, RealFloat e) => Color (Y'CbCr cs) e -> Color (cs 'NonLinear) e
ycbcr2srgb :: Color (Y'CbCr cs) e -> Color (cs 'NonLinear) e
ycbcr2srgb (ColorY'CbCr e
y' e
cb e
cr) = e -> e -> e -> Color (cs 'NonLinear) e
forall k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
e -> e -> e -> Color (cs l) e
ColorRGB e
r' e
g' e
b'
  where
    !cb05 :: e
cb05 = e
cb e -> e -> e
forall a. Num a => a -> a -> a
- e
0.5
    !cr05 :: e
cr05 = e
cr e -> e -> e
forall a. Num a => a -> a -> a
- e
0.5
    !r' :: e
r' = e -> e
forall a. RealFloat a => a -> a
clamp01 (e
y'                   e -> e -> e
forall a. Num a => a -> a -> a
+ e
1.402    e -> e -> e
forall a. Num a => a -> a -> a
* e
cr05)
    !g' :: e
g' = e -> e
forall a. RealFloat a => a -> a
clamp01 (e
y' e -> e -> e
forall a. Num a => a -> a -> a
- e
0.344136 e -> e -> e
forall a. Num a => a -> a -> a
* e
cb05 e -> e -> e
forall a. Num a => a -> a -> a
- e
0.714136 e -> e -> e
forall a. Num a => a -> a -> a
* e
cr05)
    !b' :: e
b' = e -> e
forall a. RealFloat a => a -> a
clamp01 (e
y' e -> e -> e
forall a. Num a => a -> a -> a
+ e
1.772    e -> e -> e
forall a. Num a => a -> a -> a
* e
cb05)
{-# INLINE ycbcr2srgb #-}

-- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871
--
-- @since 0.1.3
srgb2ycbcr ::
     (RedGreenBlue cs i, RealFloat e) => Color (cs 'NonLinear) e -> Color (Y'CbCr cs) e
srgb2ycbcr :: Color (cs 'NonLinear) e -> Color (Y'CbCr cs) e
srgb2ycbcr (ColorRGB e
r' e
g' e
b') = e -> e -> e -> Color (Y'CbCr cs) e
forall e (cs :: Linearity -> *). e -> e -> e -> Color (Y'CbCr cs) e
ColorY'CbCr e
y' e
cb e
cr
  where
    !y' :: e
y' =          e
0.299 e -> e -> e
forall a. Num a => a -> a -> a
* e
r' e -> e -> e
forall a. Num a => a -> a -> a
+    e
0.587 e -> e -> e
forall a. Num a => a -> a -> a
* e
g' e -> e -> e
forall a. Num a => a -> a -> a
+    e
0.114 e -> e -> e
forall a. Num a => a -> a -> a
* e
b'
    !cb :: e
cb = e
0.5 e -> e -> e
forall a. Num a => a -> a -> a
- e
0.168736 e -> e -> e
forall a. Num a => a -> a -> a
* e
r' e -> e -> e
forall a. Num a => a -> a -> a
- e
0.331264 e -> e -> e
forall a. Num a => a -> a -> a
* e
g' e -> e -> e
forall a. Num a => a -> a -> a
+      e
0.5 e -> e -> e
forall a. Num a => a -> a -> a
* e
b'
    !cr :: e
cr = e
0.5 e -> e -> e
forall a. Num a => a -> a -> a
+      e
0.5 e -> e -> e
forall a. Num a => a -> a -> a
* e
r' e -> e -> e
forall a. Num a => a -> a -> a
- e
0.418688 e -> e -> e
forall a. Num a => a -> a -> a
* e
g' e -> e -> e
forall a. Num a => a -> a -> a
- e
0.081312 e -> e -> e
forall a. Num a => a -> a -> a
* e
b'
{-# INLINE srgb2ycbcr #-}

-- | Convert any RGB color space that has `Luma` specified to `Y'CbCr`
--
-- @since 0.1.3
toColorY'CbCr ::
     forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)
  => Color (cs 'NonLinear) e'
  -> Color (Y'CbCr cs) e
toColorY'CbCr :: Color (cs 'NonLinear) e' -> Color (Y'CbCr cs) e
toColorY'CbCr Color (cs 'NonLinear) e'
rgb = Color YCbCr e -> Color (Y'CbCr cs) e
forall (cs :: Linearity -> *) e.
Color YCbCr e -> Color (Y'CbCr cs) e
Y'CbCr (Color RGB e' -> Weights e -> Color YCbCr e
forall e' e.
(Elevator e', Elevator e, RealFloat e) =>
Color RGB e' -> Weights e -> Color YCbCr e
CM.rgb2ycbcr (Color (cs 'NonLinear) e' -> Color RGB e'
forall k (cs :: Linearity -> *) (i :: k) (l :: Linearity) e.
RedGreenBlue cs i =>
Color (cs l) e -> Color RGB e
unColorRGB Color (cs 'NonLinear) e'
rgb) Weights e
weights)
  where
    !weights :: Weights e
weights = Color (cs 'NonLinear) e' -> Weights e
forall (cs :: Linearity -> *) e' e.
(Luma cs, RealFloat e) =>
Color (cs 'NonLinear) e' -> Weights e
rgbLumaWeights Color (cs 'NonLinear) e'
rgb
{-# INLINE toColorY'CbCr #-}

-- | Convert `Y'CbCr` to the base RGB color space, which must have `Luma` implemented.
--
-- @since 0.1.3
fromColorY'CbCr ::
     forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)
  => Color (Y'CbCr cs) e'
  -> Color (cs 'NonLinear) e
fromColorY'CbCr :: Color (Y'CbCr cs) e' -> Color (cs 'NonLinear) e
fromColorY'CbCr Color (Y'CbCr cs) e'
ycbcr = Color (cs 'NonLinear) e
rgb
  where
    !rgb :: Color (cs 'NonLinear) e
rgb = Color RGB e -> Color (cs 'NonLinear) e
forall k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
Color RGB e -> Color (cs l) e
mkColorRGB (Color YCbCr e' -> Weights e -> Color RGB e
forall e' e.
(Elevator e', Elevator e, RealFloat e) =>
Color YCbCr e' -> Weights e -> Color RGB e
CM.ycbcr2rgb (Color (Y'CbCr cs) e' -> Color YCbCr e'
coerce Color (Y'CbCr cs) e'
ycbcr :: Color CM.YCbCr e') Weights e
weights)
    !weights :: Weights e
weights = Color (cs 'NonLinear) e -> Weights e
forall (cs :: Linearity -> *) e' e.
(Luma cs, RealFloat e) =>
Color (cs 'NonLinear) e' -> Weights e
rgbLumaWeights Color (cs 'NonLinear) e
rgb
{-# INLINE fromColorY'CbCr #-}