{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Color.Model.CMYK
-- Copyright   : (c) Alexey Kuleshevich 2018-2020
-- 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 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 $bColorCMYKA :: e -> e -> e -> e -> e -> Color (Alpha CMYK) e
$mColorCMYKA :: forall r e.
Color (Alpha CMYK) e
-> (e -> e -> e -> e -> e -> r) -> (Void# -> r) -> r
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)
  toComponents :: Color CMYK e -> Components CMYK e
toComponents (ColorCMYK c m y k) = (e
c, e
m, e
y, e
k)
  {-# INLINE toComponents #-}
  fromComponents :: Components CMYK e -> Color CMYK e
fromComponents (c, m, y, 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 :: (a -> b) -> Color CMYK a -> Color CMYK b
fmap a -> b
f (ColorCMYK c m y 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 :: 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 fc fm fy fk) <*> :: Color CMYK (a -> b) -> Color CMYK a -> Color CMYK b
<*> (ColorCMYK c m y 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 :: (a -> b -> b) -> b -> Color CMYK a -> b
foldr a -> b -> b
f !b
z (ColorCMYK c m y 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 :: (a -> f b) -> Color CMYK a -> f (Color CMYK b)
traverse a -> f b
f (ColorCMYK c m y 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 (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 (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 (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 c m y 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 :: Color CMYK e -> Color RGB e
cmyk2rgb (ColorCMYK c m y 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 :: 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 #-}