{-
Copyright (c) 2008, 2009, 2026
Russell O'Connor, Christoffer Stjernlöf

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
-}
-- | Functions for converting 'Colour' values to and from the Oklab space, and
-- convenience functions for the derived Oklch space.
-- See <https://bottosson.github.io/posts/oklab/>.
module Data.Colour.Ok
 (okLab, okLabView
 ,okLCh, okLChView
 )
where

import Data.Complex (Complex((:+)), magnitude, mkPolar, phase)
import Data.Fixed (mod')

import Data.Colour.CIE
import Data.Colour.CIE.Illuminant
import Data.Colour.Matrix

-- |Returns the Oklab coordinates of a colour, which is a
-- perceptually uniform colour space inspired by CIELAB
-- but which handles blue hues more accurately.
--
-- A white point is not specified because Oklab assumes
-- a standard 'd65' daylight illuminant.
okLabView :: Floating a => Colour a -> (a,a,a)
okLabView :: forall a. Floating a => Colour a -> (a, a, a)
okLabView Colour a
colour = (a
l,a
a,a
b)
 where
  (a
x,a
y,a
z) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
cieXYZView Colour a
colour
  lms :: [a]
lms = [[a]] -> [a] -> [a]
forall {b}. Num b => [[b]] -> [b] -> [b]
mult [[a]]
forall a. Fractional a => [[a]]
okM1 [a
x,a
y,a
z]
  cbrt :: a -> a
cbrt a
v = a -> a
forall a. Num a => a -> a
signum a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a -> a
forall a. Num a => a -> a
abs a
v)a -> a -> a
forall a. Floating a => a -> a -> a
**(a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
3)
  lms' :: [a]
lms' = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall {a}. Floating a => a -> a
cbrt [a]
lms
  [a
l,a
a,a
b] = [[a]] -> [a] -> [a]
forall {b}. Num b => [[b]] -> [b] -> [b]
mult ([[a]] -> [[a]]
forall {a}. Fractional a => [[a]] -> [[a]]
inverse [[a]]
forall a. Fractional a => [[a]]
okM2inv) [a]
lms'

-- |Returns the colour for given Oklab coordinates, which
-- is a perceptually uniform colour space inspired by
-- CIELAB but which handles blue hues more accurately.
--
-- A white point is not specified because Oklab assumes
-- a standard 'd65' daylight illuminant.
okLab :: Floating a => a -- ^L* coordinate (lightness)
                    -> a -- ^a* coordinate
                    -> a -- ^b* coordinate
                    -> Colour a
okLab :: forall a. Floating a => a -> a -> a -> Colour a
okLab a
l a
a a
b = a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
cieXYZ a
x a
y a
z
 where
  lms' :: [a]
lms' = [[a]] -> [a] -> [a]
forall {b}. Num b => [[b]] -> [b] -> [b]
mult [[a]]
forall a. Fractional a => [[a]]
okM2inv [a
l, a
a, a
b]
  lms :: [a]
lms = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Floating a => a -> a -> a
**a
3) [a]
lms'
  [a
x,a
y,a
z] = [[a]] -> [a] -> [a]
forall {b}. Num b => [[b]] -> [b] -> [b]
mult ([[a]] -> [[a]]
forall {a}. Fractional a => [[a]] -> [[a]]
inverse [[a]]
forall a. Fractional a => [[a]]
okM1) [a]
lms

-- |Returns the Oklab LCh coordinates of a colour. The
-- lightness coordinate is the same as in Oklab, while
-- the chroma C and hue h are the (a,b)-coordinates
-- expressed in polar form.
okLChView :: RealFloat a => Colour a -> (a,a,a)
okLChView :: forall a. RealFloat a => Colour a -> (a, a, a)
okLChView Colour a
colour = (a
l,a
c, a
h a -> a -> a
forall a. Real a => a -> a -> a
`mod'` a
360)
 where
  (a
l,a
a,a
b) = Colour a -> (a, a, a)
forall a. Floating a => Colour a -> (a, a, a)
okLabView Colour a
colour
  z :: Complex a
z = a
a a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
b
  c :: a
c = Complex a -> a
forall a. RealFloat a => Complex a -> a
magnitude Complex a
z
  h :: a
h = Complex a -> a
forall a. RealFloat a => Complex a -> a
phase Complex a
z a -> a -> a
forall a. Num a => a -> a -> a
* a
180 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
forall a. Floating a => a
pi

-- |Constructs a colour from a lightness, chroma, and
-- hue given in LCh polar coordinates correspondong to
-- an Oklab coordinate.
okLCh :: Floating a => a -- ^L* coordinate (lightness)
                    -> a -- ^C* coordinate (chroma)
                    -> a -- ^h* coordinate (hue)
                    -> Colour a
okLCh :: forall a. Floating a => a -> a -> a -> Colour a
okLCh a
l a
c a
h = a -> a -> a -> Colour a
forall a. Floating a => a -> a -> a -> Colour a
okLab a
l a
a a
b
 where
  (a
a :+ a
b) = a -> a -> Complex a
forall a. Floating a => a -> a -> Complex a
mkPolar a
c (a
h a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
180)

--------------------------------------------------------------------------
{- not for export -}

-- |Converts XYZ coordinates to approximate human cone responses.
-- See <https://github.com/color-js/color.js/blob/6b487db289f7c41b78d2933d9cb83bf8c06f3c5e/scripts/oklab_matrix_maker.py>
oklms ::  Fractional a => Chromaticity a -- ^White point
                       -> [[a]]
oklms :: forall a. Fractional a => Chromaticity a -> [[a]]
oklms Chromaticity a
white_ch = ([a] -> a -> [a]) -> [[a]] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> a -> [a]
forall {f :: * -> *} {b}.
(Functor f, Fractional b) =>
f b -> b -> f b
f [[a]]
m0 [a]
lmsWhite
 where
  white :: Colour a
white = Chromaticity a -> a -> Colour a
forall a. Fractional a => Chromaticity a -> a -> Colour a
chromaColour Chromaticity a
white_ch a
1.0
  (a
xw,a
yw,a
zw) = Colour a -> (a, a, a)
forall a. Fractional a => Colour a -> (a, a, a)
cieXYZView Colour a
white
  lmsWhite :: [a]
lmsWhite = [[a]] -> [a] -> [a]
forall {b}. Num b => [[b]] -> [b] -> [b]
mult [[a]]
m0 [a
xw, a
yw, a
zw]
  f :: f b -> b -> f b
f f b
v b
w = (b -> b -> b
forall a. Fractional a => a -> a -> a
/b
w) (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
v
  m0 :: [[a]]
m0 = [[a
0.77849780, a
0.34399940, -a
0.12249720]
       ,[a
0.03303601, a
0.93076195, a
0.03620204]
       ,[a
0.05092917, a
0.27933344, a
0.66973739]
       ]

-- |The M1 matrix from the Oklab specification. This converts XYZ coordinates
-- to approximate human cone responses.
okM1 :: Fractional a => [[a]]
okM1 :: forall a. Fractional a => [[a]]
okM1 = Chromaticity a -> [[a]]
forall a. Fractional a => Chromaticity a -> [[a]]
oklms Chromaticity a
forall a. Fractional a => Chromaticity a
d65

-- |The inverse M2 matrix from the Oklab specification. This converts
-- perceptually uniform LAB coordinates into
-- non-linearly-transformed (l', m', s') coordinates.
-- See <https://github.com/color-js/color.js/blob/6b487db289f7c41b78d2933d9cb83bf8c06f3c5e/scripts/oklab_matrix_maker.py>
okM2inv :: Fractional a => [[a]]
okM2inv :: forall a. Fractional a => [[a]]
okM2inv =
 [[a
1.0, a
0.3963377774, a
0.2158037573]
 ,[a
1.0, -a
0.1055613458, -a
0.0638541728]
 ,[a
1.0, -a
0.0894841775, -a
1.2914855480]
 ]