{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Graphics.Pixel.ColorSpace
( Pixel(Pixel, PixelY, PixelXYZ, PixelRGB, PixelHSI, PixelHSL, PixelHSV,
PixelCMYK, PixelYCbCr, PixelY', PixelYA, PixelXYZA, PixelRGBA, PixelHSIA, PixelHSLA,
PixelHSVA, PixelCMYKA, PixelYCbCrA, PixelY'A)
, liftPixel
, pixelColor
, convertPixel
, toPixelY
, toPixelXYZ
, fromPixelXYZ
, toPixelBaseSpace
, fromPixelBaseSpace
, toPixelBaseModel
, fromPixelBaseModel
, toPixel8
, toPixel16
, toPixel32
, toPixel64
, toPixelF
, toPixelD
, toPixelLinearRGB
, fromPixelLinearRGB
, pattern PixelSRGB
, pattern PixelSRGBA
, SRGB
, D65
, AdobeRGB
, rgbPixelLuma
, module Graphics.Color.Space
, module Graphics.Color.Space.RGB.Luma
, module Graphics.Color.Space.RGB.Alternative
, module Graphics.Color.Algebra.Binary
) where
import Data.Coerce
import Graphics.Color.Adaptation.VonKries
import Graphics.Color.Model.Internal
import Graphics.Color.Algebra.Binary
import qualified Graphics.Color.Model.RGB as CM
import Graphics.Color.Space
import Graphics.Color.Space.RGB.AdobeRGB
import Graphics.Color.Space.RGB.Alternative
import Graphics.Color.Space.RGB.SRGB
import Graphics.Color.Space.RGB.Luma
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 = liftPixel convert
{-# INLINE convertPixel #-}
pattern PixelSRGB :: e -> e -> e -> Pixel (SRGB 'NonLinear) e
pattern 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 PixelSRGBA r g b a = Pixel (Alpha (SRGB (CM.ColorRGB r g b)) a)
{-# COMPLETE PixelSRGBA #-}
pattern PixelY :: e -> Pixel (Y i) e
pattern PixelY y = Pixel (Y y)
{-# COMPLETE PixelY #-}
pattern PixelYA :: e -> e -> Pixel (Alpha (Y i)) e
pattern PixelYA y a = Pixel (Alpha (Y y) a)
{-# COMPLETE PixelYA #-}
pattern PixelXYZ :: e -> e -> e -> Pixel (XYZ i) e
pattern PixelXYZ x y z = Pixel (XYZ (V3 x y z))
{-# COMPLETE PixelXYZ #-}
pattern PixelXYZA :: e -> e -> e -> e -> Pixel (Alpha (XYZ i)) e
pattern PixelXYZA x y z a = Pixel (Alpha (XYZ (V3 x y z)) a)
{-# COMPLETE PixelXYZA #-}
pattern PixelRGB :: RedGreenBlue cs (i :: k) => e -> e -> e -> Pixel (cs l) e
pattern PixelRGB r g b <- (coerce . unColorRGB . coerce -> V3 r g b) where
PixelRGB r g b = coerce (mkColorRGB (coerce (V3 r g b)))
{-# COMPLETE PixelRGB #-}
pattern PixelHSI :: e -> e -> e -> Pixel (HSI cs) e
pattern PixelHSI h s i = Pixel (ColorHSI h s i)
{-# COMPLETE PixelHSI #-}
pattern PixelHSL :: e -> e -> e -> Pixel (HSL cs) e
pattern PixelHSL h s l = Pixel (ColorHSL h s l)
{-# COMPLETE PixelHSL #-}
pattern PixelHSV :: e -> e -> e -> Pixel (HSV cs) e
pattern PixelHSV h s v = Pixel (ColorHSV h s v)
{-# COMPLETE PixelHSV #-}
pattern PixelCMYK :: e -> e -> e -> e -> Pixel (CMYK cs) e
pattern PixelCMYK c m y k = Pixel (ColorCMYK c m y k)
{-# COMPLETE PixelCMYK #-}
pattern PixelYCbCr :: e -> e -> e -> Pixel (YCbCr cs) e
pattern PixelYCbCr y cb cr = Pixel (ColorYCbCr y cb cr)
{-# COMPLETE PixelYCbCr #-}
pattern PixelY' :: e -> Pixel Y' e
pattern PixelY' y = Pixel (Y' y)
{-# COMPLETE PixelY' #-}
pattern PixelY'A :: e -> e -> Pixel (Alpha Y') e
pattern 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 PixelRGBA r g b a <- (pixelColor -> Alpha (unColorRGB -> CM.ColorRGB r g b) a) where
PixelRGBA r g b a = Pixel (Alpha (mkColorRGB (CM.ColorRGB r g b)) a)
{-# COMPLETE PixelRGBA #-}
pattern PixelHSIA :: e -> e -> e -> e -> Pixel (Alpha (HSI cs)) e
pattern 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 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 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 PixelCMYKA c m y k a = Pixel (ColorCMYKA c m y k a)
{-# COMPLETE PixelCMYKA #-}
pattern PixelYCbCrA :: e -> e -> e -> e -> Pixel (Alpha (YCbCr cs)) e
pattern PixelYCbCrA y cb cr a = Pixel (ColorYCbCrA y cb cr a)
{-# COMPLETE PixelYCbCrA #-}
toPixelLinearRGB ::
(RedGreenBlue cs i, Elevator e, RealFloat e) => Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e
toPixelLinearRGB = liftPixel dcctf
{-# INLINE toPixelLinearRGB #-}
fromPixelLinearRGB ::
(RedGreenBlue cs i, Elevator e, RealFloat e) => Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e
fromPixelLinearRGB = liftPixel 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' e
rgbPixelLuma = liftPixel rgbLuma
toPixelY :: ColorSpace cs i e => Pixel cs e -> Pixel (Y i) e
toPixelY = liftPixel (fmap fromDouble . luminance)
{-# INLINE toPixelY #-}
toPixelXYZ :: (ColorSpace cs i e, Elevator a, RealFloat a) => Pixel cs e -> Pixel (XYZ i) a
toPixelXYZ = liftPixel toColorXYZ
{-# INLINE toPixelXYZ #-}
fromPixelXYZ :: (ColorSpace cs i e, Elevator a, RealFloat a) => Pixel (XYZ i) a -> Pixel cs e
fromPixelXYZ = liftPixel fromColorXYZ
{-# INLINE fromPixelXYZ #-}
toPixelBaseModel :: ColorSpace cs i e => Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel = liftPixel toBaseModel
{-# INLINE toPixelBaseModel #-}
fromPixelBaseModel :: ColorSpace cs i e => Pixel (BaseModel cs) e -> Pixel cs e
fromPixelBaseModel = liftPixel fromBaseModel
{-# INLINE fromPixelBaseModel #-}
toPixelBaseSpace ::
(ColorSpace cs i e, bcs ~ BaseSpace cs, ColorSpace bcs i e) => Pixel cs e -> Pixel bcs e
toPixelBaseSpace = liftPixel toBaseSpace
{-# INLINE toPixelBaseSpace #-}
fromPixelBaseSpace ::
(ColorSpace cs i e, bcs ~ BaseSpace cs, ColorSpace bcs i e) => Pixel bcs e -> Pixel cs e
fromPixelBaseSpace = liftPixel fromBaseSpace
{-# INLINE fromPixelBaseSpace #-}