{-# 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 #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module      : Graphics.Color.Space.RGB.Luma
-- Copyright   : (c) Alexey Kuleshevich 2018-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Space.RGB.Luma
  ( -- * Luma
    pattern Y'
  , pattern Y'A
  , pattern Luma
  , Y'
  , Luma(..)
  , Weight(..)
  , Weights(..)
  , rgbLuma
  , rgbLumaWeights
  , toBaseLinearSpace
  ) where

import Data.Coerce
import Data.Kind
import Data.Typeable
import Foreign.Storable
import Graphics.Color.Model.Internal
import Graphics.Color.Model.RGB as CM
import Graphics.Color.Model.X as CM
import Graphics.Color.Space.Internal
import Graphics.Color.Space.RGB.Internal

-------------
--- Luma ----
-------------

-- | [Luma](https://en.wikipedia.org/wiki/Luma_(video\)) of a non-linear gamma corrected
-- RGB color space. (Not to be confused with luminance `Y`)
data Y' (cs :: Linearity -> Type)

-- | Constructor for Luma.
newtype instance Color (Y' cs) e = Luma (CM.Color CM.X e)

-- | Constructor for Luma `Y'`. (Not to be confused with luminance `Y`)
--
-- @since 0.1.0
pattern Y' :: e -> Color (Y' cs) e
pattern $bY' :: e -> Color (Y' cs) e
$mY' :: forall r e (cs :: Linearity -> *).
Color (Y' cs) e -> (e -> r) -> (Void# -> r) -> r
Y' y = Luma (CM.X y)
{-# COMPLETE Y' #-}

-- | Constructor for `Y'` with alpha channel. (Not to be confused with luminance `Y`)
--
-- @since 0.1.4
pattern Y'A :: e -> e -> Color (Alpha (Y' cs)) e
pattern $bY'A :: e -> e -> Color (Alpha (Y' cs)) e
$mY'A :: forall r e (cs :: Linearity -> *).
Color (Alpha (Y' cs)) e -> (e -> e -> r) -> (Void# -> r) -> r
Y'A y a = Alpha (Luma (CM.X y)) a
{-# COMPLETE Y'A #-}

-- | `Y'` - luma of a color space
deriving instance Eq e => Eq (Color (Y' cs) e)
-- | `Y'` - luma of a color space
deriving instance Ord e => Ord (Color (Y' cs) e)
-- | `Y'` - luma of a color space
deriving instance Functor (Color (Y' cs))
-- | `Y'` - luma of a color space
deriving instance Applicative (Color (Y' cs))
-- | `Y'` - luma of a color space
deriving instance Foldable (Color (Y' cs))
-- | `Y'` - luma of a color space
deriving instance Traversable (Color (Y' cs))
-- | `Y'` - luma of a color space
deriving instance Storable e => Storable (Color (Y' cs) e)


-- | `Y'` - as a color model
instance (Typeable cs, Elevator e) => Show (Color (Y' cs) e) where
  showsPrec :: Int -> Color (Y' cs) e -> ShowS
showsPrec Int
_ = Color (Y' cs) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | `Y'` - as a color model
instance (Typeable cs, Elevator e) => ColorModel (Y' cs) e where
  type Components (Y' cs) e = e
  toComponents :: Color (Y' cs) e -> Components (Y' cs) e
toComponents (Y' e
y) = e
Components (Y' cs) e
y
  {-# INLINE toComponents #-}
  fromComponents :: Components (Y' cs) e -> Color (Y' cs) e
fromComponents = Components (Y' cs) e -> Color (Y' cs) e
forall e (cs :: Linearity -> *). e -> Color (Y' cs) e
Y'
  {-# INLINE fromComponents #-}


instance ( Typeable cs
         , Illuminant i
         , ColorSpace (cs 'Linear) i e
         , ColorSpace (cs 'NonLinear) i e
         , Luma cs
         , RedGreenBlue cs i
         ) =>
         ColorSpace (Y' cs) i e where
  type BaseModel (Y' cs) = CM.X
  type BaseSpace (Y' cs) = cs 'NonLinear
  toBaseSpace :: Color (Y' cs) e -> Color (BaseSpace (Y' cs)) e
toBaseSpace Color (Y' cs) e
y = e -> Color (cs 'NonLinear) e
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color (Y' cs) e -> e
coerce Color (Y' cs) e
y :: e)
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (Y' cs)) e -> Color (Y' cs) e
fromBaseSpace = (Double -> e) -> Color (Y' cs) Double -> Color (Y' cs) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> e
forall e. Elevator e => Double -> e
fromDouble (Color (Y' cs) Double -> Color (Y' cs) e)
-> (Color (cs 'NonLinear) e -> Color (Y' cs) Double)
-> Color (cs 'NonLinear) e
-> Color (Y' cs) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (cs 'NonLinear) e -> Color (Y' cs) Double
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
rgbLuma
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (Y' cs) e -> Color (Y i) a
luminance = 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 (Color (cs 'Linear) e -> Color (Y i) a)
-> (Color (Y' cs) e -> Color (cs 'Linear) e)
-> Color (Y' cs) e
-> Color (Y i) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> e) -> Color (cs 'Linear) Double -> Color (cs 'Linear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> e
forall e. Elevator e => Double -> e
fromDouble :: Double -> e) (Color (cs 'Linear) Double -> Color (cs 'Linear) e)
-> (Color (Y' cs) e -> Color (cs 'Linear) Double)
-> Color (Y' cs) e
-> Color (cs 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y' cs) Double -> Color (cs 'Linear) Double
forall k (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, Applicative (Color (cs 'Linear)),
 RealFloat e) =>
Color (Y' cs) e -> Color (cs 'Linear) e
toBaseLinearSpace (Color (Y' cs) Double -> Color (cs 'Linear) Double)
-> (Color (Y' cs) e -> Color (Y' cs) Double)
-> Color (Y' cs) e
-> Color (cs 'Linear) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Double) -> Color (Y' cs) e -> Color (Y' cs) Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Double
forall e. Elevator e => e -> Double
toDouble
  {-# INLINE luminance #-}
  toColorXYZ :: Color (Y' cs) e -> Color (XYZ i) a
toColorXYZ = 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 -> Color (XYZ i) a)
-> (Color (Y' cs) e -> Color (cs 'Linear) e)
-> Color (Y' cs) e
-> Color (XYZ i) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> e) -> Color (cs 'Linear) Double -> Color (cs 'Linear) e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> e
forall e. Elevator e => Double -> e
fromDouble :: Double -> e) (Color (cs 'Linear) Double -> Color (cs 'Linear) e)
-> (Color (Y' cs) e -> Color (cs 'Linear) Double)
-> Color (Y' cs) e
-> Color (cs 'Linear) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color (Y' cs) Double -> Color (cs 'Linear) Double
forall k (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, Applicative (Color (cs 'Linear)),
 RealFloat e) =>
Color (Y' cs) e -> Color (cs 'Linear) e
toBaseLinearSpace (Color (Y' cs) Double -> Color (cs 'Linear) Double)
-> (Color (Y' cs) e -> Color (Y' cs) Double)
-> Color (Y' cs) e
-> Color (cs 'Linear) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Double) -> Color (Y' cs) e -> Color (Y' cs) Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Double
forall e. Elevator e => e -> Double
toDouble
  {-# INLINE toColorXYZ #-}

-- | Convert Luma directly into the linear version of base space. This is equivalent to
-- `dcctf . toBaseSpace`, but is a bit faster, since inverse transfer function is applied
-- only once
--
-- @since 0.3.0
toBaseLinearSpace ::
     forall cs e i. (RedGreenBlue cs i, Applicative (Color (cs 'Linear)), RealFloat e)
  => Color (Y' cs) e
  -> Color (cs 'Linear) e
toBaseLinearSpace :: Color (Y' cs) e -> Color (cs 'Linear) e
toBaseLinearSpace Color (Y' cs) e
y = e -> Color (cs 'Linear) e
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> e
forall k (cs :: Linearity -> *) (i :: k) e.
(RedGreenBlue cs i, RealFloat e) =>
e -> e
itransfer @_ @cs (Color (Y' cs) e -> e
coerce Color (Y' cs) e
y :: e))
{-# INLINE toBaseLinearSpace #-}

------------------
-- Luma Weights --
------------------

class Luma (cs :: Linearity -> Type) where
  {-# MINIMAL (rWeight, gWeight)|(rWeight, bWeight)|(gWeight, bWeight) #-}
  rWeight :: RealFloat e => Weight cs e
  rWeight = Weight cs e
1 Weight cs e -> Weight cs e -> Weight cs e
forall a. Num a => a -> a -> a
- Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
bWeight Weight cs e -> Weight cs e -> Weight cs e
forall a. Num a => a -> a -> a
- Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
gWeight
  {-# INLINE rWeight #-}

  gWeight :: RealFloat e => Weight cs e
  gWeight = Weight cs e
1 Weight cs e -> Weight cs e -> Weight cs e
forall a. Num a => a -> a -> a
- Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
rWeight Weight cs e -> Weight cs e -> Weight cs e
forall a. Num a => a -> a -> a
- Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
bWeight
  {-# INLINE gWeight #-}

  bWeight :: RealFloat e => Weight cs e
  bWeight = Weight cs e
1 Weight cs e -> Weight cs e -> Weight cs e
forall a. Num a => a -> a -> a
- Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
rWeight Weight cs e -> Weight cs e -> Weight cs e
forall a. Num a => a -> a -> a
- Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
gWeight
  {-# INLINE bWeight #-}

newtype Weight cs e = Weight
  { Weight cs e -> e
unWeight :: e
  } deriving (Weight cs e -> Weight cs e -> Bool
(Weight cs e -> Weight cs e -> Bool)
-> (Weight cs e -> Weight cs e -> Bool) -> Eq (Weight cs e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (cs :: k) e. Eq e => Weight cs e -> Weight cs e -> Bool
/= :: Weight cs e -> Weight cs e -> Bool
$c/= :: forall k (cs :: k) e. Eq e => Weight cs e -> Weight cs e -> Bool
== :: Weight cs e -> Weight cs e -> Bool
$c== :: forall k (cs :: k) e. Eq e => Weight cs e -> Weight cs e -> Bool
Eq, Int -> Weight cs e -> ShowS
[Weight cs e] -> ShowS
Weight cs e -> String
(Int -> Weight cs e -> ShowS)
-> (Weight cs e -> String)
-> ([Weight cs e] -> ShowS)
-> Show (Weight cs e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (cs :: k) e. Show e => Int -> Weight cs e -> ShowS
forall k (cs :: k) e. Show e => [Weight cs e] -> ShowS
forall k (cs :: k) e. Show e => Weight cs e -> String
showList :: [Weight cs e] -> ShowS
$cshowList :: forall k (cs :: k) e. Show e => [Weight cs e] -> ShowS
show :: Weight cs e -> String
$cshow :: forall k (cs :: k) e. Show e => Weight cs e -> String
showsPrec :: Int -> Weight cs e -> ShowS
$cshowsPrec :: forall k (cs :: k) e. Show e => Int -> Weight cs e -> ShowS
Show, Integer -> Weight cs e
Weight cs e -> Weight cs e
Weight cs e -> Weight cs e -> Weight cs e
(Weight cs e -> Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Integer -> Weight cs e)
-> Num (Weight cs e)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall k (cs :: k) e. Num e => Integer -> Weight cs e
forall k (cs :: k) e. Num e => Weight cs e -> Weight cs e
forall k (cs :: k) e.
Num e =>
Weight cs e -> Weight cs e -> Weight cs e
fromInteger :: Integer -> Weight cs e
$cfromInteger :: forall k (cs :: k) e. Num e => Integer -> Weight cs e
signum :: Weight cs e -> Weight cs e
$csignum :: forall k (cs :: k) e. Num e => Weight cs e -> Weight cs e
abs :: Weight cs e -> Weight cs e
$cabs :: forall k (cs :: k) e. Num e => Weight cs e -> Weight cs e
negate :: Weight cs e -> Weight cs e
$cnegate :: forall k (cs :: k) e. Num e => Weight cs e -> Weight cs e
* :: Weight cs e -> Weight cs e -> Weight cs e
$c* :: forall k (cs :: k) e.
Num e =>
Weight cs e -> Weight cs e -> Weight cs e
- :: Weight cs e -> Weight cs e -> Weight cs e
$c- :: forall k (cs :: k) e.
Num e =>
Weight cs e -> Weight cs e -> Weight cs e
+ :: Weight cs e -> Weight cs e -> Weight cs e
$c+ :: forall k (cs :: k) e.
Num e =>
Weight cs e -> Weight cs e -> Weight cs e
Num, Num (Weight cs e)
Num (Weight cs e)
-> (Weight cs e -> Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Rational -> Weight cs e)
-> Fractional (Weight cs e)
Rational -> Weight cs e
Weight cs e -> Weight cs e
Weight cs e -> Weight cs e -> Weight cs e
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
forall k (cs :: k) e. Fractional e => Num (Weight cs e)
forall k (cs :: k) e. Fractional e => Rational -> Weight cs e
forall k (cs :: k) e. Fractional e => Weight cs e -> Weight cs e
forall k (cs :: k) e.
Fractional e =>
Weight cs e -> Weight cs e -> Weight cs e
fromRational :: Rational -> Weight cs e
$cfromRational :: forall k (cs :: k) e. Fractional e => Rational -> Weight cs e
recip :: Weight cs e -> Weight cs e
$crecip :: forall k (cs :: k) e. Fractional e => Weight cs e -> Weight cs e
/ :: Weight cs e -> Weight cs e -> Weight cs e
$c/ :: forall k (cs :: k) e.
Fractional e =>
Weight cs e -> Weight cs e -> Weight cs e
$cp1Fractional :: forall k (cs :: k) e. Fractional e => Num (Weight cs e)
Fractional, Fractional (Weight cs e)
Weight cs e
Fractional (Weight cs e)
-> Weight cs e
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> (Weight cs e -> Weight cs e)
-> Floating (Weight cs e)
Weight cs e -> Weight cs e
Weight cs e -> Weight cs e -> Weight cs e
forall a.
Fractional a
-> a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
forall k (cs :: k) e. Floating e => Fractional (Weight cs e)
forall k (cs :: k) e. Floating e => Weight cs e
forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
forall k (cs :: k) e.
Floating e =>
Weight cs e -> Weight cs e -> Weight cs e
log1mexp :: Weight cs e -> Weight cs e
$clog1mexp :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
log1pexp :: Weight cs e -> Weight cs e
$clog1pexp :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
expm1 :: Weight cs e -> Weight cs e
$cexpm1 :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
log1p :: Weight cs e -> Weight cs e
$clog1p :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
atanh :: Weight cs e -> Weight cs e
$catanh :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
acosh :: Weight cs e -> Weight cs e
$cacosh :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
asinh :: Weight cs e -> Weight cs e
$casinh :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
tanh :: Weight cs e -> Weight cs e
$ctanh :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
cosh :: Weight cs e -> Weight cs e
$ccosh :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
sinh :: Weight cs e -> Weight cs e
$csinh :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
atan :: Weight cs e -> Weight cs e
$catan :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
acos :: Weight cs e -> Weight cs e
$cacos :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
asin :: Weight cs e -> Weight cs e
$casin :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
tan :: Weight cs e -> Weight cs e
$ctan :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
cos :: Weight cs e -> Weight cs e
$ccos :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
sin :: Weight cs e -> Weight cs e
$csin :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
logBase :: Weight cs e -> Weight cs e -> Weight cs e
$clogBase :: forall k (cs :: k) e.
Floating e =>
Weight cs e -> Weight cs e -> Weight cs e
** :: Weight cs e -> Weight cs e -> Weight cs e
$c** :: forall k (cs :: k) e.
Floating e =>
Weight cs e -> Weight cs e -> Weight cs e
sqrt :: Weight cs e -> Weight cs e
$csqrt :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
log :: Weight cs e -> Weight cs e
$clog :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
exp :: Weight cs e -> Weight cs e
$cexp :: forall k (cs :: k) e. Floating e => Weight cs e -> Weight cs e
pi :: Weight cs e
$cpi :: forall k (cs :: k) e. Floating e => Weight cs e
$cp1Floating :: forall k (cs :: k) e. Floating e => Fractional (Weight cs e)
Floating, a -> Weight cs b -> Weight cs a
(a -> b) -> Weight cs a -> Weight cs b
(forall a b. (a -> b) -> Weight cs a -> Weight cs b)
-> (forall a b. a -> Weight cs b -> Weight cs a)
-> Functor (Weight cs)
forall k (cs :: k) a b. a -> Weight cs b -> Weight cs a
forall k (cs :: k) a b. (a -> b) -> Weight cs a -> Weight cs b
forall a b. a -> Weight cs b -> Weight cs a
forall a b. (a -> b) -> Weight cs a -> Weight cs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Weight cs b -> Weight cs a
$c<$ :: forall k (cs :: k) a b. a -> Weight cs b -> Weight cs a
fmap :: (a -> b) -> Weight cs a -> Weight cs b
$cfmap :: forall k (cs :: k) a b. (a -> b) -> Weight cs a -> Weight cs b
Functor)

-- | Get the weights of a non-linear RGB color space that can be used for converting to `Luma`
--
-- @since 0.1.4
rgbLumaWeights ::
     forall cs e' e. (Luma cs, RealFloat e)
  => Color (cs 'NonLinear) e'
  -> Weights e
rgbLumaWeights :: Color (cs 'NonLinear) e' -> Weights e
rgbLumaWeights Color (cs 'NonLinear) e'
_ =
  V3 e -> Weights e
forall e. V3 e -> Weights e
Weights (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 (Weight cs e -> e
coerce (Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
rWeight :: Weight cs e) :: e)
              (Weight cs e -> e
coerce (Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
gWeight :: Weight cs e) :: e)
              (Weight cs e -> e
coerce (Weight cs e
forall (cs :: Linearity -> *) e.
(Luma cs, RealFloat e) =>
Weight cs e
bWeight :: Weight cs e) :: e))
{-# INLINE rgbLumaWeights #-}

-- | Convert a non-linear RGB pixel to a luma pixel
--
-- @since 0.1.0
rgbLuma ::
     forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)
  => Color (cs 'NonLinear) e'
  -> Color (Y' cs) e
rgbLuma :: Color (cs 'NonLinear) e' -> Color (Y' cs) e
rgbLuma Color (cs 'NonLinear) e'
rgb' = e -> Color (Y' cs) e
forall e (cs :: Linearity -> *). e -> Color (Y' cs) e
Y' (Color RGB e -> V3 e
coerce ((e' -> e) -> Color RGB e' -> Color RGB e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e' -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat Color RGB e'
rgb :: Color CM.RGB e) V3 e -> V3 e -> e
forall a. Num a => V3 a -> V3 a -> a
`dotProduct` Weights e -> V3 e
coerce Weights e
weights)
  where
    !rgb :: Color RGB e'
rgb = 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
unColorRGB Color (cs 'NonLinear) e'
rgb'
    !weights :: Weights e
weights = Color (cs 'NonLinear) e' -> Weights e
forall (cs :: Linearity -> *) e' e.
(Luma cs, RealFloat e) =>
Color (cs 'NonLinear) e' -> Weights e
rgbLumaWeights Color (cs 'NonLinear) e'
rgb' :: Weights e
{-# INLINE rgbLuma #-}