{-# 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.CIE1931.RGB
( CIERGB
, primaries
, castLinearity
, 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.Illuminant.CIE1931
data CIERGB (l :: Linearity)
newtype instance Color (CIERGB l) e = CIERGB (Color CM.RGB e)
deriving instance Eq e => Eq (Color (CIERGB l) e)
deriving instance Ord e => Ord (Color (CIERGB l) e)
deriving instance Functor (Color (CIERGB l))
deriving instance Applicative (Color (CIERGB l))
deriving instance Foldable (Color (CIERGB l))
deriving instance Traversable (Color (CIERGB l))
deriving instance Storable e => Storable (Color (CIERGB l) e)
instance (Typeable l, Elevator e) => Show (Color (CIERGB l) e) where
showsPrec _ = showsColorModel
instance (Typeable l, Elevator e) => ColorModel (CIERGB l) e where
type Components (CIERGB l) e = (e, e, e)
toComponents = toComponents . unColorRGB
{-# INLINE toComponents #-}
fromComponents = mkColorRGB . fromComponents
{-# INLINE fromComponents #-}
instance (Typeable l, Elevator e) => ColorSpace (CIERGB l) 'E e where
type BaseModel (CIERGB l) = CM.RGB
toBaseSpace = id
{-# INLINE toBaseSpace #-}
fromBaseSpace = id
{-# INLINE fromBaseSpace #-}
luminance = rgbLinearLuminance . castLinearity . fmap toRealFloat
{-# INLINE luminance #-}
toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity
{-# INLINE toColorXYZ #-}
fromColorXYZ xyz = castLinearity (fromRealFloat <$> (xyz2rgbLinear @CIERGB xyz))
{-# INLINE fromColorXYZ #-}
instance RedGreenBlue CIERGB 'E where
gamut = primaries
ecctf = coerce
{-# INLINE ecctf #-}
dcctf = coerce
{-# INLINE dcctf #-}
castLinearity :: Color (CIERGB l') e -> Color (CIERGB l) e
castLinearity = coerce
primaries :: RealFloat e => Gamut rgb i e
primaries = Gamut (Primary 0.734742840005998 0.265257159994002)
(Primary 0.273779033824958 0.717477700256116)
(Primary 0.166555629580280 0.008910726182545)