{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Adaptation.Internal
( ChromaticAdaptation(..)
, Adaptation(..)
, chromaticAdaptation
, convertWith
, convertElevatedWith
, convertNoAdaptation
) where
import Graphics.Color.Space.Internal
import Graphics.Color.Space.RGB.Internal
import Data.Kind
class (Illuminant it, Illuminant ir, Elevator e, RealFloat e) =>
ChromaticAdaptation (t :: k) (it :: kt) (ir :: kr) e
where
data Adaptation t it ir e :: Type
adaptColorXYZ :: Adaptation t it ir e -> Color (XYZ it) e -> Color (XYZ ir) e
data ExactNoAdaptation
instance (Illuminant i, Elevator e, RealFloat e) =>
ChromaticAdaptation ExactNoAdaptation i i e where
data Adaptation ExactNoAdaptation i i e = ExactNoAdaptation
adaptColorXYZ :: Adaptation ExactNoAdaptation i i e
-> Color (XYZ i) e -> Color (XYZ i) e
adaptColorXYZ Adaptation ExactNoAdaptation i i e
_ = Color (XYZ i) e -> Color (XYZ i) e
forall a. a -> a
id
data ApproximateNoAdaptation
instance (Illuminant it, Illuminant ir, Elevator e, RealFloat e, Temperature it ~ Temperature ir) =>
ChromaticAdaptation ApproximateNoAdaptation it ir e where
data Adaptation ApproximateNoAdaptation it ir e = ApproximateNoAdaptation
adaptColorXYZ :: Adaptation ApproximateNoAdaptation it ir e
-> Color (XYZ it) e -> Color (XYZ ir) e
adaptColorXYZ Adaptation ApproximateNoAdaptation it ir e
_ (ColorXYZ e
x e
y e
z) = e -> e -> e -> Color (XYZ ir) e
forall k e (i :: k). e -> e -> e -> Color (XYZ i) e
ColorXYZ e
x e
y e
z
chromaticAdaptation ::
ChromaticAdaptation t it ir e
=> Adaptation t it ir e
-> Gamut cs it e
-> Gamut cs ir e
chromaticAdaptation :: Adaptation t it ir e -> Gamut cs it e -> Gamut cs ir e
chromaticAdaptation Adaptation t it ir e
adaptation Gamut cs it e
g = Primary ir e -> Primary ir e -> Primary ir e -> Gamut cs ir e
forall k (cs :: Linearity -> *) (i :: k) e.
Primary i e -> Primary i e -> Primary i e -> Gamut cs i e
Gamut Primary ir e
redPrimary Primary ir e
greenPrimary Primary ir e
bluePrimary
where
applyMatrix :: Primary it e -> Primary ir e
applyMatrix Primary it e
primary =
Chromaticity ir e -> Primary ir e
forall k (i :: k) e. Chromaticity i e -> Primary i e
PrimaryChromaticity
(Color (CIExyY ir) e -> Chromaticity ir e
forall k (i :: k) e. Color (CIExyY i) e -> Chromaticity i e
Chromaticity (Color (XYZ ir) e -> Color (CIExyY ir) e
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color cs e
fromColorXYZ (Adaptation t it ir e -> Color (XYZ it) e -> Color (XYZ ir) e
forall k kt kr (t :: k) (i' :: kt) (i :: kr) e cs' cs.
(ChromaticAdaptation t i' i e, ColorSpace cs' i' e,
ColorSpace cs i e) =>
Adaptation t i' i e -> Color cs' e -> Color cs e
convertWith Adaptation t it ir e
adaptation (Primary it e -> Color (XYZ it) e
forall k (i :: k) e.
(Illuminant i, RealFloat e, Elevator e) =>
Primary i e -> Color (XYZ i) e
primaryTristimulus Primary it e
primary))))
redPrimary :: Primary ir e
redPrimary = Primary it e -> Primary ir e
applyMatrix (Gamut cs it e -> Primary it e
forall (cs :: Linearity -> *) k (i :: k) e.
Gamut cs i e -> Primary i e
gamutRedPrimary Gamut cs it e
g)
greenPrimary :: Primary ir e
greenPrimary = Primary it e -> Primary ir e
applyMatrix (Gamut cs it e -> Primary it e
forall (cs :: Linearity -> *) k (i :: k) e.
Gamut cs i e -> Primary i e
gamutGreenPrimary Gamut cs it e
g)
bluePrimary :: Primary ir e
bluePrimary = Primary it e -> Primary ir e
applyMatrix (Gamut cs it e -> Primary it e
forall (cs :: Linearity -> *) k (i :: k) e.
Gamut cs i e -> Primary i e
gamutBluePrimary Gamut cs it e
g)
convertWith ::
(ChromaticAdaptation t i' i e, ColorSpace cs' i' e, ColorSpace cs i e)
=> Adaptation t i' i e
-> Color cs' e
-> Color cs e
convertWith :: Adaptation t i' i e -> Color cs' e -> Color cs e
convertWith = Adaptation t i' i e -> Color cs' e -> Color cs e
forall k kt kr (t :: k) (i' :: kt) (i :: kr) a cs' e' cs e.
(ChromaticAdaptation t i' i a, ColorSpace cs' i' e',
ColorSpace cs i e) =>
Adaptation t i' i a -> Color cs' e' -> Color cs e
convertElevatedWith
{-# INLINE convertWith #-}
convertElevatedWith ::
(ChromaticAdaptation t i' i a, ColorSpace cs' i' e', ColorSpace cs i e)
=> Adaptation t i' i a
-> Color cs' e'
-> Color cs e
convertElevatedWith :: Adaptation t i' i a -> Color cs' e' -> Color cs e
convertElevatedWith Adaptation t i' i a
adaptation = Color (XYZ i) a -> Color cs e
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color cs e
fromColorXYZ (Color (XYZ i) a -> Color cs e)
-> (Color cs' e' -> Color (XYZ i) a) -> Color cs' e' -> Color cs e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Adaptation t i' i a -> Color (XYZ i') a -> Color (XYZ i) a
forall k kt kr (t :: k) (it :: kt) (ir :: kr) e.
ChromaticAdaptation t it ir e =>
Adaptation t it ir e -> Color (XYZ it) e -> Color (XYZ ir) e
adaptColorXYZ Adaptation t i' i a
adaptation (Color (XYZ i') a -> Color (XYZ i) a)
-> (Color cs' e' -> Color (XYZ i') a)
-> Color cs' e'
-> Color (XYZ i) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color cs' 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
{-# INLINE[2] convertElevatedWith #-}
convertNoAdaptation ::
forall cs' e' cs e i. (ColorSpace cs' i e', ColorSpace cs i e)
=> Color cs' e'
-> Color cs e
convertNoAdaptation :: Color cs' e' -> Color cs e
convertNoAdaptation = Color (XYZ i) Double -> Color cs e
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color cs e
fromColorXYZ (Color (XYZ i) Double -> Color cs e)
-> (Color cs' e' -> Color (XYZ i) Double)
-> Color cs' e'
-> Color cs e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color cs' e' -> Color (XYZ i) Double
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' e' -> Color (XYZ i) Double)
{-# INLINE convertNoAdaptation #-}
convertNoAdaptationFloat ::
forall cs' e' cs e i. (ColorSpace cs' i e', ColorSpace cs i e)
=> Color cs' e'
-> Color cs e
convertNoAdaptationFloat :: Color cs' e' -> Color cs e
convertNoAdaptationFloat = Color (XYZ i) Float -> Color cs e
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color (XYZ i) a -> Color cs e
fromColorXYZ (Color (XYZ i) Float -> Color cs e)
-> (Color cs' e' -> Color (XYZ i) Float)
-> Color cs' e'
-> Color cs e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color cs' e' -> Color (XYZ i) Float
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' e' -> Color (XYZ i) Float)
{-# INLINE convertNoAdaptationFloat #-}
{-# RULES
"convertElevatedWith (Float)"[~2] forall (a :: Adaptation t i i Float) . convertElevatedWith a = convertNoAdaptationFloat
"convertElevatedWith (Double)"[~2] forall (a :: Adaptation t i i Double) . convertElevatedWith a = convertNoAdaptation
#-}