content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TypeFamilies #-}
  -- |
  -- Module      : Graphics.Color.Model.CMYK
  -- Copyright   : (c) Alexey Kuleshevich 2018-2025
  -- License     : BSD3
  -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
  -- Stability   : experimental
  -- Portability : non-portable
  --
  module Graphics.Color.Model.CMYK
    ( CMYK
      -- * Constructors for an CMYK color model.
    , pattern ColorCMYK
    , pattern ColorCMYKA
    , Color
    , ColorModel(..)
    , cmyk2rgb
    , rgb2cmyk
    ) where
  
  import Data.List.NonEmpty
  import Foreign.Storable
  import Graphics.Color.Model.Internal
  import Graphics.Color.Model.RGB
  
  ------------
  --- CMYK ---
  ------------
  
  data CMYK
  
  -- | `CMYK` color model
  data instance Color CMYK e = ColorCMYK !e !e !e !e
  
  -- | Constructor for @CMYK@ with alpha channel.
  pattern ColorCMYKA :: e -> e -> e -> e -> e -> Color (Alpha CMYK) e
  pattern ColorCMYKA c m y k a = Alpha (ColorCMYK c m y k) a
  {-# COMPLETE ColorCMYKA #-}
  
  -- | `CMYK` color model
  deriving instance Eq e => Eq (Color CMYK e)
  -- | `CMYK` color model
  deriving instance Ord e => Ord (Color CMYK e)
  
  -- | `CMYK` color model
  instance Elevator e => Show (Color CMYK e) where
    showsPrec _ = showsColorModel
  
  -- | `CMYK` color model
  instance Elevator e => ColorModel CMYK e where
    type Components CMYK e = (e, e, e, e)
    type ChannelCount CMYK = 4
    channelCount _ = 4
    {-# INLINE channelCount #-}
    channelNames _ = "Cyan" :| ["Magenta", "Yellow", "Key"]
    channelColors _ = V3 0x00 0xff 0xff :|
                    [ V3 0xff 0x00 0xff
                    , V3 0xff 0xff 0x00
                    , V3 0xff 0xff 0xff ]
    toComponents (ColorCMYK c m y k) = (c, m, y, k)
    {-# INLINE toComponents #-}
    fromComponents (c, m, y, k) = ColorCMYK c m y k
    {-# INLINE fromComponents #-}
  
  -- | `CMYK` color model
  instance Functor (Color CMYK) where
    fmap f (ColorCMYK c m y k) = ColorCMYK (f c) (f m) (f y) (f k)
    {-# INLINE fmap #-}
  
  -- | `CMYK` color model
  instance Applicative (Color CMYK) where
    pure !e = ColorCMYK e e e e
    {-# INLINE pure #-}
    ColorCMYK fc fm fy fk <*> ColorCMYK c m y k = ColorCMYK (fc c) (fm m) (fy y) (fk k)
    {-# INLINE (<*>) #-}
  
  -- | `CMYK` color model
  instance Foldable (Color CMYK) where
    foldr f !z (ColorCMYK c m y k) = f c (f m (f y (f k z)))
    {-# INLINE foldr #-}
  
  -- | `CMYK` color model
  instance Traversable (Color CMYK) where
    traverse f (ColorCMYK c m y k) = ColorCMYK <$> f c <*> f m <*> f y <*> f k
    {-# INLINE traverse #-}
  
  -- | `CMYK` color model
  instance Storable e => Storable (Color CMYK e) where
    sizeOf = sizeOfN 4
    {-# INLINE sizeOf #-}
    alignment = alignmentN 4
    {-# INLINE alignment #-}
    peek = peek4 ColorCMYK
    {-# INLINE peek #-}
    poke p (ColorCMYK c m y k) = poke4 p c m y k
    {-# INLINE poke #-}
  
  cmyk2rgb :: (RealFloat e, Elevator e) => Color CMYK e -> Color RGB e
  cmyk2rgb (ColorCMYK c m y k) = ColorRGB (clamp01 r) (clamp01 g) (clamp01 b)
    where
      !k' = maxValue - k
      !r = (maxValue - c) * k'
      !g = (maxValue - m) * k'
      !b = (maxValue - y) * k'
  {-# INLINE cmyk2rgb #-}
  
  
  rgb2cmyk :: (RealFloat e, Elevator e) => Color RGB e -> Color CMYK e
  rgb2cmyk (ColorRGB r g b) = ColorCMYK c m y k
    where
      !c = (k' - r) / k'
      !m = (k' - g) / k'
      !y = (k' - b) / k'
      !k = maxValue - k'
      !k' = max r (max g b)
  {-# INLINE rgb2cmyk #-}
  