{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
-- |
-- Module      : Graphics.Color.Space.RGB.Internal
-- Copyright   : (c) Alexey Kuleshevich 2019-2025
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Space.RGB.Internal
  ( pattern ColorRGB
  , pattern ColorRGBA
  , RedGreenBlue(..)
  , Linearity(..)
  , ecctf
  , dcctf
  , Gamut(..)
  , coerceGamut
  , rgb2xyz
  , rgbLinear2xyz
  , xyz2rgb
  , xyz2rgbLinear
  , rgbLuminance
  , rgbLinearLuminance
  , rgbLinearGrayscale
  , rgbLinearApplyGrayscale
  , rgbNonLinearGrayscale
  , rgbNonLinearApplyGrayscale
  , NPM(..)
  , npmApply
  , npmDerive
  , INPM(..)
  , inpmApply
  , inpmDerive
  , rgbColorGamut
  , pixelWhitePoint
  , gamutWhitePoint
  , module Graphics.Color.Space.Internal
  ) where

import Data.Coerce
import Graphics.Color.Algebra
import qualified Graphics.Color.Model.RGB as CM
import Graphics.Color.Space.Internal
import Data.Kind

data Linearity = Linear | NonLinear

class Illuminant i => RedGreenBlue (cs :: Linearity -> Type) (i :: k) | cs -> i where
  -- | RGB primaries that are defined for the RGB color space, while point is defined by
  -- the __@i@__ type parameter
  gamut :: RealFloat e => Gamut cs i e

  -- | @since 0.3.0
  transfer :: RealFloat e => e -> e

  -- | @since 0.3.0
  itransfer :: RealFloat e => e -> e

  -- | Normalized primary matrix for this RGB color space. Default implementation derives
  -- it from `chromaticity`
  npm :: (ColorSpace (cs 'Linear) i e, RealFloat e) => NPM cs e
  npm = Gamut cs i e -> NPM cs e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(ColorSpace (cs 'Linear) i e, RealFloat e) =>
Gamut cs i e -> NPM cs e
npmDerive Gamut cs i e
forall e. RealFloat e => Gamut cs i e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Gamut cs i e
gamut
  {-# INLINE npm #-}

  -- | Inverse normalized primary matrix for this RGB color space. Default implementation
  -- derives it from `chromaticity`
  inpm :: (ColorSpace (cs 'Linear) i e, RealFloat e) => INPM cs e
  inpm = Gamut cs i e -> INPM cs e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(ColorSpace (cs 'Linear) i e, RealFloat e) =>
Gamut cs i e -> INPM cs e
inpmDerive Gamut cs i e
forall e. RealFloat e => Gamut cs i e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Gamut cs i e
gamut
  {-# INLINE inpm #-}

  -- | Lift RGB color model into a RGB color space
  mkColorRGB :: Color CM.RGB e -> Color (cs l) e
  default mkColorRGB ::
    Coercible (Color CM.RGB e) (Color (cs l) e) => Color CM.RGB e -> Color (cs l) e
  mkColorRGB = Color RGB e -> Color (cs l) e
forall a b. Coercible a b => a -> b
coerce

  -- | Drop RGB color space down to the RGB color model
  unColorRGB :: Color (cs l) e -> Color CM.RGB e
  default unColorRGB ::
    Coercible (Color (cs l) e) (Color CM.RGB e) => Color (cs l) e -> Color CM.RGB e
  unColorRGB = Color (cs l) e -> Color RGB e
forall a b. Coercible a b => a -> b
coerce

-- | This function allows for creating a completely mismatched color space spec. Make
-- sure you know what you are doing, if you need to use it.
--
-- @since 0.3.0
coerceGamut :: Gamut cs' i' e -> Gamut cs i e
coerceGamut :: forall {k} {k} (cs' :: Linearity -> *) (i' :: k) e
       (cs :: Linearity -> *) (i :: k).
Gamut cs' i' e -> Gamut cs i e
coerceGamut (Gamut Primary i' e
r Primary i' e
g Primary i' e
b) = Primary i e -> Primary i e -> Primary i e -> Gamut cs i e
forall {k} (cs :: Linearity -> *) (i :: k) e.
Primary i e -> Primary i e -> Primary i e -> Gamut cs i e
Gamut (Primary i' e -> Primary i e
forall a b. Coercible a b => a -> b
coerce Primary i' e
r) (Primary i' e -> Primary i e
forall a b. Coercible a b => a -> b
coerce Primary i' e
g) (Primary i' e -> Primary i e
forall a b. Coercible a b => a -> b
coerce Primary i' e
b)


-- | RGB color space gamut specification.
data Gamut (cs :: Linearity -> Type) i e = Gamut
  { forall {k} (cs :: Linearity -> *) (i :: k) e.
Gamut cs i e -> Primary i e
gamutRedPrimary   :: !(Primary i e)
  , forall {k} (cs :: Linearity -> *) (i :: k) e.
Gamut cs i e -> Primary i e
gamutGreenPrimary :: !(Primary i e)
  , forall {k} (cs :: Linearity -> *) (i :: k) e.
Gamut cs i e -> Primary i e
gamutBluePrimary  :: !(Primary i e)
  }
deriving instance Eq e => Eq (Gamut cs i e)

instance (RealFloat e, Elevator e, Illuminant i) => Show (Gamut cs i e) where
  show :: Gamut cs i e -> String
show Gamut {Primary i e
gamutRedPrimary :: forall {k} (cs :: Linearity -> *) (i :: k) e.
Gamut cs i e -> Primary i e
gamutGreenPrimary :: forall {k} (cs :: Linearity -> *) (i :: k) e.
Gamut cs i e -> Primary i e
gamutBluePrimary :: forall {k} (cs :: Linearity -> *) (i :: k) e.
Gamut cs i e -> Primary i e
gamutRedPrimary :: Primary i e
gamutGreenPrimary :: Primary i e
gamutBluePrimary :: Primary i e
..} =
    [String] -> String
unlines
      [ String
"Gamut:"
      , String
"  Red:   " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Chromaticity i e -> String
forall a. Show a => a -> String
show (Primary i e -> Chromaticity i e
forall k (i :: k) e. Primary i e -> Chromaticity i e
primaryChromaticity Primary i e
gamutRedPrimary)
      , String
"  Green: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Chromaticity i e -> String
forall a. Show a => a -> String
show (Primary i e -> Chromaticity i e
forall k (i :: k) e. Primary i e -> Chromaticity i e
primaryChromaticity Primary i e
gamutGreenPrimary)
      , String
"  Blue:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Chromaticity i e -> String
forall a. Show a => a -> String
show (Primary i e -> Chromaticity i e
forall k (i :: k) e. Primary i e -> Chromaticity i e
primaryChromaticity Primary i e
gamutBluePrimary)
      ]

-- | Get the `WhitePoint` of chromaticity. `Chromaticity` itself isn't actually evaluated,
-- its type carries enough information for this operation.
--
-- @since 0.1.0
gamutWhitePoint ::
     forall cs e i. (RedGreenBlue cs i, RealFloat e)
  => Gamut cs i e
  -> WhitePoint i e
gamutWhitePoint :: forall {k} (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Gamut cs i e -> WhitePoint i e
gamutWhitePoint Gamut cs i e
_ = WhitePoint i e
forall e. RealFloat e => WhitePoint i e
forall k (i :: k) e. (Illuminant i, RealFloat e) => WhitePoint i e
whitePoint
{-# INLINE gamutWhitePoint #-}


-- | Encoding color component transfer function (forward). Also known as opto-electronic
-- transfer function (OETF / OECF).
--
-- @since 0.1.0
ecctf ::
     forall cs e i. (RedGreenBlue cs i, RealFloat e)
  => Color (cs 'Linear) e
  -> Color (cs 'NonLinear) e
ecctf :: forall {k} (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'Linear) e -> Color (cs 'NonLinear) e
ecctf = 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 RGB e -> Color (cs 'NonLinear) e)
-> (Color (cs 'Linear) e -> Color RGB e)
-> Color (cs 'Linear) e
-> Color (cs 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> e) -> Color RGB e -> Color RGB e
forall a b. (a -> b) -> Color RGB a -> Color RGB b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
e -> e
transfer @_ @cs) (Color RGB e -> Color RGB e)
-> (Color (cs 'Linear) e -> Color RGB e)
-> Color (cs 'Linear) e
-> Color RGB e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'Linear) 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
{-# INLINE ecctf #-}

-- | Decoding color component transfer function (inverse).  Also known as electro-optical
-- transfer function (EOTF / EOCF).
--
-- @since 0.1.0
dcctf ::
     forall cs e i. (RedGreenBlue cs i, RealFloat e)
  => Color (cs 'NonLinear) e
  -> Color (cs 'Linear) e
dcctf :: forall {k} (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (cs 'Linear) e
dcctf = Color RGB e -> Color (cs 'Linear) 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 RGB e -> Color (cs 'Linear) e)
-> (Color (cs 'NonLinear) e -> Color RGB e)
-> Color (cs 'NonLinear) e
-> Color (cs 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> e) -> Color RGB e -> Color RGB e
forall a b. (a -> b) -> Color RGB a -> Color RGB b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
e -> e
itransfer @_ @cs) (Color RGB e -> Color RGB e)
-> (Color (cs 'NonLinear) e -> Color RGB e)
-> Color (cs 'NonLinear) e
-> Color RGB e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
{-# INLINE dcctf #-}


-- | Linear transformation of a pixel in a linear RGB color space into XYZ color space
--
-- ==== __Examples__
--
-- This example depicts the fact that even in @ghci@ when @npm@ is instantiated to a
-- concrete type, despite being derived it is memoized and gets computed only once.
--
-- >>> :set -XDataKinds
-- >>> import Debug.Trace
-- >>> import Graphics.Color.Illuminant.CIE1931
-- >>> import Graphics.Color.Space.RGB.Derived.SRGB
-- >>> :{
-- srgbFromLinear :: Color (SRGB 'D65 'Linear) Float -> Color (XYZ 'D65) Float
-- srgbFromLinear = npmApply npm'
--   where npm' = trace "Evaluated only once!!!" npm :: NPM (SRGB 'D65) Float
-- :}
--
-- >>> srgbFromLinear $ ColorRGB 0.1 0.2 0.3
-- <XYZ CIE1931 'D65:(Evaluated only once!!!
--  0.16688849, 0.18595251, 0.31085595)>
-- >>> srgbFromLinear $ ColorRGB 0.1 0.2 0.3
-- <XYZ CIE1931 'D65:( 0.16688849, 0.18595251, 0.31085595)>
-- >>> rgb = ColorRGB 0.1 0.2 0.3 :: Color (SRGB 'D65 'Linear) Float
-- >>> npmApply npm rgb :: Color (XYZ 'D65) Float
-- <XYZ CIE1931 'D65:( 0.16688849, 0.18595251, 0.31085595)>
--
-- Here is a comparison with a non-liner sRGB conversion:
--
-- >>> rgb = ColorRGB 0.1 0.2 0.3 :: Color (SRGB 'D65 'NonLinear) Float
-- >>> npmApply npm (dcctf rgb) :: Color (XYZ 'D65) Float {- non-linear transformation -}
-- <XYZ CIE1931 'D65:( 0.02918611, 0.03109305, 0.07373714)>
-- >>> toColorXYZ rgb :: Color (XYZ 'D65) Float           {- non-linear transformation -}
-- <XYZ CIE1931 'D65:( 0.02918611, 0.03109305, 0.07373714)>
--
--
-- @since 0.1.0
npmApply ::
     (RedGreenBlue cs i, Elevator e)
  => NPM cs e
  -> Color (cs 'Linear) e
  -> Color (XYZ i) e
npmApply :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, Elevator e) =>
NPM cs e -> Color (cs 'Linear) e -> Color (XYZ i) e
npmApply (NPM M3x3 e
npm') = V3 e -> Color (XYZ i) e
forall a b. Coercible a b => a -> b
coerce (V3 e -> Color (XYZ i) e)
-> (Color (cs 'Linear) e -> V3 e)
-> Color (cs 'Linear) e
-> Color (XYZ i) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M3x3 e -> V3 e -> V3 e
forall a. Num a => M3x3 a -> V3 a -> V3 a
multM3x3byV3 M3x3 e
npm' (V3 e -> V3 e)
-> (Color (cs 'Linear) e -> V3 e) -> Color (cs 'Linear) e -> V3 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color RGB e -> V3 e
forall a b. Coercible a b => a -> b
coerce (Color RGB e -> V3 e)
-> (Color (cs 'Linear) e -> Color RGB e)
-> Color (cs 'Linear) e
-> V3 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'Linear) 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
{-# INLINE npmApply #-}

-- | Linear transformation of a pixel in XYZ color space into a linear RGB color space
--
-- @since 0.1.0
inpmApply ::
     (RedGreenBlue cs i, Elevator e)
  => INPM cs e
  -> Color (XYZ i) e
  -> Color (cs 'Linear) e
inpmApply :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, Elevator e) =>
INPM cs e -> Color (XYZ i) e -> Color (cs 'Linear) e
inpmApply (INPM M3x3 e
inpm') = Color RGB e -> Color (cs 'Linear) 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 RGB e -> Color (cs 'Linear) e)
-> (Color (XYZ i) e -> Color RGB e)
-> Color (XYZ i) e
-> Color (cs 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 e -> Color RGB e
forall a b. Coercible a b => a -> b
coerce (V3 e -> Color RGB e)
-> (Color (XYZ i) e -> V3 e) -> Color (XYZ i) e -> Color RGB e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M3x3 e -> V3 e -> V3 e
forall a. Num a => M3x3 a -> V3 a -> V3 a
multM3x3byV3 M3x3 e
inpm' (V3 e -> V3 e)
-> (Color (XYZ i) e -> V3 e) -> Color (XYZ i) e -> V3 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (XYZ i) e -> V3 e
forall a b. Coercible a b => a -> b
coerce
{-# INLINE inpmApply #-}

-- | Linear transformation of a color into a linear luminance, i.e. the Y component of
-- XYZ color space
rgbLinearLuminance ::
     forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e)
  => Color (cs 'Linear) e
  -> Color (Y i) e
rgbLinearLuminance :: 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 (cs 'Linear) e
px =
  e -> Color (Y i) e
forall {k} e (i :: k). e -> Color (Y i) e
Y (M3x3 e -> V3 e
forall a. M3x3 a -> V3 a
m3x3row1 (NPM cs e -> M3x3 e
forall {k} (cs :: k) e. NPM cs e -> M3x3 e
unNPM (NPM cs e
forall e. (ColorSpace (cs 'Linear) i e, RealFloat e) => NPM cs e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
NPM cs e
npm :: NPM cs e)) V3 e -> V3 e -> e
forall a. Num a => V3 a -> V3 a -> a
`dotProduct` Color RGB e -> V3 e
forall a b. Coercible a b => a -> b
coerce (Color (cs 'Linear) 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 'Linear) e
px))
{-# INLINE rgbLinearLuminance #-}

rgbLinearGrayscale ::
     forall cs i e. (ColorSpace (cs 'Linear) i e)
  => Color (cs 'Linear) e
  -> Color X e
rgbLinearGrayscale :: forall {k} (cs :: Linearity -> *) (i :: k) e.
ColorSpace (cs 'Linear) i e =>
Color (cs 'Linear) e -> Color X e
rgbLinearGrayscale = e -> Color X e
forall e. e -> Color X e
ColorX (e -> Color X e)
-> (Color (cs 'Linear) e -> e) -> Color (cs 'Linear) e -> Color X e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> e
forall e. Elevator e => Double -> e
fromDouble (Double -> e)
-> (Color (cs 'Linear) e -> Double) -> Color (cs 'Linear) e -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y i) Double -> Double
forall {k} (i :: k) e. Color (Y i) e -> e
unY (Color (Y i) Double -> Double)
-> (Color (cs 'Linear) e -> Color (Y i) Double)
-> Color (cs 'Linear) e
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'Linear) e -> Color (Y i) Double
forall a.
(Elevator a, RealFloat a) =>
Color (cs 'Linear) 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
{-# INLINE rgbLinearGrayscale #-}


rgbLinearApplyGrayscale ::
     forall cs i e. (ColorSpace (cs 'Linear) i e)
  => Color (cs 'Linear) e
  -> (Color X e -> Color X e)
  -> Color (cs 'Linear) e
rgbLinearApplyGrayscale :: 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 Color (cs 'Linear) e
rgb Color X e -> Color X e
f =
  case Color (cs 'Linear) e -> Color (XYZ i) Double
forall a.
(Elevator a, RealFloat a) =>
Color (cs 'Linear) e -> Color (XYZ i) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (XYZ i) a
toColorXYZ Color (cs 'Linear) e
rgb of
    ColorXYZ Double
x Double
y Double
z ->
      Color (XYZ i) Double -> Color (cs 'Linear) e
forall a.
(Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color (cs 'Linear) e
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color cs e
fromColorXYZ (Double -> Double -> Double -> Color (XYZ i) Double
forall {k} e (i :: k). e -> e -> e -> Color (XYZ i) e
ColorXYZ Double
x (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
z)
{-# INLINE rgbLinearApplyGrayscale #-}


rgbNonLinearApplyGrayscale ::
     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
rgbNonLinearApplyGrayscale :: 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
rgbNonLinearApplyGrayscale Color (cs 'NonLinear) e
rgb Color X e -> Color X e
f =
  case Color (cs 'NonLinear) e -> Color (XYZ i) Double
forall a.
(Elevator a, RealFloat a) =>
Color (cs 'NonLinear) e -> Color (XYZ i) a
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (XYZ i) a
toColorXYZ Color (cs 'NonLinear) e
rgb of
    ColorXYZ Double
x Double
y Double
z ->
      let y' :: Double
y' = forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
e -> e
itransfer @_ @cs (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 (forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
e -> e
transfer @_ @cs Double
y)))) :: e))
      in Color (XYZ i) Double -> Color (cs 'NonLinear) e
forall a.
(Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color (cs 'NonLinear) e
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color cs e
fromColorXYZ (Double -> Double -> Double -> Color (XYZ i) Double
forall {k} e (i :: k). e -> e -> e -> Color (XYZ i) e
ColorXYZ Double
x Double
y' Double
z)
{-# INLINE rgbNonLinearApplyGrayscale #-}

rgbNonLinearGrayscale ::
     forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e)
  => Color (cs 'NonLinear) e
  -> Color X e
rgbNonLinearGrayscale :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e) =>
Color (cs 'NonLinear) e -> Color X e
rgbNonLinearGrayscale = e -> Color X e
forall e. e -> Color X e
ColorX (e -> Color X e)
-> (Color (cs 'NonLinear) e -> e)
-> Color (cs 'NonLinear) e
-> Color X e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> e
forall e. Elevator e => Double -> e
fromDouble (Double -> e)
-> (Color (cs 'NonLinear) e -> Double)
-> Color (cs 'NonLinear) e
-> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
e -> e
transfer @_ @cs) (Double -> Double)
-> (Color (cs 'NonLinear) e -> Double)
-> Color (cs 'NonLinear) e
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y i) Double -> Double
forall {k} (i :: k) e. Color (Y i) e -> e
unY (Color (Y i) Double -> Double)
-> (Color (cs 'NonLinear) e -> Color (Y i) Double)
-> Color (cs 'NonLinear) e
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'NonLinear) e -> Color (Y i) Double
forall a.
(Elevator a, RealFloat a) =>
Color (cs '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
{-# INLINE rgbNonLinearGrayscale #-}

rgbLuminance ::
     (RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e)
  => Color (cs 'NonLinear) e
  -> Color (Y i) e
rgbLuminance :: 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 (cs 'Linear) e -> Color (Y i) e
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 (cs 'Linear) e -> Color (Y i) e)
-> (Color (cs 'NonLinear) e -> Color (cs 'Linear) e)
-> Color (cs 'NonLinear) e
-> Color (Y i) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'NonLinear) e -> Color (cs 'Linear) e
forall {k} (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (cs 'Linear) e
dcctf
{-# INLINE rgbLuminance #-}

rgb2xyz ::
     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)
  => Color (cs 'NonLinear) e
  -> Color (XYZ i) e
rgb2xyz :: 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 = NPM cs e -> Color (cs 'Linear) e -> Color (XYZ i) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, Elevator e) =>
NPM cs e -> Color (cs 'Linear) e -> Color (XYZ i) e
npmApply NPM cs e
forall e. (ColorSpace (cs 'Linear) i e, RealFloat e) => NPM cs e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
NPM cs e
npm (Color (cs 'Linear) e -> Color (XYZ i) e)
-> (Color (cs 'NonLinear) e -> Color (cs 'Linear) e)
-> Color (cs 'NonLinear) e
-> Color (XYZ i) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'NonLinear) e -> Color (cs 'Linear) e
forall {k} (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (cs 'Linear) e
dcctf
{-# INLINE rgb2xyz #-}

xyz2rgb ::
     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)
  => Color (XYZ i) e
  -> Color (cs 'NonLinear) e
xyz2rgb :: 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 = Color (cs 'Linear) e -> Color (cs 'NonLinear) e
forall {k} (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'Linear) e -> Color (cs 'NonLinear) e
ecctf (Color (cs 'Linear) e -> Color (cs 'NonLinear) e)
-> (Color (XYZ i) e -> Color (cs 'Linear) e)
-> Color (XYZ i) e
-> Color (cs 'NonLinear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. INPM cs e -> Color (XYZ i) e -> Color (cs 'Linear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, Elevator e) =>
INPM cs e -> Color (XYZ i) e -> Color (cs 'Linear) e
inpmApply INPM cs e
forall e. (ColorSpace (cs 'Linear) i e, RealFloat e) => INPM cs e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
INPM cs e
inpm
{-# INLINE xyz2rgb #-}


rgbLinear2xyz ::
     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)
  => Color (cs 'Linear) e
  -> Color (XYZ i) e
rgbLinear2xyz :: 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 = NPM cs e -> Color (cs 'Linear) e -> Color (XYZ i) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, Elevator e) =>
NPM cs e -> Color (cs 'Linear) e -> Color (XYZ i) e
npmApply NPM cs e
forall e. (ColorSpace (cs 'Linear) i e, RealFloat e) => NPM cs e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
NPM cs e
npm
{-# INLINE rgbLinear2xyz #-}

xyz2rgbLinear ::
     forall cs i 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 :: 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 = INPM cs e -> Color (XYZ i) e -> Color (cs 'Linear) e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, Elevator e) =>
INPM cs e -> Color (XYZ i) e -> Color (cs 'Linear) e
inpmApply INPM cs e
forall e. (ColorSpace (cs 'Linear) i e, RealFloat e) => INPM cs e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e) =>
INPM cs e
inpm
{-# INLINE xyz2rgbLinear #-}

-- | Constructor for an RGB color space.
pattern ColorRGB :: RedGreenBlue cs i => e -> e -> e -> Color (cs l) e
pattern $mColorRGB :: forall {r} {k} {cs :: Linearity -> *} {i :: k} {e}
       {l :: Linearity}.
RedGreenBlue cs i =>
Color (cs l) e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bColorRGB :: forall {k} (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
e -> e -> e -> Color (cs l) e
ColorRGB r g b <- (unColorRGB -> CM.ColorRGB r g b) where
        ColorRGB e
r e
g e
b = Color RGB e -> Color (cs l) 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)
{-# COMPLETE ColorRGB #-}

-- | Constructor for an RGB color space with Alpha channel
pattern ColorRGBA :: RedGreenBlue cs i => e -> e -> e -> e -> Color (Alpha (cs l)) e
pattern $mColorRGBA :: forall {r} {k} {cs :: Linearity -> *} {i :: k} {e}
       {l :: Linearity}.
RedGreenBlue cs i =>
Color (Alpha (cs l)) e
-> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bColorRGBA :: forall {k} (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
e -> e -> e -> e -> Color (Alpha (cs l)) e
ColorRGBA r g b a <- Alpha (unColorRGB -> CM.ColorRGB r g b) a where
        ColorRGBA e
r e
g e
b e
a = Color (cs l) e -> e -> Color (Alpha (cs l)) e
forall cs e. Color cs e -> e -> Color (Alpha cs) e
Alpha (Color RGB e -> Color (cs l) 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)) e
a
{-# COMPLETE ColorRGBA #-}


-- newtype ConversionMatrix cs' cs = ConversionMatrix M3x3

-- conversionMatrix ::
--      forall cs' i' cs i. (RedGreenBlue cs' i', RedGreenBlue cs i)
--   => ConversionMatrix (cs' i') (cs i)
-- conversionMatrix =
--   ConversionMatrix $ multM3x3byM3x3 (unINPM (inpm :: INPM cs i)) (unNPM (npm :: NPM cs' i'))

-- makeConversionMatrix ::
--      forall cta cs' i' cs i. (RedGreenBlue cs' i', RedGreenBlue cs i)
--   => cta -> ConversionMatrix (cs' i') (cs i)
-- makeConversionMatrix _cta =
--   ConversionMatrix $ multM3x3byM3x3 (unINPM (inpm :: INPM cs i)) (unNPM (npm :: NPM cs' i'))


-- applyConversionMatrix ::
--      (RedGreenBlue cs1 i1, RedGreenBlue cs2 i2, Elevator e2, Elevator e1)
--   => ConversionMatrix (cs1 i1) (cs2 i2)
--   -> Color (cs1 i1) e1
--   -> Color (cs2 i2) e2
-- applyConversionMatrix (ConversionMatrix m) px =
--   mkColorRGB $ fromV3 CM.ColorRGB $ multM3x3byV3 m (toV3 r g b)
--   where
--     CM.ColorRGB r g b = unColorRGB px

-- | Normalized primary matrix (NPM), which is used to tranform linear RGB color space
-- into `Graphics.Color.Space.CIE1931.XYZ.XYZ` color space.
--
-- @since 0.1.0
newtype NPM cs e = NPM
  { forall {k} (cs :: k) e. NPM cs e -> M3x3 e
unNPM :: M3x3 e
  } deriving (NPM cs e -> NPM cs e -> Bool
(NPM cs e -> NPM cs e -> Bool)
-> (NPM cs e -> NPM cs e -> Bool) -> Eq (NPM cs e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (cs :: k) e. Eq e => NPM cs e -> NPM cs e -> Bool
$c== :: forall k (cs :: k) e. Eq e => NPM cs e -> NPM cs e -> Bool
== :: NPM cs e -> NPM cs e -> Bool
$c/= :: forall k (cs :: k) e. Eq e => NPM cs e -> NPM cs e -> Bool
/= :: NPM cs e -> NPM cs e -> Bool
Eq, (forall a b. (a -> b) -> NPM cs a -> NPM cs b)
-> (forall a b. a -> NPM cs b -> NPM cs a) -> Functor (NPM cs)
forall k (cs :: k) a b. a -> NPM cs b -> NPM cs a
forall k (cs :: k) a b. (a -> b) -> NPM cs a -> NPM cs b
forall a b. a -> NPM cs b -> NPM cs a
forall a b. (a -> b) -> NPM cs a -> NPM cs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (cs :: k) a b. (a -> b) -> NPM cs a -> NPM cs b
fmap :: forall a b. (a -> b) -> NPM cs a -> NPM cs b
$c<$ :: forall k (cs :: k) a b. a -> NPM cs b -> NPM cs a
<$ :: forall a b. a -> NPM cs b -> NPM cs a
Functor, Functor (NPM cs)
Functor (NPM cs) =>
(forall a. a -> NPM cs a)
-> (forall a b. NPM cs (a -> b) -> NPM cs a -> NPM cs b)
-> (forall a b c.
    (a -> b -> c) -> NPM cs a -> NPM cs b -> NPM cs c)
-> (forall a b. NPM cs a -> NPM cs b -> NPM cs b)
-> (forall a b. NPM cs a -> NPM cs b -> NPM cs a)
-> Applicative (NPM cs)
forall a. a -> NPM cs a
forall k (cs :: k). Functor (NPM cs)
forall k (cs :: k) a. a -> NPM cs a
forall k (cs :: k) a b. NPM cs a -> NPM cs b -> NPM cs a
forall k (cs :: k) a b. NPM cs a -> NPM cs b -> NPM cs b
forall k (cs :: k) a b. NPM cs (a -> b) -> NPM cs a -> NPM cs b
forall k (cs :: k) a b c.
(a -> b -> c) -> NPM cs a -> NPM cs b -> NPM cs c
forall a b. NPM cs a -> NPM cs b -> NPM cs a
forall a b. NPM cs a -> NPM cs b -> NPM cs b
forall a b. NPM cs (a -> b) -> NPM cs a -> NPM cs b
forall a b c. (a -> b -> c) -> NPM cs a -> NPM cs b -> NPM cs c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall k (cs :: k) a. a -> NPM cs a
pure :: forall a. a -> NPM cs a
$c<*> :: forall k (cs :: k) a b. NPM cs (a -> b) -> NPM cs a -> NPM cs b
<*> :: forall a b. NPM cs (a -> b) -> NPM cs a -> NPM cs b
$cliftA2 :: forall k (cs :: k) a b c.
(a -> b -> c) -> NPM cs a -> NPM cs b -> NPM cs c
liftA2 :: forall a b c. (a -> b -> c) -> NPM cs a -> NPM cs b -> NPM cs c
$c*> :: forall k (cs :: k) a b. NPM cs a -> NPM cs b -> NPM cs b
*> :: forall a b. NPM cs a -> NPM cs b -> NPM cs b
$c<* :: forall k (cs :: k) a b. NPM cs a -> NPM cs b -> NPM cs a
<* :: forall a b. NPM cs a -> NPM cs b -> NPM cs a
Applicative, (forall m. Monoid m => NPM cs m -> m)
-> (forall m a. Monoid m => (a -> m) -> NPM cs a -> m)
-> (forall m a. Monoid m => (a -> m) -> NPM cs a -> m)
-> (forall a b. (a -> b -> b) -> b -> NPM cs a -> b)
-> (forall a b. (a -> b -> b) -> b -> NPM cs a -> b)
-> (forall b a. (b -> a -> b) -> b -> NPM cs a -> b)
-> (forall b a. (b -> a -> b) -> b -> NPM cs a -> b)
-> (forall a. (a -> a -> a) -> NPM cs a -> a)
-> (forall a. (a -> a -> a) -> NPM cs a -> a)
-> (forall a. NPM cs a -> [a])
-> (forall a. NPM cs a -> Bool)
-> (forall a. NPM cs a -> Int)
-> (forall a. Eq a => a -> NPM cs a -> Bool)
-> (forall a. Ord a => NPM cs a -> a)
-> (forall a. Ord a => NPM cs a -> a)
-> (forall a. Num a => NPM cs a -> a)
-> (forall a. Num a => NPM cs a -> a)
-> Foldable (NPM cs)
forall a. Eq a => a -> NPM cs a -> Bool
forall a. Num a => NPM cs a -> a
forall a. Ord a => NPM cs a -> a
forall m. Monoid m => NPM cs m -> m
forall a. NPM cs a -> Bool
forall a. NPM cs a -> Int
forall a. NPM cs a -> [a]
forall a. (a -> a -> a) -> NPM cs a -> a
forall k (cs :: k) a. Eq a => a -> NPM cs a -> Bool
forall k (cs :: k) a. Num a => NPM cs a -> a
forall k (cs :: k) a. Ord a => NPM cs a -> a
forall k (cs :: k) m. Monoid m => NPM cs m -> m
forall k (cs :: k) a. NPM cs a -> Bool
forall k (cs :: k) a. NPM cs a -> Int
forall k (cs :: k) a. NPM cs a -> [a]
forall k (cs :: k) a. (a -> a -> a) -> NPM cs a -> a
forall k (cs :: k) m a. Monoid m => (a -> m) -> NPM cs a -> m
forall k (cs :: k) b a. (b -> a -> b) -> b -> NPM cs a -> b
forall k (cs :: k) a b. (a -> b -> b) -> b -> NPM cs a -> b
forall m a. Monoid m => (a -> m) -> NPM cs a -> m
forall b a. (b -> a -> b) -> b -> NPM cs a -> b
forall a b. (a -> b -> b) -> b -> NPM cs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall k (cs :: k) m. Monoid m => NPM cs m -> m
fold :: forall m. Monoid m => NPM cs m -> m
$cfoldMap :: forall k (cs :: k) m a. Monoid m => (a -> m) -> NPM cs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NPM cs a -> m
$cfoldMap' :: forall k (cs :: k) m a. Monoid m => (a -> m) -> NPM cs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NPM cs a -> m
$cfoldr :: forall k (cs :: k) a b. (a -> b -> b) -> b -> NPM cs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NPM cs a -> b
$cfoldr' :: forall k (cs :: k) a b. (a -> b -> b) -> b -> NPM cs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NPM cs a -> b
$cfoldl :: forall k (cs :: k) b a. (b -> a -> b) -> b -> NPM cs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NPM cs a -> b
$cfoldl' :: forall k (cs :: k) b a. (b -> a -> b) -> b -> NPM cs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NPM cs a -> b
$cfoldr1 :: forall k (cs :: k) a. (a -> a -> a) -> NPM cs a -> a
foldr1 :: forall a. (a -> a -> a) -> NPM cs a -> a
$cfoldl1 :: forall k (cs :: k) a. (a -> a -> a) -> NPM cs a -> a
foldl1 :: forall a. (a -> a -> a) -> NPM cs a -> a
$ctoList :: forall k (cs :: k) a. NPM cs a -> [a]
toList :: forall a. NPM cs a -> [a]
$cnull :: forall k (cs :: k) a. NPM cs a -> Bool
null :: forall a. NPM cs a -> Bool
$clength :: forall k (cs :: k) a. NPM cs a -> Int
length :: forall a. NPM cs a -> Int
$celem :: forall k (cs :: k) a. Eq a => a -> NPM cs a -> Bool
elem :: forall a. Eq a => a -> NPM cs a -> Bool
$cmaximum :: forall k (cs :: k) a. Ord a => NPM cs a -> a
maximum :: forall a. Ord a => NPM cs a -> a
$cminimum :: forall k (cs :: k) a. Ord a => NPM cs a -> a
minimum :: forall a. Ord a => NPM cs a -> a
$csum :: forall k (cs :: k) a. Num a => NPM cs a -> a
sum :: forall a. Num a => NPM cs a -> a
$cproduct :: forall k (cs :: k) a. Num a => NPM cs a -> a
product :: forall a. Num a => NPM cs a -> a
Foldable, Functor (NPM cs)
Foldable (NPM cs)
(Functor (NPM cs), Foldable (NPM cs)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> NPM cs a -> f (NPM cs b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NPM cs (f a) -> f (NPM cs a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NPM cs a -> m (NPM cs b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NPM cs (m a) -> m (NPM cs a))
-> Traversable (NPM cs)
forall k (cs :: k). Functor (NPM cs)
forall k (cs :: k). Foldable (NPM cs)
forall k (cs :: k) (m :: * -> *) a.
Monad m =>
NPM cs (m a) -> m (NPM cs a)
forall k (cs :: k) (f :: * -> *) a.
Applicative f =>
NPM cs (f a) -> f (NPM cs a)
forall k (cs :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NPM cs a -> m (NPM cs b)
forall k (cs :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NPM cs a -> f (NPM cs b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NPM cs (m a) -> m (NPM cs a)
forall (f :: * -> *) a.
Applicative f =>
NPM cs (f a) -> f (NPM cs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NPM cs a -> m (NPM cs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NPM cs a -> f (NPM cs b)
$ctraverse :: forall k (cs :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NPM cs a -> f (NPM cs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NPM cs a -> f (NPM cs b)
$csequenceA :: forall k (cs :: k) (f :: * -> *) a.
Applicative f =>
NPM cs (f a) -> f (NPM cs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NPM cs (f a) -> f (NPM cs a)
$cmapM :: forall k (cs :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NPM cs a -> m (NPM cs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NPM cs a -> m (NPM cs b)
$csequence :: forall k (cs :: k) (m :: * -> *) a.
Monad m =>
NPM cs (m a) -> m (NPM cs a)
sequence :: forall (m :: * -> *) a. Monad m => NPM cs (m a) -> m (NPM cs a)
Traversable)

instance Elevator e => Show (NPM cs e) where
  show :: NPM cs e -> String
show = M3x3 e -> String
forall a. Show a => a -> String
show (M3x3 e -> String) -> (NPM cs e -> M3x3 e) -> NPM cs e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPM cs e -> M3x3 e
forall {k} (cs :: k) e. NPM cs e -> M3x3 e
unNPM

-- | Inverse normalized primary matrix (iNPM), which is used to tranform linear
-- `Graphics.Color.Space.CIE1931.XYZ.XYZ` color space into a linear RGB color space. It is
-- literally a inverse matrix of `NPM`
--
-- @since 0.1.0
newtype INPM cs e = INPM
  { forall {k} (cs :: k) e. INPM cs e -> M3x3 e
unINPM :: M3x3 e
  } deriving (INPM cs e -> INPM cs e -> Bool
(INPM cs e -> INPM cs e -> Bool)
-> (INPM cs e -> INPM cs e -> Bool) -> Eq (INPM cs e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (cs :: k) e. Eq e => INPM cs e -> INPM cs e -> Bool
$c== :: forall k (cs :: k) e. Eq e => INPM cs e -> INPM cs e -> Bool
== :: INPM cs e -> INPM cs e -> Bool
$c/= :: forall k (cs :: k) e. Eq e => INPM cs e -> INPM cs e -> Bool
/= :: INPM cs e -> INPM cs e -> Bool
Eq, (forall a b. (a -> b) -> INPM cs a -> INPM cs b)
-> (forall a b. a -> INPM cs b -> INPM cs a) -> Functor (INPM cs)
forall k (cs :: k) a b. a -> INPM cs b -> INPM cs a
forall k (cs :: k) a b. (a -> b) -> INPM cs a -> INPM cs b
forall a b. a -> INPM cs b -> INPM cs a
forall a b. (a -> b) -> INPM cs a -> INPM cs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (cs :: k) a b. (a -> b) -> INPM cs a -> INPM cs b
fmap :: forall a b. (a -> b) -> INPM cs a -> INPM cs b
$c<$ :: forall k (cs :: k) a b. a -> INPM cs b -> INPM cs a
<$ :: forall a b. a -> INPM cs b -> INPM cs a
Functor, Functor (INPM cs)
Functor (INPM cs) =>
(forall a. a -> INPM cs a)
-> (forall a b. INPM cs (a -> b) -> INPM cs a -> INPM cs b)
-> (forall a b c.
    (a -> b -> c) -> INPM cs a -> INPM cs b -> INPM cs c)
-> (forall a b. INPM cs a -> INPM cs b -> INPM cs b)
-> (forall a b. INPM cs a -> INPM cs b -> INPM cs a)
-> Applicative (INPM cs)
forall a. a -> INPM cs a
forall k (cs :: k). Functor (INPM cs)
forall k (cs :: k) a. a -> INPM cs a
forall k (cs :: k) a b. INPM cs a -> INPM cs b -> INPM cs a
forall k (cs :: k) a b. INPM cs a -> INPM cs b -> INPM cs b
forall k (cs :: k) a b. INPM cs (a -> b) -> INPM cs a -> INPM cs b
forall k (cs :: k) a b c.
(a -> b -> c) -> INPM cs a -> INPM cs b -> INPM cs c
forall a b. INPM cs a -> INPM cs b -> INPM cs a
forall a b. INPM cs a -> INPM cs b -> INPM cs b
forall a b. INPM cs (a -> b) -> INPM cs a -> INPM cs b
forall a b c. (a -> b -> c) -> INPM cs a -> INPM cs b -> INPM cs c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall k (cs :: k) a. a -> INPM cs a
pure :: forall a. a -> INPM cs a
$c<*> :: forall k (cs :: k) a b. INPM cs (a -> b) -> INPM cs a -> INPM cs b
<*> :: forall a b. INPM cs (a -> b) -> INPM cs a -> INPM cs b
$cliftA2 :: forall k (cs :: k) a b c.
(a -> b -> c) -> INPM cs a -> INPM cs b -> INPM cs c
liftA2 :: forall a b c. (a -> b -> c) -> INPM cs a -> INPM cs b -> INPM cs c
$c*> :: forall k (cs :: k) a b. INPM cs a -> INPM cs b -> INPM cs b
*> :: forall a b. INPM cs a -> INPM cs b -> INPM cs b
$c<* :: forall k (cs :: k) a b. INPM cs a -> INPM cs b -> INPM cs a
<* :: forall a b. INPM cs a -> INPM cs b -> INPM cs a
Applicative, (forall m. Monoid m => INPM cs m -> m)
-> (forall m a. Monoid m => (a -> m) -> INPM cs a -> m)
-> (forall m a. Monoid m => (a -> m) -> INPM cs a -> m)
-> (forall a b. (a -> b -> b) -> b -> INPM cs a -> b)
-> (forall a b. (a -> b -> b) -> b -> INPM cs a -> b)
-> (forall b a. (b -> a -> b) -> b -> INPM cs a -> b)
-> (forall b a. (b -> a -> b) -> b -> INPM cs a -> b)
-> (forall a. (a -> a -> a) -> INPM cs a -> a)
-> (forall a. (a -> a -> a) -> INPM cs a -> a)
-> (forall a. INPM cs a -> [a])
-> (forall a. INPM cs a -> Bool)
-> (forall a. INPM cs a -> Int)
-> (forall a. Eq a => a -> INPM cs a -> Bool)
-> (forall a. Ord a => INPM cs a -> a)
-> (forall a. Ord a => INPM cs a -> a)
-> (forall a. Num a => INPM cs a -> a)
-> (forall a. Num a => INPM cs a -> a)
-> Foldable (INPM cs)
forall a. Eq a => a -> INPM cs a -> Bool
forall a. Num a => INPM cs a -> a
forall a. Ord a => INPM cs a -> a
forall m. Monoid m => INPM cs m -> m
forall a. INPM cs a -> Bool
forall a. INPM cs a -> Int
forall a. INPM cs a -> [a]
forall a. (a -> a -> a) -> INPM cs a -> a
forall k (cs :: k) a. Eq a => a -> INPM cs a -> Bool
forall k (cs :: k) a. Num a => INPM cs a -> a
forall k (cs :: k) a. Ord a => INPM cs a -> a
forall k (cs :: k) m. Monoid m => INPM cs m -> m
forall k (cs :: k) a. INPM cs a -> Bool
forall k (cs :: k) a. INPM cs a -> Int
forall k (cs :: k) a. INPM cs a -> [a]
forall k (cs :: k) a. (a -> a -> a) -> INPM cs a -> a
forall k (cs :: k) m a. Monoid m => (a -> m) -> INPM cs a -> m
forall k (cs :: k) b a. (b -> a -> b) -> b -> INPM cs a -> b
forall k (cs :: k) a b. (a -> b -> b) -> b -> INPM cs a -> b
forall m a. Monoid m => (a -> m) -> INPM cs a -> m
forall b a. (b -> a -> b) -> b -> INPM cs a -> b
forall a b. (a -> b -> b) -> b -> INPM cs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall k (cs :: k) m. Monoid m => INPM cs m -> m
fold :: forall m. Monoid m => INPM cs m -> m
$cfoldMap :: forall k (cs :: k) m a. Monoid m => (a -> m) -> INPM cs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> INPM cs a -> m
$cfoldMap' :: forall k (cs :: k) m a. Monoid m => (a -> m) -> INPM cs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> INPM cs a -> m
$cfoldr :: forall k (cs :: k) a b. (a -> b -> b) -> b -> INPM cs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> INPM cs a -> b
$cfoldr' :: forall k (cs :: k) a b. (a -> b -> b) -> b -> INPM cs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> INPM cs a -> b
$cfoldl :: forall k (cs :: k) b a. (b -> a -> b) -> b -> INPM cs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> INPM cs a -> b
$cfoldl' :: forall k (cs :: k) b a. (b -> a -> b) -> b -> INPM cs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> INPM cs a -> b
$cfoldr1 :: forall k (cs :: k) a. (a -> a -> a) -> INPM cs a -> a
foldr1 :: forall a. (a -> a -> a) -> INPM cs a -> a
$cfoldl1 :: forall k (cs :: k) a. (a -> a -> a) -> INPM cs a -> a
foldl1 :: forall a. (a -> a -> a) -> INPM cs a -> a
$ctoList :: forall k (cs :: k) a. INPM cs a -> [a]
toList :: forall a. INPM cs a -> [a]
$cnull :: forall k (cs :: k) a. INPM cs a -> Bool
null :: forall a. INPM cs a -> Bool
$clength :: forall k (cs :: k) a. INPM cs a -> Int
length :: forall a. INPM cs a -> Int
$celem :: forall k (cs :: k) a. Eq a => a -> INPM cs a -> Bool
elem :: forall a. Eq a => a -> INPM cs a -> Bool
$cmaximum :: forall k (cs :: k) a. Ord a => INPM cs a -> a
maximum :: forall a. Ord a => INPM cs a -> a
$cminimum :: forall k (cs :: k) a. Ord a => INPM cs a -> a
minimum :: forall a. Ord a => INPM cs a -> a
$csum :: forall k (cs :: k) a. Num a => INPM cs a -> a
sum :: forall a. Num a => INPM cs a -> a
$cproduct :: forall k (cs :: k) a. Num a => INPM cs a -> a
product :: forall a. Num a => INPM cs a -> a
Foldable, Functor (INPM cs)
Foldable (INPM cs)
(Functor (INPM cs), Foldable (INPM cs)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> INPM cs a -> f (INPM cs b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    INPM cs (f a) -> f (INPM cs a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> INPM cs a -> m (INPM cs b))
-> (forall (m :: * -> *) a.
    Monad m =>
    INPM cs (m a) -> m (INPM cs a))
-> Traversable (INPM cs)
forall k (cs :: k). Functor (INPM cs)
forall k (cs :: k). Foldable (INPM cs)
forall k (cs :: k) (m :: * -> *) a.
Monad m =>
INPM cs (m a) -> m (INPM cs a)
forall k (cs :: k) (f :: * -> *) a.
Applicative f =>
INPM cs (f a) -> f (INPM cs a)
forall k (cs :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> INPM cs a -> m (INPM cs b)
forall k (cs :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> INPM cs a -> f (INPM cs b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => INPM cs (m a) -> m (INPM cs a)
forall (f :: * -> *) a.
Applicative f =>
INPM cs (f a) -> f (INPM cs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> INPM cs a -> m (INPM cs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> INPM cs a -> f (INPM cs b)
$ctraverse :: forall k (cs :: k) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> INPM cs a -> f (INPM cs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> INPM cs a -> f (INPM cs b)
$csequenceA :: forall k (cs :: k) (f :: * -> *) a.
Applicative f =>
INPM cs (f a) -> f (INPM cs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
INPM cs (f a) -> f (INPM cs a)
$cmapM :: forall k (cs :: k) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> INPM cs a -> m (INPM cs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> INPM cs a -> m (INPM cs b)
$csequence :: forall k (cs :: k) (m :: * -> *) a.
Monad m =>
INPM cs (m a) -> m (INPM cs a)
sequence :: forall (m :: * -> *) a. Monad m => INPM cs (m a) -> m (INPM cs a)
Traversable)

instance Elevator e => Show (INPM cs e) where
  show :: INPM cs e -> String
show = M3x3 e -> String
forall a. Show a => a -> String
show (M3x3 e -> String) -> (INPM cs e -> M3x3 e) -> INPM cs e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. INPM cs e -> M3x3 e
forall {k} (cs :: k) e. INPM cs e -> M3x3 e
unINPM


-- | Derive a `NPM` form chromaticities and a white point
--
-- @since 0.1.0
npmDerive ::
     forall cs i e. (ColorSpace (cs 'Linear) i e, RealFloat e)
  => Gamut cs i e
  -> NPM cs e
npmDerive :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(ColorSpace (cs 'Linear) i e, RealFloat e) =>
Gamut cs i e -> NPM cs e
npmDerive (Gamut Primary i e
r Primary i e
g Primary i e
b) = M3x3 e -> NPM cs e
forall {k} (cs :: k) e. M3x3 e -> NPM cs e
NPM (M3x3 e
primaries' M3x3 e -> M3x3 e -> M3x3 e
forall a. Num a => a -> a -> a
* V3 e -> V3 e -> V3 e -> M3x3 e
forall a. V3 a -> V3 a -> V3 a -> M3x3 a
M3x3 V3 e
coeff V3 e
coeff V3 e
coeff)
  where
    !primaries' :: M3x3 e
primaries' =
      e -> e
forall a. (Elevator a, RealFloat a) => e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat (e -> e) -> M3x3 e -> M3x3 e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      -- transposed matrix with xyz primaries
      V3 e -> V3 e -> V3 e -> M3x3 e
forall a. V3 a -> V3 a -> V3 a -> M3x3 a
M3x3
        (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 (Primary i e -> e
forall {k} (i :: k) e. Primary i e -> e
xPrimary Primary i e
r) (Primary i e -> e
forall {k} (i :: k) e. Primary i e -> e
xPrimary Primary i e
g) (Primary i e -> e
forall {k} (i :: k) e. Primary i e -> e
xPrimary Primary i e
b))
        (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 (Primary i e -> e
forall {k} (i :: k) e. Primary i e -> e
yPrimary Primary i e
r) (Primary i e -> e
forall {k} (i :: k) e. Primary i e -> e
yPrimary Primary i e
g) (Primary i e -> e
forall {k} (i :: k) e. Primary i e -> e
yPrimary Primary i e
b))
        (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 (Primary i e -> e
forall {k} e (i :: k). Num e => Primary i e -> e
zPrimary Primary i e
r) (Primary i e -> e
forall {k} e (i :: k). Num e => Primary i e -> e
zPrimary Primary i e
g) (Primary i e -> e
forall {k} e (i :: k). Num e => Primary i e -> e
zPrimary Primary i e
b))
    !coeff :: V3 e
coeff = M3x3 e -> M3x3 e
forall a. Fractional a => M3x3 a -> M3x3 a
invertM3x3 M3x3 e
primaries' M3x3 e -> V3 e -> V3 e
forall a. Num a => M3x3 a -> V3 a -> V3 a
`multM3x3byV3` Color (XYZ i) e -> V3 e
forall a b. Coercible a b => a -> b
coerce (Color (XYZ i) e
forall {k} (i :: k) e.
(Illuminant i, RealFloat e, Elevator e) =>
Color (XYZ i) e
whitePointTristimulus :: Color (XYZ i) e)
{-# INLINE npmDerive #-}

-- | Derive an `INPM` form chromaticities and a white point
--
-- @since 0.1.0
inpmDerive ::
     forall cs i e. (ColorSpace (cs 'Linear) i e, RealFloat e)
  => Gamut cs i e
  -> INPM cs e
inpmDerive :: forall {k} (cs :: Linearity -> *) (i :: k) e.
(ColorSpace (cs 'Linear) i e, RealFloat e) =>
Gamut cs i e -> INPM cs e
inpmDerive = M3x3 e -> INPM cs e
forall {k} (cs :: k) e. M3x3 e -> INPM cs e
INPM (M3x3 e -> INPM cs e)
-> (Gamut cs i e -> M3x3 e) -> Gamut cs i e -> INPM cs e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M3x3 e -> M3x3 e
forall a. Fractional a => M3x3 a -> M3x3 a
invertM3x3 (M3x3 e -> M3x3 e)
-> (Gamut cs i e -> M3x3 e) -> Gamut cs i e -> M3x3 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPM cs e -> M3x3 e
forall {k} (cs :: k) e. NPM cs e -> M3x3 e
unNPM (NPM cs e -> M3x3 e)
-> (Gamut cs i e -> NPM cs e) -> Gamut cs i e -> M3x3 e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gamut cs i e -> NPM cs e
forall {k} (cs :: Linearity -> *) (i :: k) e.
(ColorSpace (cs 'Linear) i e, RealFloat e) =>
Gamut cs i e -> NPM cs e
npmDerive
{-# INLINE inpmDerive #-}



-- | Get the `Chromaticity` of a pixel in RGB color space. Color itself isn't actually
-- evaluated, its type carries enough information for this operation.
--
-- @since 0.1.0
rgbColorGamut :: (RedGreenBlue cs i, RealFloat e) => Color (cs l) a -> Gamut cs i e
rgbColorGamut :: forall {k} (cs :: Linearity -> *) (i :: k) e (l :: Linearity) a.
(RedGreenBlue cs i, RealFloat e) =>
Color (cs l) a -> Gamut cs i e
rgbColorGamut Color (cs l) a
_ = Gamut cs i e
forall e. RealFloat e => Gamut cs i e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
Gamut cs i e
gamut
{-# INLINE rgbColorGamut #-}


-- | Get the white point of any RGB pixel. Color itself isn't evaluated, since its type
-- carries enough information for getting the white point.
--
-- >>> import Graphics.Color.Space.RGB
-- >>> :set -XTypeApplications
-- >>> pixelWhitePoint @Float (ColorSRGB @Word8 1 2 3)
-- WhitePoint (Chromaticity {chromaticityCIExyY = <CIExyY * D65:( 0.31270000, 0.32900000)>})
--
-- @since 0.1.0
pixelWhitePoint ::
     forall e cs a i l. (RedGreenBlue cs i, RealFloat e)
  => Color (cs l) a
  -> WhitePoint i e
pixelWhitePoint :: forall {k} e (cs :: Linearity -> *) a (i :: k) (l :: Linearity).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs l) a -> WhitePoint i e
pixelWhitePoint Color (cs l) a
_ = WhitePoint i e
forall e. RealFloat e => WhitePoint i e
forall k (i :: k) e. (Illuminant i, RealFloat e) => WhitePoint i e
whitePoint
{-# INLINE pixelWhitePoint #-}