{-# 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.AdobeRGB
(
pattern AdobeRGB
, pattern ColorAdobeRGB
, pattern ColorAdobeRGBA
, AdobeRGB
, D65
, primaries
, npmStandard
, inpmStandard
, transfer
, itransfer
, module Graphics.Color.Space
) where
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 (D65)
data AdobeRGB
newtype instance Color AdobeRGB e = AdobeRGB (Color CM.RGB e)
pattern ColorAdobeRGB :: e -> e -> e -> Color AdobeRGB e
pattern ColorAdobeRGB r g b = AdobeRGB (CM.ColorRGB r g b)
{-# COMPLETE ColorAdobeRGB #-}
pattern ColorAdobeRGBA :: e -> e -> e -> e -> Color (Alpha AdobeRGB) e
pattern ColorAdobeRGBA r g b a = Alpha (AdobeRGB (CM.ColorRGB r g b)) a
{-# COMPLETE ColorAdobeRGBA #-}
deriving instance Eq e => Eq (Color AdobeRGB e)
deriving instance Ord e => Ord (Color AdobeRGB e)
deriving instance Functor (Color AdobeRGB)
deriving instance Applicative (Color AdobeRGB)
deriving instance Foldable (Color AdobeRGB)
deriving instance Traversable (Color AdobeRGB)
deriving instance Storable e => Storable (Color AdobeRGB e)
instance Elevator e => Show (Color AdobeRGB e) where
showsPrec _ = showsColorModel
instance Elevator e => ColorModel AdobeRGB e where
type Components AdobeRGB e = (e, e, e)
toComponents = toComponents . unColorRGB
{-# INLINE toComponents #-}
fromComponents = mkColorRGB . fromComponents
{-# INLINE fromComponents #-}
instance Elevator e => ColorSpace AdobeRGB D65 e where
type BaseModel AdobeRGB = 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 AdobeRGB D65 where
gamut = primaries
npm = npmStandard
inpm = inpmStandard
ecctf = fmap transfer
{-# INLINE ecctf #-}
dcctf = fmap itransfer
{-# INLINE dcctf #-}
npmStandard :: RealFloat e => NPM AdobeRGB e
npmStandard = NPM $ M3x3 (V3 0.57667 0.18556 0.18823)
(V3 0.29734 0.62736 0.07529)
(V3 0.02703 0.07069 0.99134)
inpmStandard :: RealFloat e => INPM AdobeRGB e
inpmStandard = INPM $ M3x3 (V3 2.04159 -0.56501 -0.34473)
(V3 -0.96924 1.87597 0.04156)
(V3 0.01344 -0.11836 1.01517)
transfer :: Floating a => a -> a
transfer u = u ** (256 / 563)
{-# INLINE transfer #-}
itransfer :: Floating a => a -> a
itransfer u = u ** 2.19921875
{-# INLINE itransfer #-}
primaries :: RealFloat e => Gamut rgb i e
primaries = Gamut (Primary 0.64 0.33)
(Primary 0.21 0.71)
(Primary 0.15 0.06)