module Graphics.Image.ColorSpace.CMYK (
CMYK(..), CMYKA(..), Pixel(..),
ToCMYK(..), ToCMYKA(..)
) where
import Prelude hiding (map)
import Control.Applicative
import Data.Foldable
import Data.Typeable (Typeable)
import Foreign.Ptr
import Foreign.Storable
import Graphics.Image.Interface
data CMYK = CyanCMYK
| MagCMYK
| YelCMYK
| KeyCMYK
deriving (Eq, Enum, Typeable)
instance Show CMYK where
show CyanCMYK = "Cyan"
show MagCMYK = "Magenta"
show YelCMYK = "Yellow"
show KeyCMYK = "Black"
instance Show e => Show (Pixel CMYK e) where
show (PixelCMYK c m y k) = "<CMYK:("++show c++"|"++show m++"|"++show y++"|"++show k++")>"
data instance Pixel CMYK e = PixelCMYK !e !e !e !e deriving Eq
instance (Elevator e, Typeable e) => ColorSpace CMYK e where
type Components CMYK e = (e, e, e, e)
fromComponents !(c, m, y, k) = PixelCMYK c m y k
toComponents (PixelCMYK c m y k) = (c, m, y, k)
broadcastC !e = PixelCMYK e e e e
getPxC (PixelCMYK c _ _ _) CyanCMYK = c
getPxC (PixelCMYK _ m _ _) MagCMYK = m
getPxC (PixelCMYK _ _ y _) YelCMYK = y
getPxC (PixelCMYK _ _ _ k) KeyCMYK = k
setPxC (PixelCMYK _ m y k) CyanCMYK c = PixelCMYK c m y k
setPxC (PixelCMYK c _ y k) MagCMYK m = PixelCMYK c m y k
setPxC (PixelCMYK c m _ k) YelCMYK y = PixelCMYK c m y k
setPxC (PixelCMYK c m y _) KeyCMYK k = PixelCMYK c m y k
mapPxC f (PixelCMYK c m y k) =
PixelCMYK (f CyanCMYK c) (f MagCMYK m) (f YelCMYK y) (f KeyCMYK k)
mapPx = fmap
zipWithPx = liftA2
foldlPx = foldl'
instance Functor (Pixel CMYK) where
fmap f (PixelCMYK c m y k) = PixelCMYK (f c) (f m) (f y) (f k)
instance Applicative (Pixel CMYK) where
pure !e = PixelCMYK e e e e
(PixelCMYK fc fm fy fk) <*> (PixelCMYK c m y k) = PixelCMYK (fc c) (fm m) (fy y) (fk k)
instance Foldable (Pixel CMYK) where
foldr f !z (PixelCMYK c m y k) = f c (f m (f y (f k z)))
instance Num e => Num (Pixel CMYK e) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
abs = liftA abs
signum = liftA signum
fromInteger = pure . fromInteger
instance Fractional e => Fractional (Pixel CMYK e) where
(/) = liftA2 (/)
recip = liftA recip
fromRational = pure . fromRational
instance Floating e => Floating (Pixel CMYK e) where
pi = pure pi
exp = liftA exp
log = liftA log
sin = liftA sin
cos = liftA cos
asin = liftA asin
atan = liftA atan
acos = liftA acos
sinh = liftA sinh
cosh = liftA cosh
asinh = liftA asinh
atanh = liftA atanh
acosh = liftA acosh
instance Storable e => Storable (Pixel CMYK e) where
sizeOf _ = 3 * sizeOf (undefined :: e)
alignment _ = alignment (undefined :: e)
peek p = do
q <- return $ castPtr p
c <- peek q
m <- peekElemOff q 1
y <- peekElemOff q 2
k <- peekElemOff q 3
return (PixelCMYK c m y k)
poke p (PixelCMYK c m y k) = do
q <- return $ castPtr p
poke q c
pokeElemOff q 1 m
pokeElemOff q 2 y
pokeElemOff q 3 k
data CMYKA = CyanCMYKA
| MagCMYKA
| YelCMYKA
| KeyCMYKA
| AlphaCMYKA
deriving (Eq, Enum, Typeable)
class ColorSpace cs Double => ToCMYK cs where
toPixelCMYK :: Pixel cs Double -> Pixel CMYK Double
toImageCMYK :: (Array arr cs Double, Array arr CMYK Double) =>
Image arr cs Double
-> Image arr CMYK Double
toImageCMYK = map toPixelCMYK
class (ToCMYK (Opaque cs), AlphaSpace cs Double) => ToCMYKA cs where
toPixelCMYKA :: Pixel cs Double -> Pixel CMYKA Double
toPixelCMYKA px = addAlpha (getAlpha px) (toPixelCMYK (dropAlpha px))
toImageCMYKA :: (Array arr cs Double, Array arr CMYKA Double) =>
Image arr cs Double
-> Image arr CMYKA Double
toImageCMYKA = map toPixelCMYKA
data instance Pixel CMYKA e = PixelCMYKA !e !e !e !e !e deriving Eq
instance Show CMYKA where
show CyanCMYKA = "Cyan"
show MagCMYKA = "Magenta"
show YelCMYKA = "Yellow"
show KeyCMYKA = "Black"
show AlphaCMYKA = "Alpha"
instance Show e => Show (Pixel CMYKA e) where
show (PixelCMYKA c m y k a) =
"<CMYKA:("++show c++"|"++show m++"|"++show y++"|"++show k++"|"++show a++")>"
instance (Elevator e, Typeable e) => ColorSpace CMYKA e where
type Components CMYKA e = (e, e, e, e, e)
fromComponents !(c, m, y, k, a) = PixelCMYKA c m y k a
toComponents (PixelCMYKA c m y k a) = (c, m, y, k, a)
broadcastC !e = PixelCMYKA e e e e e
getPxC (PixelCMYKA c _ _ _ _) CyanCMYKA = c
getPxC (PixelCMYKA _ m _ _ _) MagCMYKA = m
getPxC (PixelCMYKA _ _ y _ _) YelCMYKA = y
getPxC (PixelCMYKA _ _ _ k _) KeyCMYKA = k
getPxC (PixelCMYKA _ _ _ _ a) AlphaCMYKA = a
setPxC (PixelCMYKA _ m y k a) CyanCMYKA c = PixelCMYKA c m y k a
setPxC (PixelCMYKA c _ y k a) MagCMYKA m = PixelCMYKA c m y k a
setPxC (PixelCMYKA c m _ k a) YelCMYKA y = PixelCMYKA c m y k a
setPxC (PixelCMYKA c m y _ a) KeyCMYKA k = PixelCMYKA c m y k a
setPxC (PixelCMYKA c m y k _) AlphaCMYKA a = PixelCMYKA c m y k a
mapPxC f (PixelCMYKA c m y k a) =
PixelCMYKA (f CyanCMYKA c) (f MagCMYKA m) (f YelCMYKA y) (f KeyCMYKA k) (f AlphaCMYKA a)
mapPx = fmap
zipWithPx = liftA2
foldlPx = foldl'
instance (Elevator e, Typeable e) => AlphaSpace CMYKA e where
type Opaque CMYKA = CMYK
getAlpha (PixelCMYKA _ _ _ _ a) = a
addAlpha !a (PixelCMYK c m y k) = PixelCMYKA c m y k a
dropAlpha (PixelCMYKA c m y k _) = PixelCMYK c m y k
instance Functor (Pixel CMYKA) where
fmap f (PixelCMYKA c m y k a) = PixelCMYKA (f c) (f m) (f y) (f k) (f a)
instance Applicative (Pixel CMYKA) where
pure !e = PixelCMYKA e e e e e
(PixelCMYKA fc fm fy fk fa) <*> (PixelCMYKA c m y k a) =
PixelCMYKA (fc c) (fm m) (fy y) (fk k) (fa a)
instance Foldable (Pixel CMYKA) where
foldr f !z (PixelCMYKA c m y k a) = f c (f m (f y (f k (f a z))))
instance Num e => Num (Pixel CMYKA e) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
abs = liftA abs
signum = liftA signum
fromInteger = pure . fromInteger
instance Fractional e => Fractional (Pixel CMYKA e) where
(/) = liftA2 (/)
recip = liftA recip
fromRational = pure . fromRational
instance Floating e => Floating (Pixel CMYKA e) where
pi = pure pi
exp = liftA exp
log = liftA log
sin = liftA sin
cos = liftA cos
asin = liftA asin
atan = liftA atan
acos = liftA acos
sinh = liftA sinh
cosh = liftA cosh
asinh = liftA asinh
atanh = liftA atanh
acosh = liftA acosh
instance Storable e => Storable (Pixel CMYKA e) where
sizeOf _ = 3 * sizeOf (undefined :: e)
alignment _ = alignment (undefined :: e)
peek p = do
q <- return $ castPtr p
c <- peek q
m <- peekElemOff q 1
y <- peekElemOff q 2
k <- peekElemOff q 3
a <- peekElemOff q 4
return (PixelCMYKA c m y k a)
poke p (PixelCMYKA c m y k a) = do
q <- return $ castPtr p
poke q c
pokeElemOff q 1 m
pokeElemOff q 2 y
pokeElemOff q 3 k
pokeElemOff q 4 a