{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Pixel
-- Copyright   : (c) Alexey Kuleshevich 2019-2025
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Pixel
  ( Pixel(Pixel, PixelX, PixelRGB, PixelHSI, PixelHSL, PixelHSV,
      PixelCMYK, PixelYCbCr, PixelXA, PixelRGBA, PixelHSIA, PixelHSLA,
      PixelHSVA, PixelCMYKA, PixelYCbCrA)
  , liftPixel
  , pixelColor
  -- * Elevation
  , toPixel8
  , toPixel16
  , toPixel32
  , toPixel64
  , toPixelF
  , toPixelD
  , module Graphics.Color.Model
  , module Graphics.Color.Algebra.Binary
  ) where

import Graphics.Color.Algebra.Binary
import Graphics.Color.Model
import Graphics.Pixel.Internal

-- | Constructor for a grayscale pixel with single channel.
--
-- @since 0.1.0
pattern PixelX :: e -> Pixel X e
pattern $mPixelX :: forall {r} {e}. Pixel X e -> (e -> r) -> ((# #) -> r) -> r
$bPixelX :: forall e. e -> Pixel X e
PixelX y = Pixel (ColorX y)
{-# COMPLETE PixelX #-}

-- | Constructor for a pixel with @RGB@ color model.
--
-- @since 0.1.0
pattern PixelRGB :: e -> e -> e -> Pixel RGB e
pattern $mPixelRGB :: forall {r} {e}.
Pixel RGB e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelRGB :: forall e. e -> e -> e -> Pixel RGB e
PixelRGB r g b = Pixel (ColorRGB r g b)
{-# COMPLETE PixelRGB #-}

-- | Constructor for Pixel with @HSI@ color model.
--
-- @since 0.1.0
pattern PixelHSI :: e -> e -> e -> Pixel HSI e
pattern $mPixelHSI :: forall {r} {e}.
Pixel HSI e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelHSI :: forall e. e -> e -> e -> Pixel HSI e
PixelHSI h s i = Pixel (ColorHSI h s i)
{-# COMPLETE PixelHSI #-}

-- | Constructor for Pixel with @HSL@ color model.
--
-- @since 0.1.0
pattern PixelHSL :: e -> e -> e -> Pixel HSL e
pattern $mPixelHSL :: forall {r} {e}.
Pixel HSL e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelHSL :: forall e. e -> e -> e -> Pixel HSL e
PixelHSL h s l = Pixel (ColorHSL h s l)
{-# COMPLETE PixelHSL #-}

-- | Constructor for Pixel with @HSV@ color model.
--
-- @since 0.1.0
pattern PixelHSV :: e -> e -> e -> Pixel HSV e
pattern $mPixelHSV :: forall {r} {e}.
Pixel HSV e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelHSV :: forall e. e -> e -> e -> Pixel HSV e
PixelHSV h s v = Pixel (ColorHSV h s v)
{-# COMPLETE PixelHSV #-}

-- | Constructor for a pixel with @CMYK@ color model.
--
-- @since 0.1.0
pattern PixelCMYK :: e -> e -> e -> e -> Pixel CMYK e
pattern $mPixelCMYK :: forall {r} {e}.
Pixel CMYK e -> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelCMYK :: forall e. e -> e -> e -> e -> Pixel CMYK e
PixelCMYK c m y k = Pixel (ColorCMYK c m y k)
{-# COMPLETE PixelCMYK #-}

-- | Constructor for a pixel with @YCbCr@ color model.
--
-- @since 0.1.0
pattern PixelYCbCr :: e -> e -> e -> Pixel YCbCr e
pattern $mPixelYCbCr :: forall {r} {e}.
Pixel YCbCr e -> (e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelYCbCr :: forall e. e -> e -> e -> Pixel YCbCr e
PixelYCbCr y cb cr = Pixel (ColorYCbCr y cb cr)
{-# COMPLETE PixelYCbCr #-}


-- | Constructor for a grayscale pixel with a transparency channel.
--
-- @since 0.1.0
pattern PixelXA :: e -> e -> Pixel (Alpha X) e
pattern $mPixelXA :: forall {r} {e}.
Pixel (Alpha X) e -> (e -> e -> r) -> ((# #) -> r) -> r
$bPixelXA :: forall e. e -> e -> Pixel (Alpha X) e
PixelXA y a = Pixel (Alpha (ColorX y) a)
{-# COMPLETE PixelXA #-}

-- | Constructor for a pixel with @RGB@ color model and Alpha channel.
--
-- @since 0.1.0
pattern PixelRGBA :: e -> e -> e -> e -> Pixel (Alpha RGB) e
pattern $mPixelRGBA :: forall {r} {e}.
Pixel (Alpha RGB) e -> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelRGBA :: forall e. e -> e -> e -> e -> Pixel (Alpha RGB) e
PixelRGBA r g b a = Pixel (Alpha (ColorRGB r g b) a)
{-# COMPLETE PixelRGBA #-}

-- | Constructor for a pixel with @HSI@ color model and Alpha channel.
--
-- @since 0.1.0
pattern PixelHSIA :: e -> e -> e -> e -> Pixel (Alpha HSI) e
pattern $mPixelHSIA :: forall {r} {e}.
Pixel (Alpha HSI) e -> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelHSIA :: forall e. e -> e -> e -> e -> Pixel (Alpha HSI) e
PixelHSIA h s i a = Pixel (Alpha (ColorHSI h s i) a)
{-# COMPLETE PixelHSIA #-}

-- | Constructor for a pixel with @HSL@ color model and Alpha channel.
--
-- @since 0.1.0
pattern PixelHSLA :: e -> e -> e -> e -> Pixel (Alpha HSL) e
pattern $mPixelHSLA :: forall {r} {e}.
Pixel (Alpha HSL) e -> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelHSLA :: forall e. e -> e -> e -> e -> Pixel (Alpha HSL) e
PixelHSLA h s l a = Pixel (Alpha (ColorHSL h s l) a)
{-# COMPLETE PixelHSLA #-}

-- | Constructor for a pixel with @HSV@ color model and Alpha channel.
--
-- @since 0.1.0
pattern PixelHSVA :: e -> e -> e -> e -> Pixel (Alpha HSV) e
pattern $mPixelHSVA :: forall {r} {e}.
Pixel (Alpha HSV) e -> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelHSVA :: forall e. e -> e -> e -> e -> Pixel (Alpha HSV) e
PixelHSVA h s v a = Pixel (Alpha (ColorHSV h s v) a)
{-# COMPLETE PixelHSVA #-}


-- | Constructor for a pixel with @CMYK@ color model and Alpha channel.
--
-- @since 0.1.0
pattern PixelCMYKA :: e -> e -> e -> e -> e -> Pixel (Alpha CMYK) e
pattern $mPixelCMYKA :: forall {r} {e}.
Pixel (Alpha CMYK) e
-> (e -> e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelCMYKA :: forall e. e -> e -> e -> e -> e -> Pixel (Alpha CMYK) e
PixelCMYKA c m y k a = Pixel (Alpha (ColorCMYK c m y k) a)
{-# COMPLETE PixelCMYKA #-}

-- | Constructor for a pixel with @YCbCr@ color model and Alpha channel.
--
-- @since 0.1.0
pattern PixelYCbCrA :: e -> e -> e -> e -> Pixel (Alpha YCbCr) e
pattern $mPixelYCbCrA :: forall {r} {e}.
Pixel (Alpha YCbCr) e
-> (e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bPixelYCbCrA :: forall e. e -> e -> e -> e -> Pixel (Alpha YCbCr) e
PixelYCbCrA y cb cr a = Pixel (Alpha (ColorYCbCr y cb cr) a)
{-# COMPLETE PixelYCbCrA #-}