{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Space.RGB.ITU.Rec601
( pattern BT601_525
, BT601_525
, pattern BT601_625
, BT601_625
, D65
, ycbcrToRec601
, rec601ToYcbcr
, applyGrayscaleRec601
) where
import Data.Coerce
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 qualified Graphics.Color.Model.YCbCr 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
data BT601_525 (l :: Linearity)
newtype instance Color (BT601_525 l) e = BT601_525 (Color CM.RGB e)
deriving instance Eq e => Eq (Color (BT601_525 l) e)
deriving instance Ord e => Ord (Color (BT601_525 l) e)
deriving instance Functor (Color (BT601_525 l))
deriving instance Applicative (Color (BT601_525 l))
deriving instance Foldable (Color (BT601_525 l))
deriving instance Traversable (Color (BT601_525 l))
deriving instance Storable e => Storable (Color (BT601_525 l) e)
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
instance (Typeable l, Elevator e) => ColorModel (BT601_525 l) e where
type Components (BT601_525 l) e = (e, e, e)
type ChannelCount (BT601_525 l) = 3
channelCount :: Proxy (Color (BT601_525 l) e) -> Word8
channelCount Proxy (Color (BT601_525 l) e)
_ = Word8
3
{-# INLINE channelCount #-}
channelNames :: Proxy (Color (BT601_525 l) e) -> NonEmpty String
channelNames Proxy (Color (BT601_525 l) e)
_ = Proxy (Color RGB e) -> NonEmpty String
forall cs e.
ColorModel cs e =>
Proxy (Color cs e) -> NonEmpty String
channelNames (Proxy (Color RGB e)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Color CM.RGB e))
channelColors :: Proxy (Color (BT601_525 l) e) -> NonEmpty (V3 Word8)
channelColors Proxy (Color (BT601_525 l) e)
_ = Proxy (Color RGB e) -> NonEmpty (V3 Word8)
forall cs e.
ColorModel cs e =>
Proxy (Color cs e) -> NonEmpty (V3 Word8)
channelColors (Proxy (Color RGB e)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Color CM.RGB e))
toComponents :: Color (BT601_525 l) e -> Components (BT601_525 l) e
toComponents = Color RGB e -> (e, e, e)
Color RGB e -> Components RGB 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
forall (l :: Linearity) e. Color (BT601_525 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 e (l :: Linearity). 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
Components RGB e -> Color RGB e
forall cs e. ColorModel cs e => Components cs e -> Color cs e
fromComponents
{-# INLINE fromComponents #-}
instance Elevator e => ColorSpace (BT601_525 'Linear) D65 e where
type BaseModel (BT601_525 'Linear) = CM.RGB
toBaseSpace :: ColorSpace (BaseSpace (BT601_525 'Linear)) D65 e =>
Color (BT601_525 'Linear) e
-> Color (BaseSpace (BT601_525 'Linear)) e
toBaseSpace = Color (BT601_525 'Linear) e
-> Color (BaseSpace (BT601_525 'Linear)) e
Color (BT601_525 'Linear) e -> Color (BT601_525 'Linear) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: ColorSpace (BaseSpace (BT601_525 'Linear)) D65 e =>
Color (BaseSpace (BT601_525 'Linear)) e
-> Color (BT601_525 'Linear) e
fromBaseSpace = Color (BaseSpace (BT601_525 'Linear)) e
-> Color (BT601_525 'Linear) e
Color (BT601_525 'Linear) e -> Color (BT601_525 'Linear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: forall a.
(Elevator a, RealFloat a) =>
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 a b.
(a -> b)
-> Color (BT601_525 'Linear) a -> Color (BT601_525 'Linear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
grayscale :: Color (BT601_525 'Linear) e -> Color X e
grayscale = Color (BT601_525 'Linear) e -> Color X e
forall {k} (cs :: Linearity -> *) (i :: k) e.
ColorSpace (cs 'Linear) i e =>
Color (cs 'Linear) e -> Color X e
rgbLinearGrayscale
{-# INLINE grayscale #-}
applyGrayscale :: Color (BT601_525 'Linear) e
-> (Color X e -> Color X e) -> Color (BT601_525 'Linear) e
applyGrayscale = Color (BT601_525 'Linear) e
-> (Color X e -> Color X e) -> Color (BT601_525 'Linear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
ColorSpace (cs 'Linear) i e =>
Color (cs 'Linear) e
-> (Color X e -> Color X e) -> Color (cs 'Linear) e
rgbLinearApplyGrayscale
{-# INLINE applyGrayscale #-}
toColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
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 a b.
(a -> b)
-> Color (BT601_525 'Linear) a -> Color (BT601_525 'Linear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
Color (XYZ D65) a -> Color (BT601_525 'Linear) e
fromColorXYZ = (a -> e)
-> Color (BT601_525 'Linear) a -> Color (BT601_525 'Linear) e
forall a b.
(a -> b)
-> Color (BT601_525 'Linear) a -> Color (BT601_525 'Linear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> e
forall a. (Elevator a, RealFloat a) => 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 #-}
instance Elevator e => ColorSpace (BT601_525 'NonLinear) D65 e where
type BaseModel (BT601_525 'NonLinear) = CM.RGB
toBaseSpace :: ColorSpace (BaseSpace (BT601_525 'NonLinear)) D65 e =>
Color (BT601_525 'NonLinear) e
-> Color (BaseSpace (BT601_525 'NonLinear)) e
toBaseSpace = Color (BT601_525 'NonLinear) e
-> Color (BaseSpace (BT601_525 'NonLinear)) e
Color (BT601_525 'NonLinear) e -> Color (BT601_525 'NonLinear) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: ColorSpace (BaseSpace (BT601_525 'NonLinear)) D65 e =>
Color (BaseSpace (BT601_525 'NonLinear)) e
-> Color (BT601_525 'NonLinear) e
fromBaseSpace = Color (BaseSpace (BT601_525 'NonLinear)) e
-> Color (BT601_525 'NonLinear) e
Color (BT601_525 'NonLinear) e -> Color (BT601_525 'NonLinear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: forall a.
(Elevator a, RealFloat a) =>
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 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 e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
grayscale :: Color (BT601_525 'NonLinear) e -> Color X e
grayscale = (Double -> e) -> Color X Double -> Color X e
forall a b. (a -> b) -> Color X a -> Color X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color X Double -> Color X e)
-> (Color (BT601_525 'NonLinear) e -> Color X Double)
-> Color (BT601_525 'NonLinear) e
-> Color X e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y' BT601_525) Double -> Color X Double
forall a b. Coercible a b => a -> b
coerce (Color (Y' BT601_525) Double -> Color X Double)
-> (Color (BT601_525 'NonLinear) e -> Color (Y' BT601_525) Double)
-> Color (BT601_525 'NonLinear) e
-> Color X Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' cs) e
forall (cs :: Linearity -> *) i e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
RealFloat e) =>
Color (cs 'NonLinear) e' -> Color (Y' cs) e
rgbLuma @_ @_ @_ @Double
{-# INLINE grayscale #-}
applyGrayscale :: Color (BT601_525 'NonLinear) e
-> (Color X e -> Color X e) -> Color (BT601_525 'NonLinear) e
applyGrayscale = Color (BT601_525 'NonLinear) e
-> (Color X e -> Color X e) -> Color (BT601_525 'NonLinear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e) =>
Color (cs 'NonLinear) e
-> (Color X e -> Color X e) -> Color (cs 'NonLinear) e
applyGrayscaleRec601
{-# INLINE applyGrayscale #-}
toColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
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 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 e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
Color (XYZ D65) a -> Color (BT601_525 'NonLinear) e
fromColorXYZ = (a -> e)
-> Color (BT601_525 'NonLinear) a -> 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 a -> e
forall a. (Elevator a, RealFloat a) => 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 #-}
instance RedGreenBlue BT601_525 D65 where
gamut :: forall e. RealFloat e => 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 :: forall e. RealFloat e => e -> e
transfer = e -> e
forall a. (Ord a, Floating a) => a -> a
transferRec601
{-# INLINE transfer #-}
itransfer :: forall e. RealFloat e => e -> e
itransfer = e -> e
forall a. (Ord a, Floating a) => a -> a
itransferRec601
{-# INLINE itransfer #-}
data BT601_625 (l :: Linearity)
newtype instance Color (BT601_625 l) e = BT601_625 (Color CM.RGB e)
deriving instance Eq e => Eq (Color (BT601_625 l) e)
deriving instance Ord e => Ord (Color (BT601_625 l) e)
deriving instance Functor (Color (BT601_625 l))
deriving instance Applicative (Color (BT601_625 l))
deriving instance Foldable (Color (BT601_625 l))
deriving instance Traversable (Color (BT601_625 l))
deriving instance Storable e => Storable (Color (BT601_625 l) e)
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
instance (Typeable l, Elevator e) => ColorModel (BT601_625 l) e where
type Components (BT601_625 l) e = (e, e, e)
type ChannelCount (BT601_625 l) = 3
channelCount :: Proxy (Color (BT601_625 l) e) -> Word8
channelCount Proxy (Color (BT601_625 l) e)
_ = Word8
3
{-# INLINE channelCount #-}
channelNames :: Proxy (Color (BT601_625 l) e) -> NonEmpty String
channelNames Proxy (Color (BT601_625 l) e)
_ = Proxy (Color RGB e) -> NonEmpty String
forall cs e.
ColorModel cs e =>
Proxy (Color cs e) -> NonEmpty String
channelNames (Proxy (Color RGB e)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Color CM.RGB e))
channelColors :: Proxy (Color (BT601_625 l) e) -> NonEmpty (V3 Word8)
channelColors Proxy (Color (BT601_625 l) e)
_ = Proxy (Color RGB e) -> NonEmpty (V3 Word8)
forall cs e.
ColorModel cs e =>
Proxy (Color cs e) -> NonEmpty (V3 Word8)
channelColors (Proxy (Color RGB e)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Color CM.RGB e))
toComponents :: Color (BT601_625 l) e -> Components (BT601_625 l) e
toComponents = Color RGB e -> (e, e, e)
Color RGB e -> Components RGB 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
forall (l :: Linearity) e. Color (BT601_625 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 e (l :: Linearity). 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
Components RGB e -> Color RGB e
forall cs e. ColorModel cs e => Components cs e -> Color cs e
fromComponents
{-# INLINE fromComponents #-}
instance Elevator e => ColorSpace (BT601_625 'Linear) D65 e where
type BaseModel (BT601_625 'Linear) = CM.RGB
toBaseSpace :: ColorSpace (BaseSpace (BT601_625 'Linear)) D65 e =>
Color (BT601_625 'Linear) e
-> Color (BaseSpace (BT601_625 'Linear)) e
toBaseSpace = Color (BT601_625 'Linear) e
-> Color (BaseSpace (BT601_625 'Linear)) e
Color (BT601_625 'Linear) e -> Color (BT601_625 'Linear) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: ColorSpace (BaseSpace (BT601_625 'Linear)) D65 e =>
Color (BaseSpace (BT601_625 'Linear)) e
-> Color (BT601_625 'Linear) e
fromBaseSpace = Color (BaseSpace (BT601_625 'Linear)) e
-> Color (BT601_625 'Linear) e
Color (BT601_625 'Linear) e -> Color (BT601_625 'Linear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: forall a.
(Elevator a, RealFloat a) =>
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 a b.
(a -> b)
-> Color (BT601_625 'Linear) a -> Color (BT601_625 'Linear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
grayscale :: Color (BT601_625 'Linear) e -> Color X e
grayscale = Color (BT601_625 'Linear) e -> Color X e
forall {k} (cs :: Linearity -> *) (i :: k) e.
ColorSpace (cs 'Linear) i e =>
Color (cs 'Linear) e -> Color X e
rgbLinearGrayscale
{-# INLINE grayscale #-}
applyGrayscale :: Color (BT601_625 'Linear) e
-> (Color X e -> Color X e) -> Color (BT601_625 'Linear) e
applyGrayscale = Color (BT601_625 'Linear) e
-> (Color X e -> Color X e) -> Color (BT601_625 'Linear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
ColorSpace (cs 'Linear) i e =>
Color (cs 'Linear) e
-> (Color X e -> Color X e) -> Color (cs 'Linear) e
rgbLinearApplyGrayscale
{-# INLINE applyGrayscale #-}
toColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
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 a b.
(a -> b)
-> Color (BT601_625 'Linear) a -> Color (BT601_625 'Linear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
Color (XYZ D65) a -> Color (BT601_625 'Linear) e
fromColorXYZ = (a -> e)
-> Color (BT601_625 'Linear) a -> Color (BT601_625 'Linear) e
forall a b.
(a -> b)
-> Color (BT601_625 'Linear) a -> Color (BT601_625 'Linear) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> e
forall a. (Elevator a, RealFloat a) => 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 #-}
instance Elevator e => ColorSpace (BT601_625 'NonLinear) D65 e where
type BaseModel (BT601_625 'NonLinear) = CM.RGB
toBaseSpace :: ColorSpace (BaseSpace (BT601_625 'NonLinear)) D65 e =>
Color (BT601_625 'NonLinear) e
-> Color (BaseSpace (BT601_625 'NonLinear)) e
toBaseSpace = Color (BT601_625 'NonLinear) e
-> Color (BaseSpace (BT601_625 'NonLinear)) e
Color (BT601_625 'NonLinear) e -> Color (BT601_625 'NonLinear) e
forall a. a -> a
id
{-# INLINE toBaseSpace #-}
fromBaseSpace :: ColorSpace (BaseSpace (BT601_625 'NonLinear)) D65 e =>
Color (BaseSpace (BT601_625 'NonLinear)) e
-> Color (BT601_625 'NonLinear) e
fromBaseSpace = Color (BaseSpace (BT601_625 'NonLinear)) e
-> Color (BT601_625 'NonLinear) e
Color (BT601_625 'NonLinear) e -> Color (BT601_625 'NonLinear) e
forall a. a -> a
id
{-# INLINE fromBaseSpace #-}
luminance :: forall a.
(Elevator a, RealFloat a) =>
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 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 e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE luminance #-}
grayscale :: Color (BT601_625 'NonLinear) e -> Color X e
grayscale = (Double -> e) -> Color X Double -> Color X e
forall a b. (a -> b) -> Color X a -> Color X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color X Double -> Color X e)
-> (Color (BT601_625 'NonLinear) e -> Color X Double)
-> Color (BT601_625 'NonLinear) e
-> Color X e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y' BT601_625) Double -> Color X Double
forall a b. Coercible a b => a -> b
coerce (Color (Y' BT601_625) Double -> Color X Double)
-> (Color (BT601_625 'NonLinear) e -> Color (Y' BT601_625) Double)
-> Color (BT601_625 'NonLinear) e
-> Color X Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' cs) e
forall (cs :: Linearity -> *) i e' e.
(Luma cs, RedGreenBlue cs i, Elevator e', Elevator e,
RealFloat e) =>
Color (cs 'NonLinear) e' -> Color (Y' cs) e
rgbLuma @_ @_ @_ @Double
{-# INLINE grayscale #-}
applyGrayscale :: Color (BT601_625 'NonLinear) e
-> (Color X e -> Color X e) -> Color (BT601_625 'NonLinear) e
applyGrayscale = Color (BT601_625 'NonLinear) e
-> (Color X e -> Color X e) -> Color (BT601_625 'NonLinear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e) =>
Color (cs 'NonLinear) e
-> (Color X e -> Color X e) -> Color (cs 'NonLinear) e
applyGrayscaleRec601
{-# INLINE applyGrayscale #-}
toColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
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 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 e -> a
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ :: forall a.
(Elevator a, RealFloat a) =>
Color (XYZ D65) a -> Color (BT601_625 'NonLinear) e
fromColorXYZ = (a -> e)
-> Color (BT601_625 'NonLinear) a -> 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 a -> e
forall a. (Elevator a, RealFloat a) => 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 #-}
instance RedGreenBlue BT601_625 D65 where
gamut :: forall e. RealFloat e => 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 k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Gamut cs i e
gamut @_ @BT470_625)
transfer :: forall e. RealFloat e => e -> e
transfer = e -> e
forall a. (Ord a, Floating a) => a -> a
transferRec601
{-# INLINE transfer #-}
itransfer :: forall e. RealFloat e => e -> e
itransfer = e -> e
forall a. (Ord a, Floating a) => a -> a
itransferRec601
{-# INLINE itransfer #-}
instance Luma BT601_525 where
rWeight :: forall e. RealFloat e => Weight BT601_525 e
rWeight = Weight BT601_525 e
0.299
gWeight :: forall e. RealFloat e => Weight BT601_525 e
gWeight = Weight BT601_525 e
0.587
bWeight :: forall e. RealFloat e => Weight BT601_525 e
bWeight = Weight BT601_525 e
0.114
instance Luma BT601_625 where
rWeight :: forall e. RealFloat e => Weight BT601_625 e
rWeight = Weight BT601_625 e
0.299
gWeight :: forall e. RealFloat e => Weight BT601_625 e
gWeight = Weight BT601_625 e
0.587
bWeight :: forall e. RealFloat e => Weight BT601_625 e
bWeight = Weight BT601_625 e
0.114
transferRec601 :: (Ord a, Floating a) => a -> a
transferRec601 :: forall a. (Ord a, Floating a) => 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 ) a -> a -> a
forall a. Num a => a -> a -> a
- a
0.099
{-# INLINE transferRec601 #-}
itransferRec601 :: (Ord a, Floating a) => a -> a
itransferRec601 :: forall a. (Ord a, Floating a) => 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 :: forall a. (Ord a, Floating a) => a
inv0018 = a -> a
forall a. (Ord a, Floating a) => a -> a
transferRec601 a
0.018
ycbcrToRec601 ::
(RedGreenBlue cs i, RealFloat e)
=> Color CM.YCbCr e
-> Color (cs 'NonLinear) e
ycbcrToRec601 :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color YCbCr e -> Color (cs 'NonLinear) e
ycbcrToRec601 (CM.ColorYCbCr e
y' e
cb e
cr) = 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 (e -> e -> e -> Color RGB e
forall e. e -> e -> e -> Color RGB e
CM.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 e. RealFloat e => e -> e
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 e. RealFloat e => e -> e
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 e. RealFloat e => e -> e
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 ycbcrToRec601 #-}
rec601ToYcbcr :: (RedGreenBlue cs i, RealFloat e) => Color (cs 'NonLinear) e -> Color CM.YCbCr e
rec601ToYcbcr :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color YCbCr e
rec601ToYcbcr Color (cs 'NonLinear) e
rgb = e -> e -> e -> Color YCbCr e
forall e. e -> e -> e -> Color YCbCr e
CM.ColorYCbCr e
y' e
cb e
cr
where
CM.ColorRGB e
r' e
g' e
b' = 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
!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 rec601ToYcbcr #-}
applyGrayscaleRec601 ::
forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e)
=> Color (cs 'NonLinear) e
-> (Color X e -> Color X e)
-> Color (cs 'NonLinear) e
applyGrayscaleRec601 :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e) =>
Color (cs 'NonLinear) e
-> (Color X e -> Color X e) -> Color (cs 'NonLinear) e
applyGrayscaleRec601 Color (cs 'NonLinear) e
rgb Color X e -> Color X e
f =
case Color (cs 'NonLinear) Double -> Color YCbCr Double
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color YCbCr e
rec601ToYcbcr (e -> Double
forall e. Elevator e => e -> Double
toDouble (e -> Double)
-> Color (cs 'NonLinear) e -> Color (cs 'NonLinear) Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Color (cs 'NonLinear) e
rgb) of
(CM.ColorYCbCr Double
y' Double
cb Double
cr :: Color CM.YCbCr Double) ->
Double -> e
forall e. Elevator e => Double -> e
fromDouble (Double -> e)
-> Color (cs 'NonLinear) Double -> Color (cs 'NonLinear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Color YCbCr Double -> Color (cs 'NonLinear) Double
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Color YCbCr e -> Color (cs 'NonLinear) e
ycbcrToRec601 (Double -> Double -> Double -> Color YCbCr Double
forall e. e -> e -> e -> Color YCbCr e
CM.ColorYCbCr (e -> Double
forall e. Elevator e => e -> Double
toDouble (Color X e -> e
forall a b. Coercible a b => a -> b
coerce (Color X e -> Color X e
f (e -> Color X e
forall e. e -> Color X e
X (Double -> e
forall e. Elevator e => Double -> e
fromDouble Double
y'))) :: e)) Double
cb Double
cr)
{-# INLINE applyGrayscaleRec601 #-}