{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Model.CMYK
( CMYK
, pattern ColorCMYK
, pattern ColorCMYKA
, Color
, ColorModel(..)
, cmyk2rgb
, rgb2cmyk
) where
import Foreign.Storable
import Graphics.Color.Model.Alpha
import Graphics.Color.Model.Internal
import Graphics.Color.Model.RGB
data CMYK
data instance Color CMYK e = ColorCMYK !e !e !e !e
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 #-}
deriving instance Eq e => Eq (Color CMYK e)
deriving instance Ord e => Ord (Color CMYK e)
instance Elevator e => Show (Color CMYK e) where
showsPrec _ = showsColorModel
instance Elevator e => ColorModel CMYK e where
type Components CMYK e = (e, e, e, e)
toComponents (ColorCMYK c m y k) = (c, m, y, k)
{-# INLINE toComponents #-}
fromComponents (c, m, y, k) = ColorCMYK c m y k
{-# INLINE fromComponents #-}
instance Functor (Color CMYK) where
fmap f (ColorCMYK c m y k) = ColorCMYK (f c) (f m) (f y) (f k)
{-# INLINE fmap #-}
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 (<*>) #-}
instance Foldable (Color CMYK) where
foldr f !z (ColorCMYK c m y k) = f c (f m (f y (f k z)))
{-# INLINE foldr #-}
instance Traversable (Color CMYK) where
traverse f (ColorCMYK c m y k) = ColorCMYK <$> f c <*> f m <*> f y <*> f k
{-# INLINE traverse #-}
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 #-}