{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Space.RGB.ITU.Rec709
( pattern BT709
, BT709
, D65
, primaries
, Rec601.transfer
, Rec601.itransfer
, module Graphics.Color.Space
) where
import Data.Coerce
import Data.Typeable
import Foreign.Storable
import Graphics.Color.Model.Internal
import qualified Graphics.Color.Model.RGB as CM
import Graphics.Color.Space
import Graphics.Color.Space.RGB.ITU.Rec601 as Rec601 (D65, itransfer, transfer)
import Graphics.Color.Space.RGB.Luma
data BT709 (l :: Linearity)
newtype instance Color (BT709 l) e = BT709 (Color CM.RGB e)
deriving instance Eq e => Eq (Color (BT709 l) e)
deriving instance Ord e => Ord (Color (BT709 l) e)
deriving instance Functor (Color (BT709 l))
deriving instance Applicative (Color (BT709 l))
deriving instance Foldable (Color (BT709 l))
deriving instance Traversable (Color (BT709 l))
deriving instance Storable e => Storable (Color (BT709 l) e)
instance (Typeable l, Elevator e) => Show (Color (BT709 l) e) where
showsPrec _ = showsColorModel
instance (Typeable l, Elevator e) => ColorModel (BT709 l) e where
type Components (BT709 l) e = (e, e, e)
toComponents = toComponents . unColorRGB
{-# INLINE toComponents #-}
fromComponents = mkColorRGB . fromComponents
{-# INLINE fromComponents #-}
instance Elevator e => ColorSpace (BT709 'Linear) D65 e where
type BaseModel (BT709 'Linear) = CM.RGB
toBaseSpace = id
{-# INLINE toBaseSpace #-}
fromBaseSpace = id
{-# INLINE fromBaseSpace #-}
luminance = rgbLinearLuminance . fmap toRealFloat
{-# INLINE luminance #-}
toColorXYZ = rgbLinear2xyz . fmap toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
{-# INLINE fromColorXYZ #-}
instance Elevator e => ColorSpace (BT709 'NonLinear) D65 e where
type BaseModel (BT709 'NonLinear) = CM.RGB
toBaseSpace = id
{-# INLINE toBaseSpace #-}
fromBaseSpace = id
{-# INLINE fromBaseSpace #-}
luminance = rgbLuminance . fmap toRealFloat
{-# INLINE luminance #-}
toColorXYZ = rgb2xyz . fmap toRealFloat
{-# INLINE toColorXYZ #-}
fromColorXYZ = fmap fromRealFloat . xyz2rgb
{-# INLINE fromColorXYZ #-}
instance RedGreenBlue BT709 D65 where
gamut = primaries
ecctf = BT709 . fmap Rec601.transfer . coerce
{-# INLINE ecctf #-}
dcctf = BT709 . fmap Rec601.itransfer . coerce
{-# INLINE dcctf #-}
primaries :: RealFloat e => Gamut rgb i e
primaries = Gamut (Primary 0.64 0.33)
(Primary 0.30 0.60)
(Primary 0.15 0.06)
instance Luma BT709 where
rWeight = 0.2126
gWeight = 0.7152
bWeight = 0.0722