{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Color.Space.CIE1976.LUV
--
module Graphics.Color.Space.CIE1976.LUV
  ( -- * Constructors for an CIE L*u*v* color space.
    pattern LUV
  , pattern ColorLUV
  , pattern ColorLUVA
  , LUV
  ) where

import Foreign.Storable
import Graphics.Color.Model.Internal
import Graphics.Color.Space.Internal

--------------
--- CIELUV ---
--------------

-- | [CIE L*u*v*](https://en.wikipedia.org/wiki/CIELUV_color_space) color space
data LUV (i :: k)

-- | Color in CIE L*u*v* color space
newtype instance Color (LUV i) e = LUV (V3 e)


pattern ColorLUV :: e -> e -> e -> Color (LUV i) e
pattern $bColorLUV :: e -> e -> e -> Color (LUV i) e
$mColorLUV :: forall r k e (i :: k).
Color (LUV i) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
ColorLUV l' u' v' = LUV (V3 l' u' v')
{-# COMPLETE ColorLUV #-}

-- | Constructor for @LUV@ with alpha channel.
pattern ColorLUVA :: e -> e -> e -> e -> Color (Alpha (LUV i)) e
pattern $bColorLUVA :: e -> e -> e -> e -> Color (Alpha (LUV i)) e
$mColorLUVA :: forall r k e (i :: k).
Color (Alpha (LUV i)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
ColorLUVA l' u' v' a = Alpha (LUV (V3 l' u' v')) a
{-# COMPLETE ColorLUVA #-}

-- | CIE1976 `LUV` color space
deriving instance Eq e => Eq (Color (LUV i) e)

-- | CIE1976 `LUV` color space
deriving instance Ord e => Ord (Color (LUV i) e)

-- | CIE1976 `LUV` color space
deriving instance Functor (Color (LUV i))

-- | CIE1976 `LUV` color space
deriving instance Applicative (Color (LUV i))

-- | CIE1976 `LUV` color space
deriving instance Foldable (Color (LUV i))

-- | CIE1976 `LUV` color space
deriving instance Traversable (Color (LUV i))

-- | CIE1976 `LUV` color space
deriving instance Storable e => Storable (Color (LUV i) e)

-- | CIE1976 `LUV` color space
instance (Illuminant i, Elevator e) => Show (Color (LUV i) e) where
  showsPrec :: Int -> Color (LUV i) e -> ShowS
showsPrec Int
_ = Color (LUV i) e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | CIE1976 `LUV` color space
instance (Illuminant i, Elevator e) => ColorModel (LUV i) e where
  type Components (LUV i) e = (e, e, e)
  toComponents :: Color (LUV i) e -> Components (LUV i) e
toComponents (ColorLUV e
l' e
u' e
v') = (e
l', e
u', e
v')
  {-# INLINE toComponents #-}
  fromComponents :: Components (LUV i) e -> Color (LUV i) e
fromComponents (l', u', v') = e -> e -> e -> Color (LUV i) e
forall k e (i :: k). e -> e -> e -> Color (LUV i) e
ColorLUV e
l' e
u' e
v'
  {-# INLINE fromComponents #-}

instance (Illuminant i, Elevator e, RealFloat e) => ColorSpace (LUV (i :: k)) i e where
  type BaseModel (LUV i) = LUV i
  type BaseSpace (LUV i) = LUV i
  toBaseSpace :: Color (LUV i) e -> Color (BaseSpace (LUV i)) e
toBaseSpace = Color (LUV i) e -> Color (BaseSpace (LUV i)) e
forall a. a -> a
id
  {-# INLINE toBaseSpace #-}
  fromBaseSpace :: Color (BaseSpace (LUV i)) e -> Color (LUV i) e
fromBaseSpace = Color (BaseSpace (LUV i)) e -> Color (LUV i) e
forall a. a -> a
id
  {-# INLINE fromBaseSpace #-}
  luminance :: Color (LUV i) e -> Color (Y i) a
luminance (ColorLUV e
l' e
_ e
_) = a -> Color (Y i) a
forall k e (i :: k). e -> Color (Y i) e
Y (a -> a
forall a. (Fractional a, Ord a) => a -> a
ift (e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
scaleLightness e
l'))
  {-# INLINE luminance #-}
  toColorXYZ :: Color (LUV i) e -> Color (XYZ i) a
toColorXYZ = Color (LUV i) e -> Color (XYZ i) a
forall k (i :: k) a e.
(Illuminant i, Elevator e, Elevator a, RealFloat a) =>
Color (LUV i) e -> Color (XYZ i) a
luv2xyz
  {-# INLINE toColorXYZ #-}
  fromColorXYZ :: Color (XYZ i) a -> Color (LUV i) e
fromColorXYZ = Color (XYZ i) a -> Color (LUV i) e
forall k (i :: k) a e.
(Illuminant i, Elevator a, Elevator e, RealFloat e) =>
Color (XYZ i) a -> Color (LUV i) e
xyz2luv
  {-# INLINE fromColorXYZ #-}

luv2xyz ::
     forall i a e. (Illuminant i, Elevator e, Elevator a, RealFloat a)
  => Color (LUV i) e
  -> Color (XYZ i) a
luv2xyz :: Color (LUV i) e -> Color (XYZ i) a
luv2xyz (ColorLUV e
l' e
u' e
v') = a -> a -> a -> Color (XYZ i) a
forall k e (i :: k). e -> e -> e -> Color (XYZ i) e
ColorXYZ a
x a
y a
z
  where
    !(ColorXYZ a
wx a
_ a
wz) = Color (XYZ i) a
forall k (i :: k) e.
(Illuminant i, RealFloat e, Elevator e) =>
Color (XYZ i) e
whitePointTristimulus :: Color (XYZ i) a
    !y :: a
y = a -> a
forall a. (Fractional a, Ord a) => a -> a
ift (a -> a) -> (e -> a) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
scaleLightness (e -> a) -> e -> a
forall a b. (a -> b) -> a -> b
$ e
l'
    !wxyz :: a
wxyz = a
wx a -> a -> a
forall a. Num a => a -> a -> a
+ a
15 a -> a -> a
forall a. Num a => a -> a -> a
+ a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
wz
    !l1 :: a
l1 = a
13 a -> a -> a
forall a. Num a => a -> a -> a
* e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat e
l'
    !a :: a
a = (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
3) a -> a -> a
forall a. Num a => a -> a -> a
* ((a
4 a -> a -> a
forall a. Num a => a -> a -> a
* a
l1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat e
u' a -> a -> a
forall a. Num a => a -> a -> a
+ a
l1 a -> a -> a
forall a. Num a => a -> a -> a
* a
4 a -> a -> a
forall a. Num a => a -> a -> a
* (a
wx a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
wxyz))) a -> a -> a
forall a. Num a => a -> a -> a
- a
1) :: a
    !b :: a
b = -a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
y
    !c :: a
c = -a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3
    !d :: a
d = a
y a -> a -> a
forall a. Num a => a -> a -> a
* (a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
l1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat e
v' a -> a -> a
forall a. Num a => a -> a -> a
+ a
l1 a -> a -> a
forall a. Num a => a -> a -> a
* a
9 a -> a -> a
forall a. Num a => a -> a -> a
* (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
wxyz)) a -> a -> a
forall a. Num a => a -> a -> a
- a
5) :: a
    !x :: a
x = (a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
b) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
c)
    !z :: a
z = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b
{-# INLINE luv2xyz #-}

scaleLightness :: (Elevator e, Elevator a, RealFloat a) => e -> a
scaleLightness :: e -> a
scaleLightness e
l' = (e -> a
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat e
l' a -> a -> a
forall a. Num a => a -> a -> a
+ a
16) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
116
{-# INLINE scaleLightness #-}

ift :: (Fractional a, Ord a) => a -> a
ift :: a -> a
ift a
t
  | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
6 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
29 = a
t a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int)
  | Bool
otherwise = (a
108 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
841) a -> a -> a
forall a. Num a => a -> a -> a
* (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
4 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
29)


xyz2luv ::
     forall i a e. (Illuminant i, Elevator a, Elevator e, RealFloat e)
  => Color (XYZ i) a
  -> Color (LUV i) e
xyz2luv :: Color (XYZ i) a -> Color (LUV i) e
xyz2luv (ColorXYZ a
x a
y a
z) = e -> e -> e -> Color (LUV i) e
forall k e (i :: k). e -> e -> e -> Color (LUV i) e
ColorLUV e
l' e
u' e
v'
  where
    !l' :: e
l' = e
116 e -> e -> e
forall a. Num a => a -> a -> a
* e -> e
forall a. RealFloat a => a -> a
ft (a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat a
y) e -> e -> e
forall a. Num a => a -> a -> a
- e
16
    !(ColorXYZ e
wx e
_ e
wz) = Color (XYZ i) e
forall k (i :: k) e.
(Illuminant i, RealFloat e, Elevator e) =>
Color (XYZ i) e
whitePointTristimulus :: Color (XYZ i) e
    !xyz :: e
xyz = a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat (a -> e) -> a -> e
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
15 a -> a -> a
forall a. Num a => a -> a -> a
* a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
z
    !wxyz :: e
wxyz = e
wx e -> e -> e
forall a. Num a => a -> a -> a
+ e
15 e -> e -> e
forall a. Num a => a -> a -> a
+ e
3 e -> e -> e
forall a. Num a => a -> a -> a
* e
wz
    !u' :: e
u' = e
13 e -> e -> e
forall a. Num a => a -> a -> a
* e
l' e -> e -> e
forall a. Num a => a -> a -> a
* e
4 e -> e -> e
forall a. Num a => a -> a -> a
* (a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat a
x e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
xyz e -> e -> e
forall a. Num a => a -> a -> a
- e
wx e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
wxyz)
    !v' :: e
v' = e
13 e -> e -> e
forall a. Num a => a -> a -> a
* e
l' e -> e -> e
forall a. Num a => a -> a -> a
* e
9 e -> e -> e
forall a. Num a => a -> a -> a
* (a -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat a
y e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
xyz e -> e -> e
forall a. Num a => a -> a -> a
- e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
wxyz)
{-# INLINE xyz2luv #-}

ft :: RealFloat a => a -> a
ft :: a -> a
ft a
t
  | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. RealFloat a => a
t0 = a
t a -> a -> a
forall a. Floating a => a -> a -> a
** (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3)
  | Bool
otherwise = a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. RealFloat a => a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
4 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
29
{-# INLINE ft #-}

m :: RealFloat a => a
m :: a
m = a
841 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
108

t0 :: RealFloat a => a
t0 :: a
t0 = a
216 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
24389
  -- where
  --   m = 1/3 * δ^-2 = 841/108 =~ 7.787[037]
  --   t0 = δ^3 =~ 0.008856
  --   δ = 6/29 =~ 0.2069