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

module Vision.Image.RGBA.Type (
      RGBA, RGBAPixel (..), RGBADelayed
    ) 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 RGBAPixel = RGBAPixel {
      RGBAPixel -> Word8
rgbaRed   :: {-# UNPACK #-} !Word8, RGBAPixel -> Word8
rgbaGreen :: {-# UNPACK #-} !Word8
    , RGBAPixel -> Word8
rgbaBlue  :: {-# UNPACK #-} !Word8, RGBAPixel -> Word8
rgbaAlpha :: {-# UNPACK #-} !Word8
    } deriving (RGBAPixel -> RGBAPixel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RGBAPixel -> RGBAPixel -> Bool
$c/= :: RGBAPixel -> RGBAPixel -> Bool
== :: RGBAPixel -> RGBAPixel -> Bool
$c== :: RGBAPixel -> RGBAPixel -> Bool
Eq, Int -> RGBAPixel -> ShowS
[RGBAPixel] -> ShowS
RGBAPixel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RGBAPixel] -> ShowS
$cshowList :: [RGBAPixel] -> ShowS
show :: RGBAPixel -> String
$cshow :: RGBAPixel -> String
showsPrec :: Int -> RGBAPixel -> ShowS
$cshowsPrec :: Int -> RGBAPixel -> ShowS
Show)

type RGBA = Manifest RGBAPixel

type RGBADelayed = Delayed RGBAPixel

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

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

    peek :: Ptr RGBAPixel -> IO RGBAPixel
peek !Ptr RGBAPixel
ptr =
        let !ptr' :: Ptr Word8
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr RGBAPixel
ptr
        in Word8 -> Word8 -> Word8 -> Word8 -> RGBAPixel
RGBAPixel 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) 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
3)
    {-# INLINE peek #-}

    poke :: Ptr RGBAPixel -> RGBAPixel -> IO ()
poke !Ptr RGBAPixel
ptr RGBAPixel { Word8
rgbaAlpha :: Word8
rgbaBlue :: Word8
rgbaGreen :: Word8
rgbaRed :: Word8
rgbaAlpha :: RGBAPixel -> Word8
rgbaBlue :: RGBAPixel -> Word8
rgbaGreen :: RGBAPixel -> Word8
rgbaRed :: RGBAPixel -> Word8
.. } =
        let !ptr' :: Ptr Word8
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr RGBAPixel
ptr
        in forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr'               Word8
rgbaRed   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
rgbaGreen 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
rgbaBlue  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
3) Word8
rgbaAlpha
    {-# INLINE poke #-}

instance Pixel RGBAPixel where
    type PixelChannel RGBAPixel    = Word8

    pixNChannels :: RGBAPixel -> Int
pixNChannels RGBAPixel
_ = Int
4
    {-# INLINE pixNChannels #-}

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

instance Interpolable RGBAPixel where
    interpol :: (PixelChannel RGBAPixel
 -> PixelChannel RGBAPixel -> PixelChannel RGBAPixel)
-> RGBAPixel -> RGBAPixel -> RGBAPixel
interpol PixelChannel RGBAPixel
-> PixelChannel RGBAPixel -> PixelChannel RGBAPixel
f RGBAPixel
a RGBAPixel
b =
        let RGBAPixel Word8
aRed Word8
aGreen Word8
aBlue Word8
aAlpha = RGBAPixel
a
            RGBAPixel Word8
bRed Word8
bGreen Word8
bBlue Word8
bAlpha = RGBAPixel
b
        in RGBAPixel {
              rgbaRed :: Word8
rgbaRed  = PixelChannel RGBAPixel
-> PixelChannel RGBAPixel -> PixelChannel RGBAPixel
f Word8
aRed  Word8
bRed,  rgbaGreen :: Word8
rgbaGreen = PixelChannel RGBAPixel
-> PixelChannel RGBAPixel -> PixelChannel RGBAPixel
f Word8
aGreen Word8
bGreen
            , rgbaBlue :: Word8
rgbaBlue = PixelChannel RGBAPixel
-> PixelChannel RGBAPixel -> PixelChannel RGBAPixel
f Word8
aBlue Word8
bBlue, rgbaAlpha :: Word8
rgbaAlpha = PixelChannel RGBAPixel
-> PixelChannel RGBAPixel -> PixelChannel RGBAPixel
f Word8
aAlpha Word8
bAlpha
            }
    {-# INLINE interpol #-}