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

module Vision.Image.RGB.Type (
      RGB, RGBPixel (..), RGBDelayed
    ) 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 RGBPixel = RGBPixel {
      RGBPixel -> Word8
rgbRed   :: {-# UNPACK #-} !Word8, RGBPixel -> Word8
rgbGreen :: {-# UNPACK #-} !Word8
    , RGBPixel -> Word8
rgbBlue  :: {-# UNPACK #-} !Word8
    } deriving (RGBPixel -> RGBPixel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RGBPixel -> RGBPixel -> Bool
$c/= :: RGBPixel -> RGBPixel -> Bool
== :: RGBPixel -> RGBPixel -> Bool
$c== :: RGBPixel -> RGBPixel -> Bool
Eq, Int -> RGBPixel -> ShowS
[RGBPixel] -> ShowS
RGBPixel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RGBPixel] -> ShowS
$cshowList :: [RGBPixel] -> ShowS
show :: RGBPixel -> String
$cshow :: RGBPixel -> String
showsPrec :: Int -> RGBPixel -> ShowS
$cshowsPrec :: Int -> RGBPixel -> ShowS
Show)

type RGB = Manifest RGBPixel

type RGBDelayed = Delayed RGBPixel

instance Storable RGBPixel where
    sizeOf :: RGBPixel -> Int
sizeOf RGBPixel
_ = 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 :: RGBPixel -> Int
alignment RGBPixel
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: Word8)
    {-# INLINE alignment #-}

    peek :: Ptr RGBPixel -> IO RGBPixel
peek !Ptr RGBPixel
ptr =
        let !ptr' :: Ptr Word8
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr RGBPixel
ptr
        in Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel 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 RGBPixel -> RGBPixel -> IO ()
poke !Ptr RGBPixel
ptr RGBPixel { Word8
rgbBlue :: Word8
rgbGreen :: Word8
rgbRed :: Word8
rgbBlue :: RGBPixel -> Word8
rgbGreen :: RGBPixel -> Word8
rgbRed :: RGBPixel -> Word8
.. } =
        let !ptr' :: Ptr Word8
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr RGBPixel
ptr
        in forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr'               Word8
rgbRed   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
rgbGreen 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
rgbBlue
    {-# INLINE poke #-}

instance Pixel RGBPixel where
    type PixelChannel RGBPixel = Word8

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

    pixIndex :: RGBPixel -> Int -> PixelChannel RGBPixel
pixIndex !(RGBPixel Word8
r Word8
_ Word8
_) Int
0 = Word8
r
    pixIndex !(RGBPixel Word8
_ Word8
g Word8
_) Int
1 = Word8
g
    pixIndex !(RGBPixel Word8
_ Word8
_ Word8
b) Int
_ = Word8
b
    {-# INLINE pixIndex #-}

instance Interpolable RGBPixel where
    interpol :: (PixelChannel RGBPixel
 -> PixelChannel RGBPixel -> PixelChannel RGBPixel)
-> RGBPixel -> RGBPixel -> RGBPixel
interpol PixelChannel RGBPixel
-> PixelChannel RGBPixel -> PixelChannel RGBPixel
f RGBPixel
a RGBPixel
b =
        let RGBPixel Word8
aRed Word8
aGreen Word8
aBlue = RGBPixel
a
            RGBPixel Word8
bRed Word8
bGreen Word8
bBlue = RGBPixel
b
        in RGBPixel {
              rgbRed :: Word8
rgbRed  = PixelChannel RGBPixel
-> PixelChannel RGBPixel -> PixelChannel RGBPixel
f Word8
aRed  Word8
bRed, rgbGreen :: Word8
rgbGreen = PixelChannel RGBPixel
-> PixelChannel RGBPixel -> PixelChannel RGBPixel
f Word8
aGreen Word8
bGreen
            , rgbBlue :: Word8
rgbBlue = PixelChannel RGBPixel
-> PixelChannel RGBPixel -> PixelChannel RGBPixel
f Word8
aBlue Word8
bBlue
            }
    {-# INLINE interpol #-}