{-# 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 $mColorCMYKA :: forall {r} {e}.
Color (Alpha CMYK) e
-> (e -> e -> e -> e -> e -> r) -> ((# #) -> r) -> r
$bColorCMYKA :: forall e. e -> e -> e -> e -> e -> Color (Alpha CMYK) e
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 :: Int -> Color CMYK e -> ShowS
showsPrec Int
_ = Color CMYK e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | `CMYK` color model
instance Elevator e => ColorModel CMYK e where
  type Components CMYK e = (e, e, e, e)
  type ChannelCount CMYK = 4
  channelCount :: Proxy (Color CMYK e) -> Word8
channelCount Proxy (Color CMYK e)
_ = Word8
4
  {-# INLINE channelCount #-}
  channelNames :: Proxy (Color CMYK e) -> NonEmpty String
channelNames Proxy (Color CMYK e)
_ = String
"Cyan" String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String
"Magenta", String
"Yellow", String
"Key"]
  channelColors :: Proxy (Color CMYK e) -> NonEmpty (V3 Word8)
channelColors Proxy (Color CMYK e)
_ = Word8 -> Word8 -> Word8 -> V3 Word8
forall a. a -> a -> a -> V3 a
V3 Word8
0x00 Word8
0xff Word8
0xff V3 Word8 -> [V3 Word8] -> NonEmpty (V3 Word8)
forall a. a -> [a] -> NonEmpty a
:|
                  [ Word8 -> Word8 -> Word8 -> V3 Word8
forall a. a -> a -> a -> V3 a
V3 Word8
0xff Word8
0x00 Word8
0xff
                  , Word8 -> Word8 -> Word8 -> V3 Word8
forall a. a -> a -> a -> V3 a
V3 Word8
0xff Word8
0xff Word8
0x00
                  , Word8 -> Word8 -> Word8 -> V3 Word8
forall a. a -> a -> a -> V3 a
V3 Word8
0xff Word8
0xff Word8
0xff ]
  toComponents :: Color CMYK e -> Components CMYK e
toComponents (ColorCMYK e
c e
m e
y e
k) = (e
c, e
m, e
y, e
k)
  {-# INLINE toComponents #-}
  fromComponents :: Components CMYK e -> Color CMYK e
fromComponents (e
c, e
m, e
y, e
k) = e -> e -> e -> e -> Color CMYK e
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK e
c e
m e
y e
k
  {-# INLINE fromComponents #-}

-- | `CMYK` color model
instance Functor (Color CMYK) where
  fmap :: forall a b. (a -> b) -> Color CMYK a -> Color CMYK b
fmap a -> b
f (ColorCMYK a
c a
m a
y a
k) = b -> b -> b -> b -> Color CMYK b
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK (a -> b
f a
c) (a -> b
f a
m) (a -> b
f a
y) (a -> b
f a
k)
  {-# INLINE fmap #-}

-- | `CMYK` color model
instance Applicative (Color CMYK) where
  pure :: forall a. a -> Color CMYK a
pure !a
e = a -> a -> a -> a -> Color CMYK a
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK a
e a
e a
e a
e
  {-# INLINE pure #-}
  ColorCMYK a -> b
fc a -> b
fm a -> b
fy a -> b
fk <*> :: forall a b. Color CMYK (a -> b) -> Color CMYK a -> Color CMYK b
<*> ColorCMYK a
c a
m a
y a
k = b -> b -> b -> b -> Color CMYK b
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK (a -> b
fc a
c) (a -> b
fm a
m) (a -> b
fy a
y) (a -> b
fk a
k)
  {-# INLINE (<*>) #-}

-- | `CMYK` color model
instance Foldable (Color CMYK) where
  foldr :: forall a b. (a -> b -> b) -> b -> Color CMYK a -> b
foldr a -> b -> b
f !b
z (ColorCMYK a
c a
m a
y a
k) = a -> b -> b
f a
c (a -> b -> b
f a
m (a -> b -> b
f a
y (a -> b -> b
f a
k b
z)))
  {-# INLINE foldr #-}

-- | `CMYK` color model
instance Traversable (Color CMYK) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Color CMYK a -> f (Color CMYK b)
traverse a -> f b
f (ColorCMYK a
c a
m a
y a
k) = b -> b -> b -> b -> Color CMYK b
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK (b -> b -> b -> b -> Color CMYK b)
-> f b -> f (b -> b -> b -> Color CMYK b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
c f (b -> b -> b -> Color CMYK b)
-> f b -> f (b -> b -> Color CMYK b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
m f (b -> b -> Color CMYK b) -> f b -> f (b -> Color CMYK b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
y f (b -> Color CMYK b) -> f b -> f (Color CMYK b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
k
  {-# INLINE traverse #-}

-- | `CMYK` color model
instance Storable e => Storable (Color CMYK e) where
  sizeOf :: Color CMYK e -> Int
sizeOf = Int -> Color CMYK e -> Int
forall cs e. Storable e => Int -> Color cs e -> Int
sizeOfN Int
4
  {-# INLINE sizeOf #-}
  alignment :: Color CMYK e -> Int
alignment = Int -> Color CMYK e -> Int
forall cs e. Storable e => Int -> Color cs e -> Int
alignmentN Int
4
  {-# INLINE alignment #-}
  peek :: Ptr (Color CMYK e) -> IO (Color CMYK e)
peek = (e -> e -> e -> e -> Color CMYK e)
-> Ptr (Color CMYK e) -> IO (Color CMYK e)
forall cs e.
Storable e =>
(e -> e -> e -> e -> Color cs e)
-> Ptr (Color cs e) -> IO (Color cs e)
peek4 e -> e -> e -> e -> Color CMYK e
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK
  {-# INLINE peek #-}
  poke :: Ptr (Color CMYK e) -> Color CMYK e -> IO ()
poke Ptr (Color CMYK e)
p (ColorCMYK e
c e
m e
y e
k) = Ptr (Color CMYK e) -> e -> e -> e -> e -> IO ()
forall cs e.
Storable e =>
Ptr (Color cs e) -> e -> e -> e -> e -> IO ()
poke4 Ptr (Color CMYK e)
p e
c e
m e
y e
k
  {-# INLINE poke #-}

cmyk2rgb :: (RealFloat e, Elevator e) => Color CMYK e -> Color RGB e
cmyk2rgb :: forall e. (RealFloat e, Elevator e) => Color CMYK e -> Color RGB e
cmyk2rgb (ColorCMYK e
c e
m e
y e
k) = e -> e -> e -> Color RGB e
forall e. e -> e -> e -> Color RGB e
ColorRGB (e -> e
forall a. RealFloat a => a -> a
clamp01 e
r) (e -> e
forall a. RealFloat a => a -> a
clamp01 e
g) (e -> e
forall a. RealFloat a => a -> a
clamp01 e
b)
  where
    !k' :: e
k' = e
forall e. Elevator e => e
maxValue e -> e -> e
forall a. Num a => a -> a -> a
- e
k
    !r :: e
r = (e
forall e. Elevator e => e
maxValue e -> e -> e
forall a. Num a => a -> a -> a
- e
c) e -> e -> e
forall a. Num a => a -> a -> a
* e
k'
    !g :: e
g = (e
forall e. Elevator e => e
maxValue e -> e -> e
forall a. Num a => a -> a -> a
- e
m) e -> e -> e
forall a. Num a => a -> a -> a
* e
k'
    !b :: e
b = (e
forall e. Elevator e => e
maxValue e -> e -> e
forall a. Num a => a -> a -> a
- e
y) e -> e -> e
forall a. Num a => a -> a -> a
* e
k'
{-# INLINE cmyk2rgb #-}


rgb2cmyk :: (RealFloat e, Elevator e) => Color RGB e -> Color CMYK e
rgb2cmyk :: forall e. (RealFloat e, Elevator e) => Color RGB e -> Color CMYK e
rgb2cmyk (ColorRGB e
r e
g e
b) = e -> e -> e -> e -> Color CMYK e
forall e. e -> e -> e -> e -> Color CMYK e
ColorCMYK e
c e
m e
y e
k
  where
    !c :: e
c = (e
k' e -> e -> e
forall a. Num a => a -> a -> a
- e
r) e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
k'
    !m :: e
m = (e
k' e -> e -> e
forall a. Num a => a -> a -> a
- e
g) e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
k'
    !y :: e
y = (e
k' e -> e -> e
forall a. Num a => a -> a -> a
- e
b) e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
k'
    !k :: e
k = e
forall e. Elevator e => e
maxValue e -> e -> e
forall a. Num a => a -> a -> a
- e
k'
    !k' :: e
k' = e -> e -> e
forall a. Ord a => a -> a -> a
max e
r (e -> e -> e
forall a. Ord a => a -> a -> a
max e
g e
b)
{-# INLINE rgb2cmyk #-}