{-# 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 #-}
{-# LANGUAGE ViewPatterns #-}
-- |
-- Module      : Graphics.Color.Space.RGB.Alternative.YCbCr
-- Copyright   : (c) Alexey Kuleshevich 2019-2025
-- 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) => 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 $mColorY'CbCr :: forall {r} {e} {cs :: Linearity -> *}.
Color (Y'CbCr cs) e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bColorY'CbCr :: forall e (cs :: Linearity -> *). e -> e -> e -> Color (Y'CbCr cs) e
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 $mColorY'CbCrA :: forall {r} {e} {cs :: Linearity -> *}.
Color (Alpha (Y'CbCr cs)) e
-> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bColorY'CbCrA :: forall e (cs :: Linearity -> *).
e -> e -> e -> e -> Color (Alpha (Y'CbCr cs)) e
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)
  type ChannelCount (Y'CbCr cs) = 3
  channelCount :: Proxy (Color (Y'CbCr cs) e) -> Word8
channelCount Proxy (Color (Y'CbCr cs) e)
_ = Word8
3
  {-# INLINE channelCount #-}
  channelNames :: Proxy (Color (Y'CbCr cs) e) -> NonEmpty String
channelNames Proxy (Color (Y'CbCr cs) e)
_ = Proxy (Color YCbCr e) -> NonEmpty String
forall cs e.
ColorModel cs e =>
Proxy (Color cs e) -> NonEmpty String
channelNames (Proxy (Color YCbCr e)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Color CM.YCbCr e))
  channelColors :: Proxy (Color (Y'CbCr cs) e) -> NonEmpty (V3 Word8)
channelColors Proxy (Color (Y'CbCr cs) e)
_ = Proxy (Color YCbCr e) -> NonEmpty (V3 Word8)
forall cs e.
ColorModel cs e =>
Proxy (Color cs e) -> NonEmpty (V3 Word8)
channelColors (Proxy (Color YCbCr e)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Color CM.YCbCr 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 (e
y, e
cb, e
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 :: ColorSpace (BaseSpace (Y'CbCr SRGB)) D65 e =>
Color (Y'CbCr SRGB) e -> Color (BaseSpace (Y'CbCr SRGB)) e
toBaseSpace = (Float -> e)
-> Color (SRGB 'NonLinear) Float -> Color (SRGB 'NonLinear) e
forall a b.
(a -> b) -> Color (SRGB 'NonLinear) a -> Color (SRGB 'NonLinear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> e
forall a. (Elevator a, RealFloat a) => a -> 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 a b.
(a -> b) -> Color (Y'CbCr SRGB) a -> Color (Y'CbCr SRGB) b
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 :: ColorSpace (BaseSpace (Y'CbCr SRGB)) D65 e =>
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 a b.
(a -> b) -> Color (Y'CbCr SRGB) a -> Color (Y'CbCr SRGB) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> e
forall a. (Elevator a, RealFloat a) => a -> 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 a b.
(a -> b) -> Color (SRGB 'NonLinear) a -> Color (SRGB 'NonLinear) b
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 :: forall a.
(Elevator a, RealFloat a) =>
Color (Y'CbCr SRGB) e -> Color (Y D65) a
luminance = Color (SRGB 'NonLinear) e -> Color (Y D65) a
forall a.
(Elevator a, RealFloat a) =>
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 (BaseSpace (Y'CbCr SRGB)) e
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 #-}
  grayscale :: Color (Y'CbCr SRGB) e -> Color X e
grayscale (Color (Y'CbCr SRGB) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
y' e
_ e
_) = e -> Color X e
forall e. e -> Color X e
X e
y'
  {-# INLINE grayscale #-}
  replaceGrayscale :: Color (Y'CbCr SRGB) e -> Color X e -> Color (Y'CbCr SRGB) e
replaceGrayscale (Color (Y'CbCr SRGB) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
_ e
cb e
cr) (X e
y') = V3 e -> Color (Y'CbCr SRGB) e
forall a b. Coercible a b => a -> b
coerce (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 e
y' e
cb e
cr)
  {-# INLINE replaceGrayscale #-}

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 :: ColorSpace (BaseSpace (Y'CbCr BT601_525)) D65 e =>
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 a b.
(a -> b)
-> Color (BT601_525 'NonLinear) a -> Color (BT601_525 'NonLinear) b
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 :: ColorSpace (BaseSpace (Y'CbCr BT601_525)) D65 e =>
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 a b.
(a -> b)
-> Color (Y'CbCr BT601_525) a -> Color (Y'CbCr BT601_525) b
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 :: forall a.
(Elevator a, RealFloat a) =>
Color (Y'CbCr BT601_525) e -> Color (Y D65) a
luminance = Color (BT601_525 'NonLinear) e -> Color (Y D65) a
forall a.
(Elevator a, RealFloat a) =>
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 (BaseSpace (Y'CbCr BT601_525)) e
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 #-}
  grayscale :: Color (Y'CbCr BT601_525) e -> Color X e
grayscale (Color (Y'CbCr BT601_525) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
y' e
_ e
_) = e -> Color X e
forall e. e -> Color X e
X e
y'
  {-# INLINE grayscale #-}
  replaceGrayscale :: Color (Y'CbCr BT601_525) e
-> Color X e -> Color (Y'CbCr BT601_525) e
replaceGrayscale (Color (Y'CbCr BT601_525) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
_ e
cb e
cr) (X e
y') = V3 e -> Color (Y'CbCr BT601_525) e
forall a b. Coercible a b => a -> b
coerce (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 e
y' e
cb e
cr)
  {-# INLINE replaceGrayscale #-}

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 :: ColorSpace (BaseSpace (Y'CbCr BT601_625)) D65 e =>
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 a b.
(a -> b)
-> Color (BT601_625 'NonLinear) a -> Color (BT601_625 'NonLinear) b
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 :: ColorSpace (BaseSpace (Y'CbCr BT601_625)) D65 e =>
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 a b.
(a -> b)
-> Color (Y'CbCr BT601_625) a -> Color (Y'CbCr BT601_625) b
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 :: forall a.
(Elevator a, RealFloat a) =>
Color (Y'CbCr BT601_625) e -> Color (Y D65) a
luminance = Color (BT601_625 'NonLinear) e -> Color (Y D65) a
forall a.
(Elevator a, RealFloat a) =>
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 (BaseSpace (Y'CbCr BT601_625)) e
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 #-}
  grayscale :: Color (Y'CbCr BT601_625) e -> Color X e
grayscale (Color (Y'CbCr BT601_625) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
y' e
_ e
_) = e -> Color X e
forall e. e -> Color X e
X e
y'
  {-# INLINE grayscale #-}
  replaceGrayscale :: Color (Y'CbCr BT601_625) e
-> Color X e -> Color (Y'CbCr BT601_625) e
replaceGrayscale (Color (Y'CbCr BT601_625) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
_ e
cb e
cr) (X e
y') = V3 e -> Color (Y'CbCr BT601_625) e
forall a b. Coercible a b => a -> b
coerce (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 e
y' e
cb e
cr)
  {-# INLINE replaceGrayscale #-}

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 :: ColorSpace (BaseSpace (Y'CbCr BT709)) D65 e =>
Color (Y'CbCr BT709) e -> Color (BaseSpace (Y'CbCr BT709)) e
toBaseSpace = (Double -> e)
-> Color (BT709 'NonLinear) Double -> Color (BT709 'NonLinear) e
forall a b.
(a -> b)
-> Color (BT709 'NonLinear) a -> Color (BT709 'NonLinear) b
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 :: ColorSpace (BaseSpace (Y'CbCr BT709)) D65 e =>
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 a b.
(a -> b) -> Color (Y'CbCr BT709) a -> Color (Y'CbCr BT709) b
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 :: forall a.
(Elevator a, RealFloat a) =>
Color (Y'CbCr BT709) e -> Color (Y D65) a
luminance = Color (BT709 'NonLinear) e -> Color (Y D65) a
forall a.
(Elevator a, RealFloat a) =>
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 (BaseSpace (Y'CbCr BT709)) e
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 #-}
  grayscale :: Color (Y'CbCr BT709) e -> Color X e
grayscale (Color (Y'CbCr BT709) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
y' e
_ e
_) = e -> Color X e
forall e. e -> Color X e
X e
y'
  {-# INLINE grayscale #-}
  replaceGrayscale :: Color (Y'CbCr BT709) e -> Color X e -> Color (Y'CbCr BT709) e
replaceGrayscale (Color (Y'CbCr BT709) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
_ e
cb e
cr) (X e
y') = V3 e -> Color (Y'CbCr BT709) e
forall a b. Coercible a b => a -> b
coerce (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 e
y' e
cb e
cr)
  {-# INLINE replaceGrayscale #-}

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 :: ColorSpace (BaseSpace (Y'CbCr (cs i))) i e =>
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 a b.
(a -> b) -> Color (cs i 'NonLinear) a -> Color (cs i 'NonLinear) b
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 :: ColorSpace (BaseSpace (Y'CbCr (cs i))) i e =>
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 a b.
(a -> b) -> Color (Y'CbCr (cs i)) a -> Color (Y'CbCr (cs i)) b
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 :: forall a.
(Elevator a, RealFloat a) =>
Color (Y'CbCr (cs i)) e -> Color (Y i) a
luminance = Color (cs i 'NonLinear) e -> Color (Y i) a
forall a.
(Elevator a, RealFloat a) =>
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
Color (Y'CbCr (cs i)) e -> Color (BaseSpace (Y'CbCr (cs i))) 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 #-}
  grayscale :: Color (Y'CbCr (cs i)) e -> Color X e
grayscale (Color (Y'CbCr (cs i)) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
y' e
_ e
_) = e -> Color X e
forall e. e -> Color X e
X e
y'
  {-# INLINE grayscale #-}
  replaceGrayscale :: Color (Y'CbCr (cs i)) e -> Color X e -> Color (Y'CbCr (cs i)) e
replaceGrayscale (Color (Y'CbCr (cs i)) e -> V3 e
forall a b. Coercible a b => a -> b
coerce -> V3 e
_ e
cb e
cr) (X e
y') = V3 e -> Color (Y'CbCr (cs i)) e
forall a b. Coercible a b => a -> b
coerce (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 e
y' e
cb e
cr)
  {-# INLINE replaceGrayscale #-}


-- | 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 :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (Y'CbCr cs) e -> Color (cs 'NonLinear) e
ycbcr2srgb = Color YCbCr e -> Color (cs 'NonLinear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color YCbCr e -> Color (cs 'NonLinear) e
ycbcrToRec601 (Color YCbCr e -> Color (cs 'NonLinear) e)
-> (Color (Y'CbCr cs) e -> Color YCbCr e)
-> Color (Y'CbCr cs) e
-> Color (cs 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y'CbCr cs) e -> Color YCbCr e
forall a b. Coercible a b => a -> b
coerce
{-# 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 :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (Y'CbCr cs) e
srgb2ycbcr = Color YCbCr e -> Color (Y'CbCr cs) e
forall a b. Coercible a b => a -> b
coerce (Color YCbCr e -> Color (Y'CbCr cs) e)
-> (Color (cs 'NonLinear) e -> Color YCbCr e)
-> Color (cs 'NonLinear) e
-> Color (Y'CbCr cs) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'NonLinear) e -> Color YCbCr e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color YCbCr e
rec601ToYcbcr
{-# 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 :: 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 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
forall (l :: Linearity) e. 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 :: 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 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 e (l :: Linearity). Color RGB e -> Color (cs l) 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'
forall a b. Coercible a b => a -> b
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 #-}