{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Graphics.Pixel.ColorSpace
( Pixel(Pixel, PixelY, PixelXYZ, PixelLAB, PixelRGB, PixelHSI, PixelHSL, PixelHSV,
PixelCMYK, PixelY'CbCr, PixelY', PixelYA, PixelXYZA, PixelLABA, PixelRGBA, PixelHSIA, PixelHSLA,
PixelHSVA, PixelCMYKA, PixelY'CbCrA, PixelY'A)
, liftPixel
, pixelColor
, convertPixel
, toPixelY
, toPixelXYZ
, fromPixelXYZ
, toPixelBaseSpace
, fromPixelBaseSpace
, toPixelBaseModel
, fromPixelBaseModel
, toPixel8
, toPixel16
, toPixel32
, toPixel64
, toPixelF
, toPixelD
, toPixelLinearRGB
, fromPixelLinearRGB
, pattern PixelSRGB
, pattern PixelSRGBA
, rgbPixelLuma
, module Graphics.Color.Space
, module Graphics.Color.Algebra.Binary
) where
import Data.Coerce
import Graphics.Color.Adaptation.VonKries
import Graphics.Color.Algebra.Binary
import qualified Graphics.Color.Model.RGB as CM
import Graphics.Color.Space
import Graphics.Pixel.Internal
convertPixel ::
forall cs i e cs' i' e' . (ColorSpace cs' i' e', ColorSpace cs i e)
=> Pixel cs' e'
-> Pixel cs e
convertPixel :: Pixel cs' e' -> Pixel cs e
convertPixel = (Color cs' e' -> Color cs e) -> Pixel cs' e' -> Pixel cs e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color cs' e' -> Color cs e
forall k1 k2 cs' (i' :: k1) e' cs (i :: k2) e.
(ColorSpace cs' i' e', ColorSpace cs i e) =>
Color cs' e' -> Color cs e
convert
{-# INLINE convertPixel #-}
pattern PixelSRGB :: e -> e -> e -> Pixel (SRGB 'NonLinear) e
pattern $bPixelSRGB :: e -> e -> e -> Pixel (SRGB 'NonLinear) e
$mPixelSRGB :: forall r e.
Pixel (SRGB 'NonLinear) e
-> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelSRGB r g b = Pixel (SRGB (CM.ColorRGB r g b))
{-# COMPLETE PixelSRGB #-}
pattern PixelSRGBA :: e -> e -> e -> e -> Pixel (Alpha (SRGB 'NonLinear)) e
pattern $bPixelSRGBA :: e -> e -> e -> e -> Pixel (Alpha (SRGB 'NonLinear)) e
$mPixelSRGBA :: forall r e.
Pixel (Alpha (SRGB 'NonLinear)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelSRGBA r g b a = Pixel (Alpha (SRGB (CM.ColorRGB r g b)) a)
{-# COMPLETE PixelSRGBA #-}
pattern PixelY :: e -> Pixel (Y i) e
pattern $bPixelY :: e -> Pixel (Y i) e
$mPixelY :: forall r k e (i :: k).
Pixel (Y i) e -> (e -> r) -> (Void# -> r) -> r
PixelY y = Pixel (Y y)
{-# COMPLETE PixelY #-}
pattern PixelYA :: e -> e -> Pixel (Alpha (Y i)) e
pattern $bPixelYA :: e -> e -> Pixel (Alpha (Y i)) e
$mPixelYA :: forall r k e (i :: k).
Pixel (Alpha (Y i)) e -> (e -> e -> r) -> (Void# -> r) -> r
PixelYA y a = Pixel (Alpha (Y y) a)
{-# COMPLETE PixelYA #-}
pattern PixelXYZ :: e -> e -> e -> Pixel (XYZ i) e
pattern $bPixelXYZ :: e -> e -> e -> Pixel (XYZ i) e
$mPixelXYZ :: forall r k e (i :: k).
Pixel (XYZ i) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelXYZ x y z = Pixel (XYZ (V3 x y z))
{-# COMPLETE PixelXYZ #-}
pattern PixelXYZA :: e -> e -> e -> e -> Pixel (Alpha (XYZ i)) e
pattern $bPixelXYZA :: e -> e -> e -> e -> Pixel (Alpha (XYZ i)) e
$mPixelXYZA :: forall r k e (i :: k).
Pixel (Alpha (XYZ i)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelXYZA x y z a = Pixel (Alpha (XYZ (V3 x y z)) a)
{-# COMPLETE PixelXYZA #-}
pattern PixelLAB :: e -> e -> e -> Pixel (LAB i) e
pattern $bPixelLAB :: e -> e -> e -> Pixel (LAB i) e
$mPixelLAB :: forall r k e (i :: k).
Pixel (LAB i) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelLAB l' a' b' = Pixel (LAB (V3 l' a' b'))
{-# COMPLETE PixelLAB #-}
pattern PixelLABA :: e -> e -> e -> e -> Pixel (Alpha (LAB i)) e
pattern $bPixelLABA :: e -> e -> e -> e -> Pixel (Alpha (LAB i)) e
$mPixelLABA :: forall r k e (i :: k).
Pixel (Alpha (LAB i)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelLABA l' a' b' a = Pixel (Alpha (LAB (V3 l' a' b')) a)
{-# COMPLETE PixelLABA #-}
pattern PixelRGB :: RedGreenBlue cs (i :: k) => e -> e -> e -> Pixel (cs l) e
pattern $bPixelRGB :: e -> e -> e -> Pixel (cs l) e
$mPixelRGB :: forall r k2 (cs :: Linearity -> *) k2 (i :: k2) e (l :: Linearity).
RedGreenBlue cs i =>
Pixel (cs l) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelRGB r g b <- (coerce . unColorRGB . coerce -> V3 r g b) where
PixelRGB e
r e
g e
b = Color (cs l) e -> Pixel (cs l) e
coerce (Color RGB e -> Color (cs l) e
forall k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
Color RGB e -> Color (cs l) e
mkColorRGB (V3 e -> Color RGB e
coerce (e -> e -> e -> V3 e
forall a. a -> a -> a -> V3 a
V3 e
r e
g e
b)))
{-# COMPLETE PixelRGB #-}
pattern PixelHSI :: e -> e -> e -> Pixel (HSI cs) e
pattern $bPixelHSI :: e -> e -> e -> Pixel (HSI cs) e
$mPixelHSI :: forall r k e (cs :: k).
Pixel (HSI cs) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelHSI h s i = Pixel (ColorHSI h s i)
{-# COMPLETE PixelHSI #-}
pattern PixelHSL :: e -> e -> e -> Pixel (HSL cs) e
pattern $bPixelHSL :: e -> e -> e -> Pixel (HSL cs) e
$mPixelHSL :: forall r k e (cs :: k).
Pixel (HSL cs) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelHSL h s l = Pixel (ColorHSL h s l)
{-# COMPLETE PixelHSL #-}
pattern PixelHSV :: e -> e -> e -> Pixel (HSV cs) e
pattern $bPixelHSV :: e -> e -> e -> Pixel (HSV cs) e
$mPixelHSV :: forall r k e (cs :: k).
Pixel (HSV cs) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelHSV h s v = Pixel (ColorHSV h s v)
{-# COMPLETE PixelHSV #-}
pattern PixelCMYK :: e -> e -> e -> e -> Pixel (CMYK cs) e
pattern $bPixelCMYK :: e -> e -> e -> e -> Pixel (CMYK cs) e
$mPixelCMYK :: forall r k e (cs :: k).
Pixel (CMYK cs) e -> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelCMYK c m y k = Pixel (ColorCMYK c m y k)
{-# COMPLETE PixelCMYK #-}
pattern PixelY'CbCr :: e -> e -> e -> Pixel (Y'CbCr cs) e
pattern $bPixelY'CbCr :: e -> e -> e -> Pixel (Y'CbCr cs) e
$mPixelY'CbCr :: forall r e (cs :: Linearity -> *).
Pixel (Y'CbCr cs) e -> (e -> e -> e -> r) -> (Void# -> r) -> r
PixelY'CbCr y cb cr = Pixel (ColorY'CbCr y cb cr)
{-# COMPLETE PixelY'CbCr #-}
pattern PixelY' :: e -> Pixel (Y' cs) e
pattern $bPixelY' :: e -> Pixel (Y' cs) e
$mPixelY' :: forall r e (cs :: Linearity -> *).
Pixel (Y' cs) e -> (e -> r) -> (Void# -> r) -> r
PixelY' y = Pixel (Y' y)
{-# COMPLETE PixelY' #-}
pattern PixelY'A :: e -> e -> Pixel (Alpha (Y' cs)) e
pattern $bPixelY'A :: e -> e -> Pixel (Alpha (Y' cs)) e
$mPixelY'A :: forall r e (cs :: Linearity -> *).
Pixel (Alpha (Y' cs)) e -> (e -> e -> r) -> (Void# -> r) -> r
PixelY'A y a = Pixel (Alpha (Y' y) a)
{-# COMPLETE PixelY'A #-}
pattern PixelRGBA :: RedGreenBlue cs i => e -> e -> e -> e -> Pixel (Alpha (cs l)) e
pattern $bPixelRGBA :: e -> e -> e -> e -> Pixel (Alpha (cs l)) e
$mPixelRGBA :: forall r k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
Pixel (Alpha (cs l)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelRGBA r g b a <- (pixelColor -> Alpha (unColorRGB -> CM.ColorRGB r g b) a) where
PixelRGBA e
r e
g e
b e
a = Color (Alpha (cs l)) e -> Pixel (Alpha (cs l)) e
forall cs e. Color cs e -> Pixel cs e
Pixel (Color (cs l) e -> e -> Color (Alpha (cs l)) e
forall cs e. Color cs e -> e -> Color (Alpha cs) e
Alpha (Color RGB e -> Color (cs l) e
forall k (cs :: Linearity -> *) (i :: k) e (l :: Linearity).
RedGreenBlue cs i =>
Color RGB e -> Color (cs l) e
mkColorRGB (e -> e -> e -> Color RGB e
forall e. e -> e -> e -> Color RGB e
CM.ColorRGB e
r e
g e
b)) e
a)
{-# COMPLETE PixelRGBA #-}
pattern PixelHSIA :: e -> e -> e -> e -> Pixel (Alpha (HSI cs)) e
pattern $bPixelHSIA :: e -> e -> e -> e -> Pixel (Alpha (HSI cs)) e
$mPixelHSIA :: forall r k e (cs :: k).
Pixel (Alpha (HSI cs)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelHSIA h s i a = Pixel (ColorHSIA h s i a)
{-# COMPLETE PixelHSIA #-}
pattern PixelHSLA :: e -> e -> e -> e -> Pixel (Alpha (HSL cs)) e
pattern $bPixelHSLA :: e -> e -> e -> e -> Pixel (Alpha (HSL cs)) e
$mPixelHSLA :: forall r k e (cs :: k).
Pixel (Alpha (HSL cs)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelHSLA h s l a = Pixel (ColorHSLA h s l a)
{-# COMPLETE PixelHSLA #-}
pattern PixelHSVA :: e -> e -> e -> e -> Pixel (Alpha (HSV cs)) e
pattern $bPixelHSVA :: e -> e -> e -> e -> Pixel (Alpha (HSV cs)) e
$mPixelHSVA :: forall r k e (cs :: k).
Pixel (Alpha (HSV cs)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelHSVA h s v a = Pixel (ColorHSVA h s v a)
{-# COMPLETE PixelHSVA #-}
pattern PixelCMYKA :: e -> e -> e -> e -> e -> Pixel (Alpha (CMYK cs)) e
pattern $bPixelCMYKA :: e -> e -> e -> e -> e -> Pixel (Alpha (CMYK cs)) e
$mPixelCMYKA :: forall r k e (cs :: k).
Pixel (Alpha (CMYK cs)) e
-> (e -> e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelCMYKA c m y k a = Pixel (ColorCMYKA c m y k a)
{-# COMPLETE PixelCMYKA #-}
pattern PixelY'CbCrA :: e -> e -> e -> e -> Pixel (Alpha (Y'CbCr cs)) e
pattern $bPixelY'CbCrA :: e -> e -> e -> e -> Pixel (Alpha (Y'CbCr cs)) e
$mPixelY'CbCrA :: forall r e (cs :: Linearity -> *).
Pixel (Alpha (Y'CbCr cs)) e
-> (e -> e -> e -> e -> r) -> (Void# -> r) -> r
PixelY'CbCrA y cb cr a = Pixel (ColorY'CbCrA y cb cr a)
{-# COMPLETE PixelY'CbCrA #-}
toPixelLinearRGB ::
(RedGreenBlue cs i, RealFloat e) => Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e
toPixelLinearRGB :: Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e
toPixelLinearRGB = (Color (cs 'NonLinear) e -> Color (cs 'Linear) e)
-> Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color (cs 'NonLinear) e -> Color (cs 'Linear) e
forall k (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'NonLinear) e -> Color (cs 'Linear) e
dcctf
{-# INLINE toPixelLinearRGB #-}
fromPixelLinearRGB ::
(RedGreenBlue cs i, RealFloat e) => Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e
fromPixelLinearRGB :: Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e
fromPixelLinearRGB = (Color (cs 'Linear) e -> Color (cs 'NonLinear) e)
-> Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color (cs 'Linear) e -> Color (cs 'NonLinear) e
forall k (cs :: Linearity -> *) e (i :: k).
(RedGreenBlue cs i, RealFloat e) =>
Color (cs 'Linear) e -> Color (cs 'NonLinear) e
ecctf
{-# INLINE fromPixelLinearRGB #-}
rgbPixelLuma ::
forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)
=> Pixel (cs 'NonLinear) e'
-> Pixel (Y' cs) e
rgbPixelLuma :: Pixel (cs 'NonLinear) e' -> Pixel (Y' cs) e
rgbPixelLuma = (Color (cs 'NonLinear) e' -> Color (Y' cs) e)
-> Pixel (cs 'NonLinear) e' -> Pixel (Y' cs) e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color (cs 'NonLinear) e' -> Color (Y' cs) e
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
toPixelY :: ColorSpace cs i e => Pixel cs e -> Pixel (Y i) e
toPixelY :: Pixel cs e -> Pixel (Y i) e
toPixelY = (Color cs e -> Color (Y i) e) -> Pixel cs e -> Pixel (Y i) e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((Double -> e) -> Color (Y i) Double -> Color (Y i) 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 i) Double -> Color (Y i) e)
-> (Color cs e -> Color (Y i) Double)
-> Color cs e
-> Color (Y i) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color cs e -> Color (Y i) Double
forall k cs (i :: k) e a.
(ColorSpace cs i e, Elevator a, RealFloat a) =>
Color cs e -> Color (Y i) a
luminance)
{-# INLINE toPixelY #-}
toPixelXYZ :: (ColorSpace cs i e, Elevator a, RealFloat a) => Pixel cs e -> Pixel (XYZ i) a
toPixelXYZ :: Pixel cs e -> Pixel (XYZ i) a
toPixelXYZ = (Color cs e -> Color (XYZ i) a) -> Pixel cs e -> Pixel (XYZ i) a
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel 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 toPixelXYZ #-}
fromPixelXYZ :: (ColorSpace cs i e, Elevator a, RealFloat a) => Pixel (XYZ i) a -> Pixel cs e
fromPixelXYZ :: Pixel (XYZ i) a -> Pixel cs e
fromPixelXYZ = (Color (XYZ i) a -> Color cs e) -> Pixel (XYZ i) a -> Pixel cs e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel 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
{-# INLINE fromPixelXYZ #-}
toPixelBaseModel :: ColorSpace cs i e => Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel :: Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel = (Color cs e -> Color (BaseModel cs) e)
-> Pixel cs e -> Pixel (BaseModel cs) e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color cs e -> Color (BaseModel cs) e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Color cs e -> Color (BaseModel cs) e
toBaseModel
{-# INLINE toPixelBaseModel #-}
fromPixelBaseModel :: ColorSpace cs i e => Pixel (BaseModel cs) e -> Pixel cs e
fromPixelBaseModel :: Pixel (BaseModel cs) e -> Pixel cs e
fromPixelBaseModel = (Color (BaseModel cs) e -> Color cs e)
-> Pixel (BaseModel cs) e -> Pixel cs e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color (BaseModel cs) e -> Color cs e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Color (BaseModel cs) e -> Color cs e
fromBaseModel
{-# INLINE fromPixelBaseModel #-}
toPixelBaseSpace ::
(ColorSpace cs i e, bcs ~ BaseSpace cs, ColorSpace bcs i e) => Pixel cs e -> Pixel bcs e
toPixelBaseSpace :: Pixel cs e -> Pixel bcs e
toPixelBaseSpace = (Color cs e -> Color bcs e) -> Pixel cs e -> Pixel bcs e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color cs e -> Color bcs e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color cs e -> Color (BaseSpace cs) e
toBaseSpace
{-# INLINE toPixelBaseSpace #-}
fromPixelBaseSpace ::
(ColorSpace cs i e, bcs ~ BaseSpace cs, ColorSpace bcs i e) => Pixel bcs e -> Pixel cs e
fromPixelBaseSpace :: Pixel bcs e -> Pixel cs e
fromPixelBaseSpace = (Color bcs e -> Color cs e) -> Pixel bcs e -> Pixel cs e
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color bcs e -> Color cs e
forall k cs (i :: k) e.
(ColorSpace cs i e, ColorSpace (BaseSpace cs) i e) =>
Color (BaseSpace cs) e -> Color cs e
fromBaseSpace
{-# INLINE fromPixelBaseSpace #-}