{-# LANGUAGE BangPatterns
           , CPP
           , RecordWildCards
           , TypeFamilies
           , TypeOperators #-}

module Vision.Image.HSV.Type (
      HSV, HSVPixel (..), HSVDelayed
    ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>))
#endif

import Data.Word
import Foreign.Storable (Storable (..))
import Foreign.Ptr (castPtr, plusPtr)

import Vision.Image.Class (Pixel (..))
import Vision.Image.Interpolate (Interpolable (..))
import Vision.Image.Type (Manifest, Delayed)

data HSVPixel = HSVPixel {
      HSVPixel -> Word8
hsvHue   :: {-# UNPACK #-} !Word8, HSVPixel -> Word8
hsvSat :: {-# UNPACK #-} !Word8
    , HSVPixel -> Word8
hsvValue :: {-# UNPACK #-} !Word8
    } deriving (HSVPixel -> HSVPixel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HSVPixel -> HSVPixel -> Bool
$c/= :: HSVPixel -> HSVPixel -> Bool
== :: HSVPixel -> HSVPixel -> Bool
$c== :: HSVPixel -> HSVPixel -> Bool
Eq, Int -> HSVPixel -> ShowS
[HSVPixel] -> ShowS
HSVPixel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HSVPixel] -> ShowS
$cshowList :: [HSVPixel] -> ShowS
show :: HSVPixel -> String
$cshow :: HSVPixel -> String
showsPrec :: Int -> HSVPixel -> ShowS
$cshowsPrec :: Int -> HSVPixel -> ShowS
Show)

-- | 24 bits (3 * 8 bits) HSV image.
--
-- The Hue value is in [0..179], Saturation in [0..255] and Value in [0..255].
--
-- This image type is more respectful to human eye perception of colors and can
-- be converted (using 'convert') from 'RGB' images.
--
-- Uses <http://en.wikipedia.org/wiki/HSL_and_HSV> equations to convert from and
-- to RGB.
type HSV = Manifest HSVPixel

type HSVDelayed = Delayed HSVPixel

instance Storable HSVPixel where
    sizeOf :: HSVPixel -> Int
sizeOf HSVPixel
_ = Int
3 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Word8)
    {-# INLINE sizeOf #-}

    alignment :: HSVPixel -> Int
alignment HSVPixel
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: Word8)
    {-# INLINE alignment #-}

    peek :: Ptr HSVPixel -> IO HSVPixel
peek !Ptr HSVPixel
ptr =
        let !ptr' :: Ptr Word8
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr HSVPixel
ptr
        in Word8 -> Word8 -> Word8 -> HSVPixel
HSVPixel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr'               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
ptr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
ptr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
    {-# INLINE peek #-}

    poke :: Ptr HSVPixel -> HSVPixel -> IO ()
poke !Ptr HSVPixel
ptr HSVPixel { Word8
hsvValue :: Word8
hsvSat :: Word8
hsvHue :: Word8
hsvValue :: HSVPixel -> Word8
hsvSat :: HSVPixel -> Word8
hsvHue :: HSVPixel -> Word8
.. } =
        let !ptr' :: Ptr Word8
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr HSVPixel
ptr
        in forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr'               Word8
hsvHue   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
           forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
hsvSat   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
           forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
hsvValue
    {-# INLINE poke #-}

instance Pixel HSVPixel where
    type PixelChannel HSVPixel = Word8

    pixNChannels :: HSVPixel -> Int
pixNChannels HSVPixel
_ = Int
3
    {-# INLINE pixNChannels #-}

    pixIndex :: HSVPixel -> Int -> PixelChannel HSVPixel
pixIndex !(HSVPixel Word8
h Word8
_ Word8
_) Int
0 = Word8
h
    pixIndex !(HSVPixel Word8
_ Word8
s Word8
_) Int
1 = Word8
s
    pixIndex !(HSVPixel Word8
_ Word8
_ Word8
v) Int
_ = Word8
v
    {-# INLINE pixIndex #-}

instance Interpolable HSVPixel where
    interpol :: (PixelChannel HSVPixel
 -> PixelChannel HSVPixel -> PixelChannel HSVPixel)
-> HSVPixel -> HSVPixel -> HSVPixel
interpol PixelChannel HSVPixel
-> PixelChannel HSVPixel -> PixelChannel HSVPixel
f HSVPixel
a HSVPixel
b =
        let HSVPixel Word8
aHue Word8
aSat Word8
aVal = HSVPixel
a
            HSVPixel Word8
bHue Word8
bSat Word8
bVal = HSVPixel
b
        in HSVPixel {
              hsvHue :: Word8
hsvHue   = PixelChannel HSVPixel
-> PixelChannel HSVPixel -> PixelChannel HSVPixel
f Word8
aHue Word8
bHue, hsvSat :: Word8
hsvSat = PixelChannel HSVPixel
-> PixelChannel HSVPixel -> PixelChannel HSVPixel
f Word8
aSat Word8
bSat
            , hsvValue :: Word8
hsvValue = PixelChannel HSVPixel
-> PixelChannel HSVPixel -> PixelChannel HSVPixel
f Word8
aVal Word8
bVal
            }
    {-# INLINE interpol #-}