-- SPDX-License-Identifier: MPL-2.0

{- | Three-channel color conversion. sRGB uses the IEC piecewise transfer;
XYZ is D65 with Y=1 for reference white; Lab uses that same D65 white (no
implicit chromatic adaptation). Hue is in turns [0,1), HSV/HSL saturation
and brightness/lightness in [0,1]. Full-range BT.601 YCbCr uses chroma offset
0.5. Out-of-gamut conversions return finite unclipped values; converting
those results back requires the target color space's input domain.
Matrix and Lab definitions: https://www.w3.org/TR/css-color-4/ .
-}
module HMath.Image.Color (ColorSpace (..), convertColor, grayscale, srgbToLinear, linearToSrgb) where

import HMath.Error
import HMath.Image.Core

{- | Color coordinate convention,including sRGB,linear RGB,HSV,HSL,XYZ,Lab,and YCbCr.
convertColor validates each source convention's ranges.
-}
data ColorSpace = SRGB | LinearRGB | HSV | HSL | XYZ | Lab | YCbCr deriving (ColorSpace -> ColorSpace -> Bool
(ColorSpace -> ColorSpace -> Bool)
-> (ColorSpace -> ColorSpace -> Bool) -> Eq ColorSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorSpace -> ColorSpace -> Bool
== :: ColorSpace -> ColorSpace -> Bool
$c/= :: ColorSpace -> ColorSpace -> Bool
/= :: ColorSpace -> ColorSpace -> Bool
Eq, Int -> ColorSpace -> ShowS
[ColorSpace] -> ShowS
ColorSpace -> String
(Int -> ColorSpace -> ShowS)
-> (ColorSpace -> String)
-> ([ColorSpace] -> ShowS)
-> Show ColorSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorSpace -> ShowS
showsPrec :: Int -> ColorSpace -> ShowS
$cshow :: ColorSpace -> String
show :: ColorSpace -> String
$cshowList :: [ColorSpace] -> ShowS
showList :: [ColorSpace] -> ShowS
Show)

{- | Transfer functions extend linearly below their positive breakpoints;
finite negative/out-of-gamut channels are retained.
-}
srgbToLinear :: Double -> Either MathError Double
srgbToLinear :: Double -> Either MathError Double
srgbToLinear Double
x = do Bool -> String -> Either MathError ()
require (Double -> Bool
finite Double
x) String
"nonfinite sRGB channel"; Double -> Either MathError Double
scalar (Double -> Double
decode Double
x)

{- | Encode a finite linear-light channel with the sRGB piecewise transfer function (linear
branch through 0.0031308). No automatic clipping is performed. Non-finite input/result
returns Left MathError.
-}
linearToSrgb :: Double -> Either MathError Double
linearToSrgb :: Double -> Either MathError Double
linearToSrgb Double
x = do Bool -> String -> Either MathError ()
require (Double -> Bool
finite Double
x) String
"nonfinite linear RGB channel"; Double -> Either MathError Double
scalar (Double -> Double
encode Double
x)

scalar :: Double -> Either MathError Double
scalar :: Double -> Either MathError Double
scalar Double
x = do _ <- [Double] -> Either MathError [Double]
checked [Double
x]; Right x
decode, encode :: Double -> Double
decode :: Double -> Double
decode Double
x = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.04045 then Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
12.92 else ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.055) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1.055) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2.4
encode :: Double -> Double
encode Double
x = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.0031308 then Double
12.92 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x else Double
1.055 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.4) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.055

-- | Explicit source/destination spaces; three interleaved channels required.
convertColor :: ColorSpace -> ColorSpace -> Image -> Either MathError Image
convertColor :: ColorSpace -> ColorSpace -> Image -> Either MathError Image
convertColor ColorSpace
source ColorSpace
destination Image
img = do
    Bool -> String -> Either MathError ()
require (Image -> Int
imageChannels Image
img Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3) String
"color conversion needs three channels"
    let triples :: [[Double]]
triples = [Double] -> [[Double]]
forall {a}. [a] -> [[a]]
chunks (Image -> [Double]
imageValues Image
img)
    ([Double] -> Either MathError ())
-> [[Double]] -> Either MathError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ColorSpace -> [Double] -> Either MathError ()
validateSource ColorSpace
source) [[Double]]
triples
    result <-
        ([Double] -> Either MathError [Double])
-> [[Double]] -> Either MathError [[Double]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
            ( \[Double]
rgb -> do
                linear <- ColorSpace -> [Double] -> Either MathError [Double]
convertTo ColorSpace
source [Double]
rgb
                if destination == HSV || destination == HSL
                    then do
                        encoded <- checked (map encode linear)
                        _ <- checked [maximum encoded - minimum encoded]
                        Right ()
                    else Right ()
                checked (convertFrom destination linear)
            )
            [[Double]]
triples
    image (imageShape img) 3 (concat result)
  where
    chunks :: [a] -> [[a]]
chunks [] = []
    chunks (a
a : a
b : a
c : [a]
rest) = [a
a, a
b, a
c] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
chunks [a]
rest
    chunks [a]
_ = [] -- constructor guarantees channel divisibility

validateSource :: ColorSpace -> [Double] -> Either MathError ()
validateSource :: ColorSpace -> [Double] -> Either MathError ()
validateSource ColorSpace
space [Double]
values = case ColorSpace
space of
    ColorSpace
HSV -> Either MathError ()
unit
    ColorSpace
HSL -> Either MathError ()
unit
    ColorSpace
_ -> () -> Either MathError ()
forall a b. b -> Either a b
Right ()
  where
    unit :: Either MathError ()
unit = Bool -> String -> Either MathError ()
require ((Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Double
x -> Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1) [Double]
values) String
"HSV/HSL components outside [0,1]"

convertTo :: ColorSpace -> [Double] -> Either MathError [Double]
convertTo :: ColorSpace -> [Double] -> Either MathError [Double]
convertTo ColorSpace
space [Double]
values = do
    let rgb :: [Double]
rgb = case (ColorSpace
space, [Double]
values) of
            (ColorSpace
SRGB, [Double]
_) -> (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
decode [Double]
values
            (ColorSpace
LinearRGB, [Double]
_) -> [Double]
values
            (ColorSpace
XYZ, [Double]
_) -> [Double] -> [Double]
xyzToRGB [Double]
values
            (ColorSpace
Lab, [Double
l, Double
a, Double
b]) ->
                [Double] -> [Double]
xyzToRGB
                    [ Double
0.95047 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
labInverse ((Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
116 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
500)
                    , Double -> Double
labInverse ((Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
116)
                    , Double
1.08883 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
labInverse ((Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
116 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
200)
                    ]
            (ColorSpace
HSV, [Double
h, Double
s, Double
v]) -> (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
decode (Double -> Double -> Double -> [Double]
hueRGB Double
h (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s) (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s))
            (ColorSpace
HSL, [Double
h, Double
s, Double
l]) -> let c :: Double
c = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s in (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
decode (Double -> Double -> Double -> [Double]
hueRGB Double
h Double
c (Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
            (ColorSpace
YCbCr, [Double
y, Double
cb, Double
cr]) ->
                (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map
                    Double -> Double
decode
                    [ Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.402 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
cr Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5)
                    , Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.34413628620102216 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
cb Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.7141362862010221 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
cr Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5)
                    , Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.772 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
cb Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5)
                    ]
            (ColorSpace, [Double])
_ -> []
    [Double] -> Either MathError [Double]
checked [Double]
rgb
convertFrom :: ColorSpace -> [Double] -> [Double]
convertFrom :: ColorSpace -> [Double] -> [Double]
convertFrom ColorSpace
space [Double]
linear = case (ColorSpace
space, [Double]
linear) of
    (ColorSpace
LinearRGB, [Double]
_) -> [Double]
linear
    (ColorSpace
XYZ, [Double]
_) -> [Double] -> [Double]
rgbToXYZ [Double]
linear
    (ColorSpace
Lab, [Double]
_) -> case [Double] -> [Double]
rgbToXYZ [Double]
linear of
        [Double
x, Double
y, Double
z] ->
            let fx :: Double
fx = Double -> Double
labFunction (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.95047); fy :: Double
fy = Double -> Double
labFunction Double
y; fz :: Double
fz = Double -> Double
labFunction (Double
z Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1.08883)
             in [Double
116 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
16, Double
500 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
fx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fy), Double
200 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
fy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fz)]
        [Double]
_ -> []
    (ColorSpace, [Double])
_ ->
        let rgb :: [Double]
rgb = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
encode [Double]
linear
         in case (ColorSpace
space, [Double]
rgb) of
                (ColorSpace
SRGB, [Double]
_) -> [Double]
rgb
                (ColorSpace
HSV, [Double
r, Double
g, Double
b]) ->
                    let hi :: Double
hi = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
rgb; lo :: Double
lo = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
rgb; c :: Double
c = Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo
                     in [Double -> Double -> Double -> Double -> Double -> Double
hue Double
r Double
g Double
b Double
hi Double
c, if Double
hi Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
0 else Double
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
hi, Double
hi]
                (ColorSpace
HSL, [Double
r, Double
g, Double
b]) ->
                    let hi :: Double
hi = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
rgb; lo :: Double
lo = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
rgb; c :: Double
c = Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo; l :: Double
l = (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                     in [Double -> Double -> Double -> Double -> Double -> Double
hue Double
r Double
g Double
b Double
hi Double
c, if Double
c Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
0 else Double
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)), Double
l]
                (ColorSpace
YCbCr, [Double
r, Double
g, Double
b]) -> let y :: Double
y = Double
0.299 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.587 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.114 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b in [Double
y, Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1.772, Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1.402]
                (ColorSpace, [Double])
_ -> []

hue :: Double -> Double -> Double -> Double -> Double -> Double
hue :: Double -> Double -> Double -> Double -> Double -> Double
hue Double
r Double
g Double
b Double
hi Double
chroma
    | Double
chroma Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Double
0
    | Bool
otherwise =
        let sector :: Double
sector =
                if Double
hi Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
r then (Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
chroma else if Double
hi Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
g then (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
chroma Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 else (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
g) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
chroma Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4
            value :: Double
value = Double
sector Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
6
         in Double
value Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
value :: Int)
hueRGB :: Double -> Double -> Double -> [Double]
hueRGB :: Double -> Double -> Double -> [Double]
hueRGB Double
h Double
chroma Double
minimumValue =
    (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map
        (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
minimumValue)
        ( case Int
sector of
            Int
0 -> [Double
chroma, Double
x, Double
0]
            Int
1 -> [Double
x, Double
chroma, Double
0]
            Int
2 -> [Double
0, Double
chroma, Double
x]
            Int
3 -> [Double
0, Double
x, Double
chroma]
            Int
4 -> [Double
x, Double
0, Double
chroma]
            Int
_ -> [Double
chroma, Double
0, Double
x]
        )
  where
    turn :: Double
turn = (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
h :: Int)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
6
    sector :: Int
sector = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
turn :: Int
    x :: Double
x = Double
chroma Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Double
turn Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
turn Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1))
rgbToXYZ, xyzToRGB :: [Double] -> [Double]
rgbToXYZ :: [Double] -> [Double]
rgbToXYZ [Double
r, Double
g, Double
b] =
    [ Double
0.4124564 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.3575761 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.1804375 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b
    , Double
0.2126729 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.7151522 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0721750 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b
    , Double
0.0193339 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.1191920 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.9503041 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b
    ]
rgbToXYZ [Double]
_ = []
xyzToRGB :: [Double] -> [Double]
xyzToRGB [Double
x, Double
y, Double
z] =
    [ Double
3.2404542 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1.5371385 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.4985314 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z
    , (-Double
0.9692660) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.8760108 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0415560 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z
    , Double
0.0556434 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.2040259 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0572252 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z
    ]
xyzToRGB [Double]
_ = []
labFunction, labInverse :: Double -> Double
labFunction :: Double -> Double
labFunction Double
x = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double
6 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
29) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int) then Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3) else Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
6 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
29) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
29
labInverse :: Double -> Double
labInverse Double
x = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
6 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
29 then Double
x Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int) else Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
6 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
29) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
29)

-- | Rec.709 luminance, explicitly converting the stated source to linear RGB.
grayscale :: ColorSpace -> Image -> Either MathError Image
grayscale :: ColorSpace -> Image -> Either MathError Image
grayscale ColorSpace
source Image
img = do
    linear <- ColorSpace -> ColorSpace -> Image -> Either MathError Image
convertColor ColorSpace
source ColorSpace
LinearRGB Image
img
    build
        (imageShape img)
        1
        (\[Int]
ix Int
_ -> Double
0.2126 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Image -> [Int] -> Int -> Double
at Image
linear [Int]
ix Int
0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.7152 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Image -> [Int] -> Int -> Double
at Image
linear [Int]
ix Int
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0722 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Image -> [Int] -> Int -> Double
at Image
linear [Int]
ix Int
2)