-- | Module provides basic types for image manipulation in the library.


{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE CPP                    #-}
{-# LANGUAGE DeriveDataTypeable     #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE Rank2Types             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeSynonymInstances   #-}
{-# LANGUAGE UndecidableInstances   #-}
-- Defined types are used to store all of those __Juicy Pixels__

module Codec.Picture.Types( -- * Types

                            -- ** Image types

                            Image( .. )
                          , MutableImage( .. )
                          , DynamicImage( .. )
                          , PalettedImage( .. )
                          , Palette
                          , Palette'( .. )

                            -- ** Image functions

                          , createMutableImage
                          , newMutableImage
                          , freezeImage
                          , unsafeFreezeImage
                          , thawImage
                          , unsafeThawImage

                            -- ** Image Lenses

                          , Traversal
                          , imagePixels
                          , imageIPixels

                            -- ** Pixel types

                          , Pixel8
                          , Pixel16
                          , Pixel32
                          , PixelF
                          , PixelYA8( .. )
                          , PixelYA16( .. )
                          , PixelRGB8( .. )
                          , PixelRGB16( .. )
                          , PixelRGBF( .. )
                          , PixelRGBA8( .. )
                          , PixelRGBA16( .. )
                          , PixelCMYK8( .. )
                          , PixelCMYK16( .. )
                          , PixelYCbCr8( .. )
                          , PixelYCbCrK8( .. )

                          -- * Type classes

                          , ColorConvertible( .. )
                          , Pixel(..)
                          -- $graph

                          , ColorSpaceConvertible( .. )
                          , LumaPlaneExtractable( .. )
                          , TransparentPixel( .. )

                            -- * Helper functions

                          , pixelMap
                          , pixelMapXY
                          , pixelFold
                          , pixelFoldM
                          , pixelFoldMap

                          , dynamicMap
                          , dynamicPixelMap
                          , palettedToTrueColor
                          , palettedAsImage
                          , dropAlphaLayer
                          , withImage
                          , zipPixelComponent3
                          , generateImage
                          , generateFoldImage
                          , gammaCorrection
                          , toneMapping

                            -- * Color plane extraction

                          , ColorPlane ( )

                          , PlaneRed( .. )
                          , PlaneGreen( .. )
                          , PlaneBlue( .. )
                          , PlaneAlpha( .. )
                          , PlaneLuma( .. )
                          , PlaneCr( .. )
                          , PlaneCb( .. )
                          , PlaneCyan( .. )
                          , PlaneMagenta( .. )
                          , PlaneYellow( .. )
                          , PlaneBlack( .. )

                          , extractComponent
                          , unsafeExtractComponent

                            -- * Packeable writing (unsafe but faster)

                          , PackeablePixel( .. )
                          , fillImageWith
                          , readPackedPixelAt
                          , writePackedPixelAt
                          , unsafeWritePixelBetweenAt
                          ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( Monoid, mempty )
import Control.Applicative( Applicative, pure, (<*>), (<$>) )
#endif
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid( (<>) )
#endif
import Control.Monad( foldM, liftM, ap )
import Control.DeepSeq( NFData( .. ) )
import Control.Monad.ST( ST, runST )
import Control.Monad.Primitive ( PrimMonad, PrimState )
import Foreign.ForeignPtr( castForeignPtr )
import Foreign.Storable ( Storable )
import Data.Bits( unsafeShiftL, unsafeShiftR, (.|.), (.&.) )
import Data.Typeable ( Typeable )
import Data.Word( Word8, Word16, Word32, Word64 )
import Data.Vector.Storable ( (!) )
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable.Mutable as M

#include "ConvGraph.hs"

-- | The main type of this package, one that most

-- functions work on, is Image.

--

-- Parameterized by the underlying pixel format it

-- forms a rigid type. If you wish to store images

-- of different or unknown pixel formats use 'DynamicImage'.

--

-- Image is essentially a rectangular pixel buffer

-- of specified width and height. The coordinates are

-- assumed to start from the upper-left corner

-- of the image, with the horizontal position first

-- and vertical second.

data Image a = Image
    { -- | Width of the image in pixels

      forall a. Image a -> Int
imageWidth  :: {-# UNPACK #-} !Int
      -- | Height of the image in pixels.

    , forall a. Image a -> Int
imageHeight :: {-# UNPACK #-} !Int

      -- | Image pixel data. To extract pixels at a given position

      -- you should use the helper functions.

      --

      -- Internally pixel data is stored as consecutively packed

      -- lines from top to bottom, scanned from left to right

      -- within individual lines, from first to last color

      -- component within each pixel.

    , forall a. Image a -> Vector (PixelBaseComponent a)
imageData   :: V.Vector (PixelBaseComponent a)
    }
    deriving (Typeable)

instance (Eq (PixelBaseComponent a), Storable (PixelBaseComponent a))
    => Eq (Image a) where
  Image a
a == :: Image a -> Image a -> Bool
== Image a
b = Image a -> Int
forall a. Image a -> Int
imageWidth  Image a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image a -> Int
forall a. Image a -> Int
imageWidth  Image a
b Bool -> Bool -> Bool
&&
           Image a -> Int
forall a. Image a -> Int
imageHeight Image a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image a -> Int
forall a. Image a -> Int
imageHeight Image a
b Bool -> Bool -> Bool
&&
           Image a -> Vector (PixelBaseComponent a)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData   Image a
a Vector (PixelBaseComponent a)
-> Vector (PixelBaseComponent a) -> Bool
forall a. Eq a => a -> a -> Bool
== Image a -> Vector (PixelBaseComponent a)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData   Image a
b

-- | Type for the palette used in Gif & PNG files.

type Palette = Image PixelRGB8

-- | Class used to describle plane present in the pixel

-- type. If a pixel has a plane description associated,

-- you can use the plane name to extract planes independently.

class ColorPlane pixel planeToken where
    -- | Retrieve the index of the component in the

    -- given pixel type.

    toComponentIndex :: pixel -> planeToken -> Int

-- | Define the plane for the red color component

data PlaneRed = PlaneRed
    deriving (Typeable)

-- | Define the plane for the green color component

data PlaneGreen = PlaneGreen
    deriving (Typeable)

-- | Define the plane for the blue color component

data PlaneBlue = PlaneBlue
    deriving (Typeable)

-- | Define the plane for the alpha (transparency) component

data PlaneAlpha = PlaneAlpha
    deriving (Typeable)

-- | Define the plane for the luma component

data PlaneLuma = PlaneLuma
    deriving (Typeable)

-- | Define the plane for the Cr component

data PlaneCr = PlaneCr
    deriving (Typeable)

-- | Define the plane for the Cb component

data PlaneCb = PlaneCb
    deriving (Typeable)

-- | Define plane for the cyan component of the

-- CMYK color space.

data PlaneCyan = PlaneCyan
    deriving (Typeable)

-- | Define plane for the magenta component of the

-- CMYK color space.

data PlaneMagenta = PlaneMagenta
    deriving (Typeable)

-- | Define plane for the yellow component of the

-- CMYK color space.

data PlaneYellow = PlaneYellow
    deriving (Typeable)

-- | Define plane for the black component of

-- the CMYK color space.

data PlaneBlack = PlaneBlack
    deriving (Typeable)

-- | Extract a color plane from an image given a present plane in the image

-- examples:

--

-- @

--  extractRedPlane :: Image PixelRGB8 -> Image Pixel8

--  extractRedPlane = extractComponent PlaneRed

-- @

--

extractComponent :: forall px plane. ( Pixel px
                                     , Pixel (PixelBaseComponent px)
                                     , PixelBaseComponent (PixelBaseComponent px)
                                                    ~ PixelBaseComponent px
                                     , ColorPlane px plane )
                 => plane -> Image px -> Image (PixelBaseComponent px)
extractComponent :: forall px plane.
(Pixel px, Pixel (PixelBaseComponent px),
 PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px,
 ColorPlane px plane) =>
plane -> Image px -> Image (PixelBaseComponent px)
extractComponent plane
plane = Int -> Image px -> Image (PixelBaseComponent px)
forall a.
(Pixel a, Pixel (PixelBaseComponent a),
 PixelBaseComponent (PixelBaseComponent a)
 ~ PixelBaseComponent a) =>
Int -> Image a -> Image (PixelBaseComponent a)
unsafeExtractComponent Int
idx
    where idx :: Int
idx = px -> plane -> Int
forall pixel planeToken.
ColorPlane pixel planeToken =>
pixel -> planeToken -> Int
toComponentIndex (px
forall a. HasCallStack => a
undefined :: px) plane
plane

-- | Extract a plane of an image. Returns the requested color

-- component as a greyscale image.

--

-- If you ask for a component out of bound, the `error` function will

-- be called.

unsafeExtractComponent :: forall a
                        . ( Pixel a
                          , Pixel (PixelBaseComponent a)
                          , PixelBaseComponent (PixelBaseComponent a)
                                              ~ PixelBaseComponent a)
                       => Int     -- ^ The component index, beginning at 0 ending at (componentCount - 1)

                       -> Image a -- ^ Source image

                       -> Image (PixelBaseComponent a)
unsafeExtractComponent :: forall a.
(Pixel a, Pixel (PixelBaseComponent a),
 PixelBaseComponent (PixelBaseComponent a)
 ~ PixelBaseComponent a) =>
Int -> Image a -> Image (PixelBaseComponent a)
unsafeExtractComponent Int
comp img :: Image a
img@(Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h })
  | Int
comp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
padd = [Char] -> Image (PixelBaseComponent a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Image (PixelBaseComponent a))
-> [Char] -> Image (PixelBaseComponent a)
forall a b. (a -> b) -> a -> b
$ [Char]
"extractComponent : invalid component index ("
                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
comp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", max:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
padd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  | Bool
otherwise = Image { imageWidth :: Int
imageWidth = Int
w, imageHeight :: Int
imageHeight = Int
h, imageData :: Vector (PixelBaseComponent (PixelBaseComponent a))
imageData = Vector (PixelBaseComponent a)
Vector (PixelBaseComponent (PixelBaseComponent a))
plane }
      where plane :: Vector (PixelBaseComponent a)
plane = Image a -> Int -> Int -> Vector (PixelBaseComponent a)
forall a.
Storable (PixelBaseComponent a) =>
Image a -> Int -> Int -> Vector (PixelBaseComponent a)
stride Image a
img Int
padd Int
comp
            padd :: Int
padd = a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)

-- | For any image with an alpha component (transparency),

-- drop it, returning a pure opaque image.

dropAlphaLayer :: (TransparentPixel a b) => Image a -> Image b
dropAlphaLayer :: forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer = (a -> b) -> Image a -> Image b
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap a -> b
forall a b. TransparentPixel a b => a -> b
dropTransparency

-- | Class modeling transparent pixel, should provide a method

-- to combine transparent pixels

class (Pixel a, Pixel b) => TransparentPixel a b | a -> b where
    -- | Just return the opaque pixel value

    dropTransparency :: a -> b

    -- | access the transparency (alpha layer) of a given

    -- transparent pixel type.

    getTransparency :: a -> PixelBaseComponent a
{-# DEPRECATED getTransparency "please use 'pixelOpacity' instead" #-}

instance TransparentPixel PixelRGBA8 PixelRGB8 where
    {-# INLINE dropTransparency #-}
    dropTransparency :: PixelRGBA8 -> PixelRGB8
dropTransparency (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
_) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 Pixel8
r Pixel8
g Pixel8
b
    {-# INLINE getTransparency #-}
    getTransparency :: PixelRGBA8 -> PixelBaseComponent PixelRGBA8
getTransparency (PixelRGBA8 Pixel8
_ Pixel8
_ Pixel8
_ Pixel8
a) = Pixel8
PixelBaseComponent PixelRGBA8
a

lineFold :: (Monad m) => a -> Int -> (a -> Int -> m a) -> m a
{-# INLINE lineFold #-}
lineFold :: forall (m :: * -> *) a.
Monad m =>
a -> Int -> (a -> Int -> m a) -> m a
lineFold a
initial Int
count a -> Int -> m a
f = Int -> a -> m a
go Int
0 a
initial
  where go :: Int -> a -> m a
go Int
n a
acc | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
        go Int
n a
acc = a -> Int -> m a
f a
acc Int
n m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> a -> m a
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

stride :: (Storable (PixelBaseComponent a))
       => Image a -> Int -> Int -> V.Vector (PixelBaseComponent a)
stride :: forall a.
Storable (PixelBaseComponent a) =>
Image a -> Int -> Int -> Vector (PixelBaseComponent a)
stride Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent a)
array }
        Int
padd Int
firstComponent = (forall s. ST s (Vector (PixelBaseComponent a)))
-> Vector (PixelBaseComponent a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (PixelBaseComponent a)))
 -> Vector (PixelBaseComponent a))
-> (forall s. ST s (Vector (PixelBaseComponent a)))
-> Vector (PixelBaseComponent a)
forall a b. (a -> b) -> a -> b
$ do
    let cell_count :: Int
cell_count = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h
    MVector s (PixelBaseComponent a)
outArray <- Int -> ST s (MVector (PrimState (ST s)) (PixelBaseComponent a))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new Int
cell_count

    let go :: Int -> Int -> ST s ()
go Int
writeIndex Int
_ | Int
writeIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cell_count = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
writeIndex Int
readIndex = do
          (MVector s (PixelBaseComponent a)
MVector (PrimState (ST s)) (PixelBaseComponent a)
outArray MVector (PrimState (ST s)) (PixelBaseComponent a)
-> Int -> PixelBaseComponent a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
writeIndex) (PixelBaseComponent a -> ST s ())
-> PixelBaseComponent a -> ST s ()
forall a b. (a -> b) -> a -> b
$ Vector (PixelBaseComponent a)
array Vector (PixelBaseComponent a) -> Int -> PixelBaseComponent a
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
readIndex
          Int -> Int -> ST s ()
go (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padd

    Int -> Int -> ST s ()
go Int
0 Int
firstComponent
    MVector (PrimState (ST s)) (PixelBaseComponent a)
-> ST s (Vector (PixelBaseComponent a))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector s (PixelBaseComponent a)
MVector (PrimState (ST s)) (PixelBaseComponent a)
outArray

instance NFData (Image a) where
    rnf :: Image a -> ()
rnf (Image Int
width Int
height Vector (PixelBaseComponent a)
dat) = Int
width  Int -> () -> ()
forall a b. a -> b -> b
`seq`
                                   Int
height Int -> () -> ()
forall a b. a -> b -> b
`seq`
                                   Vector (PixelBaseComponent a)
dat    Vector (PixelBaseComponent a) -> () -> ()
forall a b. a -> b -> b
`seq`
                                   ()

-- | Image or pixel buffer, the coordinates are assumed to start

-- from the upper-left corner of the image, with the horizontal

-- position first, then the vertical one. The image can be transformed in place.

data MutableImage s a = MutableImage
    { -- | Width of the image in pixels

      forall s a. MutableImage s a -> Int
mutableImageWidth  :: {-# UNPACK #-} !Int

      -- | Height of the image in pixels.

    , forall s a. MutableImage s a -> Int
mutableImageHeight :: {-# UNPACK #-} !Int

      -- | The real image, to extract pixels at some position

      -- you should use the helpers functions.

    , forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData   :: M.STVector s (PixelBaseComponent a)
    }
    deriving (Typeable)

-- | `O(n)` Yield an immutable copy of an image by making a copy of it

freezeImage :: (Storable (PixelBaseComponent px), PrimMonad m)
            => MutableImage (PrimState m) px -> m (Image px)
freezeImage :: forall px (m :: * -> *).
(Storable (PixelBaseComponent px), PrimMonad m) =>
MutableImage (PrimState m) px -> m (Image px)
freezeImage (MutableImage Int
w Int
h STVector (PrimState m) (PixelBaseComponent px)
d) = Int -> Int -> Vector (PixelBaseComponent px) -> Image px
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h (Vector (PixelBaseComponent px) -> Image px)
-> m (Vector (PixelBaseComponent px)) -> m (Image px)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` STVector (PrimState m) (PixelBaseComponent px)
-> m (Vector (PixelBaseComponent px))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.freeze STVector (PrimState m) (PixelBaseComponent px)
d

-- | `O(n)` Yield a mutable copy of an image by making a copy of it.

thawImage :: (Storable (PixelBaseComponent px), PrimMonad m)
          => Image px -> m (MutableImage (PrimState m) px)
thawImage :: forall px (m :: * -> *).
(Storable (PixelBaseComponent px), PrimMonad m) =>
Image px -> m (MutableImage (PrimState m) px)
thawImage (Image Int
w Int
h Vector (PixelBaseComponent px)
d) = Int
-> Int
-> STVector (PrimState m) (PixelBaseComponent px)
-> MutableImage (PrimState m) px
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
w Int
h (STVector (PrimState m) (PixelBaseComponent px)
 -> MutableImage (PrimState m) px)
-> m (STVector (PrimState m) (PixelBaseComponent px))
-> m (MutableImage (PrimState m) px)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector (PixelBaseComponent px)
-> m (STVector (PrimState m) (PixelBaseComponent px))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector (PixelBaseComponent px)
d

-- | `O(1)` Unsafe convert an imutable image to an mutable one without copying.

-- The source image shouldn't be used after this operation.

unsafeThawImage :: (Storable (PixelBaseComponent px), PrimMonad m)
                => Image px -> m (MutableImage (PrimState m) px)
{-# NOINLINE unsafeThawImage #-}
unsafeThawImage :: forall px (m :: * -> *).
(Storable (PixelBaseComponent px), PrimMonad m) =>
Image px -> m (MutableImage (PrimState m) px)
unsafeThawImage (Image Int
w Int
h Vector (PixelBaseComponent px)
d) = Int
-> Int
-> STVector (PrimState m) (PixelBaseComponent px)
-> MutableImage (PrimState m) px
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
w Int
h (STVector (PrimState m) (PixelBaseComponent px)
 -> MutableImage (PrimState m) px)
-> m (STVector (PrimState m) (PixelBaseComponent px))
-> m (MutableImage (PrimState m) px)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector (PixelBaseComponent px)
-> m (STVector (PrimState m) (PixelBaseComponent px))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Vector (PixelBaseComponent px)
d

-- | `O(1)` Unsafe convert a mutable image to an immutable one without copying.

-- The mutable image may not be used after this operation.

unsafeFreezeImage ::  (Storable (PixelBaseComponent a), PrimMonad m)
                  => MutableImage (PrimState m) a -> m (Image a)
unsafeFreezeImage :: forall px (m :: * -> *).
(Storable (PixelBaseComponent px), PrimMonad m) =>
MutableImage (PrimState m) px -> m (Image px)
unsafeFreezeImage (MutableImage Int
w Int
h STVector (PrimState m) (PixelBaseComponent a)
d) = Int -> Int -> Vector (PixelBaseComponent a) -> Image a
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h (Vector (PixelBaseComponent a) -> Image a)
-> m (Vector (PixelBaseComponent a)) -> m (Image a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` STVector (PrimState m) (PixelBaseComponent a)
-> m (Vector (PixelBaseComponent a))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze STVector (PrimState m) (PixelBaseComponent a)
d

-- | Create a mutable image, filled with the given background color.

createMutableImage :: (Pixel px, PrimMonad m)
                   => Int -- ^ Width

                   -> Int -- ^ Height

                   -> px  -- ^ Background color

                   -> m (MutableImage (PrimState m) px)
createMutableImage :: forall px (m :: * -> *).
(Pixel px, PrimMonad m) =>
Int -> Int -> px -> m (MutableImage (PrimState m) px)
createMutableImage Int
width Int
height px
background =
   (Int -> Int -> px)
-> Int -> Int -> m (MutableImage (PrimState m) px)
forall (m :: * -> *) px.
(Pixel px, PrimMonad m) =>
(Int -> Int -> px)
-> Int -> Int -> m (MutableImage (PrimState m) px)
generateMutableImage (\Int
_ Int
_ -> px
background) Int
width Int
height

-- | Create a mutable image with garbage as content. All data

-- is uninitialized.

newMutableImage :: forall px m. (Pixel px, PrimMonad m)
                => Int -- ^ Width

                -> Int -- ^ Height

                -> m (MutableImage (PrimState m) px)
newMutableImage :: forall px (m :: * -> *).
(Pixel px, PrimMonad m) =>
Int -> Int -> m (MutableImage (PrimState m) px)
newMutableImage Int
w Int
h = Int
-> Int
-> STVector (PrimState m) (PixelBaseComponent px)
-> MutableImage (PrimState m) px
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
w Int
h (STVector (PrimState m) (PixelBaseComponent px)
 -> MutableImage (PrimState m) px)
-> m (STVector (PrimState m) (PixelBaseComponent px))
-> m (MutableImage (PrimState m) px)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> m (STVector (PrimState m) (PixelBaseComponent px))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compCount)
  where compCount :: Int
compCount = px -> Int
forall a. Pixel a => a -> Int
componentCount (px
forall a. HasCallStack => a
undefined :: px)

instance NFData (MutableImage s a) where
    rnf :: MutableImage s a -> ()
rnf (MutableImage Int
width Int
height STVector s (PixelBaseComponent a)
dat) = Int
width  Int -> () -> ()
forall a b. a -> b -> b
`seq`
                                          Int
height Int -> () -> ()
forall a b. a -> b -> b
`seq`
                                          STVector s (PixelBaseComponent a)
dat    STVector s (PixelBaseComponent a) -> () -> ()
forall a b. a -> b -> b
`seq`
                                          ()

-- | Image type enumerating all predefined pixel types.

-- It enables loading and use of images of different

-- pixel types.

data DynamicImage =
       -- | A greyscale image.

       ImageY8    (Image Pixel8)
       -- | A greyscale image with 16bit components

     | ImageY16   (Image Pixel16)
       -- | A greyscale image with 32bit components

     | ImageY32   (Image Pixel32)
       -- | A greyscale HDR image

     | ImageYF    (Image PixelF)
       -- | An image in greyscale with an alpha channel.

     | ImageYA8   (Image PixelYA8)
      -- | An image in greyscale with alpha channel on 16 bits.

     | ImageYA16  (Image PixelYA16)
       -- | An image in true color.

     | ImageRGB8  (Image PixelRGB8)
       -- | An image in true color with 16bit depth.

     | ImageRGB16 (Image PixelRGB16)
       -- | An image with HDR pixels

     | ImageRGBF  (Image PixelRGBF)
       -- | An image in true color and an alpha channel.

     | ImageRGBA8 (Image PixelRGBA8)
       -- | A true color image with alpha on 16 bits.

     | ImageRGBA16 (Image PixelRGBA16)
       -- | An image in the colorspace used by Jpeg images.

     | ImageYCbCr8 (Image PixelYCbCr8)
       -- | An image in the colorspace CMYK

     | ImageCMYK8  (Image PixelCMYK8)
       -- | An image in the colorspace CMYK and 16 bits precision

     | ImageCMYK16 (Image PixelCMYK16)
    deriving (DynamicImage -> DynamicImage -> Bool
(DynamicImage -> DynamicImage -> Bool)
-> (DynamicImage -> DynamicImage -> Bool) -> Eq DynamicImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DynamicImage -> DynamicImage -> Bool
== :: DynamicImage -> DynamicImage -> Bool
$c/= :: DynamicImage -> DynamicImage -> Bool
/= :: DynamicImage -> DynamicImage -> Bool
Eq, Typeable)

-- | Type used to expose a palette extracted during reading.

-- Use `palettedAsImage` to convert it to a palette usable for

-- writing.

data Palette' px = Palette'
  { -- | Number of element in pixels.

    forall px. Palette' px -> Int
_paletteSize :: !Int
    -- | Real data used by the palette.

  , forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData :: !(V.Vector (PixelBaseComponent px))
  }
  deriving Typeable

-- | Convert a palette to an image. Used mainly for

-- backward compatibility.

palettedAsImage :: Palette' px -> Image px
palettedAsImage :: forall px. Palette' px -> Image px
palettedAsImage Palette' px
p = Int -> Int -> Vector (PixelBaseComponent px) -> Image px
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image (Palette' px -> Int
forall px. Palette' px -> Int
_paletteSize Palette' px
p) Int
1 (Vector (PixelBaseComponent px) -> Image px)
-> Vector (PixelBaseComponent px) -> Image px
forall a b. (a -> b) -> a -> b
$ Palette' px -> Vector (PixelBaseComponent px)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' px
p

-- | Describe an image and it's potential associated

-- palette. If no palette is present, fallback to a

-- DynamicImage

data PalettedImage
  = TrueColorImage DynamicImage -- ^ Fallback

  | PalettedY8    (Image Pixel8) (Palette' Pixel8)
  | PalettedRGB8  (Image Pixel8) (Palette' PixelRGB8)
  | PalettedRGBA8 (Image Pixel8) (Palette' PixelRGBA8)
  | PalettedRGB16 (Image Pixel8) (Palette' PixelRGB16)
  deriving (Typeable)

-- | Flatten a PalettedImage to a DynamicImage

palettedToTrueColor :: PalettedImage -> DynamicImage
palettedToTrueColor :: PalettedImage -> DynamicImage
palettedToTrueColor PalettedImage
img = case PalettedImage
img of
  TrueColorImage DynamicImage
d -> DynamicImage
d
  PalettedY8    Image Pixel8
i Palette' Pixel8
p -> Image Pixel8 -> DynamicImage
ImageY8 (Image Pixel8 -> DynamicImage) -> Image Pixel8 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Int
-> Vector (PixelBaseComponent Pixel8)
-> Image Pixel8
-> Image Pixel8
forall {a} {b}.
(Pixel a, Pixel b, Integral a) =>
Int -> Vector (PixelBaseComponent b) -> Image a -> Image b
toTrueColor Int
1 (Palette' Pixel8 -> Vector (PixelBaseComponent Pixel8)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' Pixel8
p) Image Pixel8
i
  PalettedRGB8  Image Pixel8
i Palette' PixelRGB8
p -> Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Int
-> Vector (PixelBaseComponent PixelRGB8)
-> Image Pixel8
-> Image PixelRGB8
forall {a} {b}.
(Pixel a, Pixel b, Integral a) =>
Int -> Vector (PixelBaseComponent b) -> Image a -> Image b
toTrueColor Int
3 (Palette' PixelRGB8 -> Vector (PixelBaseComponent PixelRGB8)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' PixelRGB8
p) Image Pixel8
i
  PalettedRGBA8 Image Pixel8
i Palette' PixelRGBA8
p -> Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Int
-> Vector (PixelBaseComponent PixelRGBA8)
-> Image Pixel8
-> Image PixelRGBA8
forall {a} {b}.
(Pixel a, Pixel b, Integral a) =>
Int -> Vector (PixelBaseComponent b) -> Image a -> Image b
toTrueColor Int
4 (Palette' PixelRGBA8 -> Vector (PixelBaseComponent PixelRGBA8)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' PixelRGBA8
p) Image Pixel8
i
  PalettedRGB16 Image Pixel8
i Palette' PixelRGB16
p -> Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> DynamicImage)
-> Image PixelRGB16 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Int
-> Vector (PixelBaseComponent PixelRGB16)
-> Image Pixel8
-> Image PixelRGB16
forall {a} {b}.
(Pixel a, Pixel b, Integral a) =>
Int -> Vector (PixelBaseComponent b) -> Image a -> Image b
toTrueColor Int
3 (Palette' PixelRGB16 -> Vector (PixelBaseComponent PixelRGB16)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' PixelRGB16
p) Image Pixel8
i
  where 
    toTrueColor :: Int -> Vector (PixelBaseComponent b) -> Image a -> Image b
toTrueColor Int
c Vector (PixelBaseComponent b)
vec = (a -> b) -> Image a -> Image b
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap (Vector (PixelBaseComponent b) -> Int -> b
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent b)
vec (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

-- | Helper function to help extract information from dynamic

-- image. To get the width of a dynamic image, you can use

-- the following snippet:

--

-- > dynWidth :: DynamicImage -> Int

-- > dynWidth img = dynamicMap imageWidth img

--

dynamicMap :: (forall pixel . (Pixel pixel) => Image pixel -> a)
           -> DynamicImage -> a
dynamicMap :: forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageY8    Image Pixel8
i) = Image Pixel8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image Pixel8
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageY16   Image Pixel16
i) = Image Pixel16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image Pixel16
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageY32   Image Pixel32
i) = Image Pixel32 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image Pixel32
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageYF    Image PixelF
i) = Image PixelF -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelF
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageYA8   Image PixelYA8
i) = Image PixelYA8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelYA8
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageYA16  Image PixelYA16
i) = Image PixelYA16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelYA16
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGB8  Image PixelRGB8
i) = Image PixelRGB8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGB8
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGB16 Image PixelRGB16
i) = Image PixelRGB16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGB16
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGBF  Image PixelRGBF
i) = Image PixelRGBF -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGBF
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGBA8 Image PixelRGBA8
i) = Image PixelRGBA8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGBA8
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGBA16 Image PixelRGBA16
i) = Image PixelRGBA16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGBA16
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageYCbCr8 Image PixelYCbCr8
i) = Image PixelYCbCr8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelYCbCr8
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageCMYK8 Image PixelCMYK8
i) = Image PixelCMYK8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelCMYK8
i
dynamicMap forall pixel. Pixel pixel => Image pixel -> a
f (ImageCMYK16 Image PixelCMYK16
i) = Image PixelCMYK16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelCMYK16
i

-- | Equivalent of the `pixelMap` function for the dynamic images.

-- You can perform pixel colorspace independant operations with this

-- function.

--

-- For instance, if you want to extract a square crop of any image,

-- without caring about colorspace, you can use the following snippet.

--

-- > dynSquare :: DynamicImage -> DynamicImage

-- > dynSquare = dynamicPixelMap squareImage

-- >

-- > squareImage :: Pixel a => Image a -> Image a

-- > squareImage img = generateImage (\x y -> pixelAt img x y) edge edge

-- >    where edge = min (imageWidth img) (imageHeight img)

--

dynamicPixelMap :: (forall pixel . (Pixel pixel) => Image pixel -> Image pixel)
                -> DynamicImage -> DynamicImage
dynamicPixelMap :: (forall pixel. Pixel pixel => Image pixel -> Image pixel)
-> DynamicImage -> DynamicImage
dynamicPixelMap forall pixel. Pixel pixel => Image pixel -> Image pixel
f = DynamicImage -> DynamicImage
aux
  where
    aux :: DynamicImage -> DynamicImage
aux (ImageY8    Image Pixel8
i) = Image Pixel8 -> DynamicImage
ImageY8 (Image Pixel8 -> Image Pixel8
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image Pixel8
i)
    aux (ImageY16   Image Pixel16
i) = Image Pixel16 -> DynamicImage
ImageY16 (Image Pixel16 -> Image Pixel16
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image Pixel16
i)
    aux (ImageY32   Image Pixel32
i) = Image Pixel32 -> DynamicImage
ImageY32 (Image Pixel32 -> Image Pixel32
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image Pixel32
i)
    aux (ImageYF    Image PixelF
i) = Image PixelF -> DynamicImage
ImageYF (Image PixelF -> Image PixelF
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelF
i)
    aux (ImageYA8   Image PixelYA8
i) = Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> Image PixelYA8
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelYA8
i)
    aux (ImageYA16  Image PixelYA16
i) = Image PixelYA16 -> DynamicImage
ImageYA16 (Image PixelYA16 -> Image PixelYA16
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelYA16
i)
    aux (ImageRGB8  Image PixelRGB8
i) = Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Image PixelRGB8
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelRGB8
i)
    aux (ImageRGB16 Image PixelRGB16
i) = Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> Image PixelRGB16
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelRGB16
i)
    aux (ImageRGBF  Image PixelRGBF
i) = Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> Image PixelRGBF
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelRGBF
i)
    aux (ImageRGBA8 Image PixelRGBA8
i) = Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> Image PixelRGBA8
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelRGBA8
i)
    aux (ImageRGBA16 Image PixelRGBA16
i) = Image PixelRGBA16 -> DynamicImage
ImageRGBA16 (Image PixelRGBA16 -> Image PixelRGBA16
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelRGBA16
i)
    aux (ImageYCbCr8 Image PixelYCbCr8
i) = Image PixelYCbCr8 -> DynamicImage
ImageYCbCr8 (Image PixelYCbCr8 -> Image PixelYCbCr8
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelYCbCr8
i)
    aux (ImageCMYK8 Image PixelCMYK8
i) = Image PixelCMYK8 -> DynamicImage
ImageCMYK8 (Image PixelCMYK8 -> Image PixelCMYK8
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelCMYK8
i)
    aux (ImageCMYK16 Image PixelCMYK16
i) = Image PixelCMYK16 -> DynamicImage
ImageCMYK16 (Image PixelCMYK16 -> Image PixelCMYK16
forall pixel. Pixel pixel => Image pixel -> Image pixel
f Image PixelCMYK16
i)

instance NFData DynamicImage where
    rnf :: DynamicImage -> ()
rnf (ImageY8 Image Pixel8
img)     = Image Pixel8 -> ()
forall a. NFData a => a -> ()
rnf Image Pixel8
img
    rnf (ImageY16 Image Pixel16
img)    = Image Pixel16 -> ()
forall a. NFData a => a -> ()
rnf Image Pixel16
img
    rnf (ImageY32 Image Pixel32
img)    = Image Pixel32 -> ()
forall a. NFData a => a -> ()
rnf Image Pixel32
img
    rnf (ImageYF Image PixelF
img)     = Image PixelF -> ()
forall a. NFData a => a -> ()
rnf Image PixelF
img
    rnf (ImageYA8 Image PixelYA8
img)    = Image PixelYA8 -> ()
forall a. NFData a => a -> ()
rnf Image PixelYA8
img
    rnf (ImageYA16 Image PixelYA16
img)   = Image PixelYA16 -> ()
forall a. NFData a => a -> ()
rnf Image PixelYA16
img
    rnf (ImageRGB8 Image PixelRGB8
img)   = Image PixelRGB8 -> ()
forall a. NFData a => a -> ()
rnf Image PixelRGB8
img
    rnf (ImageRGB16 Image PixelRGB16
img)  = Image PixelRGB16 -> ()
forall a. NFData a => a -> ()
rnf Image PixelRGB16
img
    rnf (ImageRGBF Image PixelRGBF
img)   = Image PixelRGBF -> ()
forall a. NFData a => a -> ()
rnf Image PixelRGBF
img
    rnf (ImageRGBA8 Image PixelRGBA8
img)  = Image PixelRGBA8 -> ()
forall a. NFData a => a -> ()
rnf Image PixelRGBA8
img
    rnf (ImageRGBA16 Image PixelRGBA16
img) = Image PixelRGBA16 -> ()
forall a. NFData a => a -> ()
rnf Image PixelRGBA16
img
    rnf (ImageYCbCr8 Image PixelYCbCr8
img) = Image PixelYCbCr8 -> ()
forall a. NFData a => a -> ()
rnf Image PixelYCbCr8
img
    rnf (ImageCMYK8 Image PixelCMYK8
img)  = Image PixelCMYK8 -> ()
forall a. NFData a => a -> ()
rnf Image PixelCMYK8
img
    rnf (ImageCMYK16 Image PixelCMYK16
img)  = Image PixelCMYK16 -> ()
forall a. NFData a => a -> ()
rnf Image PixelCMYK16
img

-- | Type alias for 8bit greyscale pixels. For simplicity,

-- greyscale pixels use plain numbers instead of a separate type.

type Pixel8 = Word8

-- | Type alias for 16bit greyscale pixels.

type Pixel16 = Word16

-- | Type alias for 32bit greyscale pixels.

type Pixel32 = Word32

-- | Type alias for 32bit floating point greyscale pixels. The standard

-- bounded value range is mapped to the closed interval [0,1] i.e.

--

-- > map promotePixel [0, 1 .. 255 :: Pixel8] == [0/255, 1/255 .. 1.0 :: PixelF]

type PixelF = Float

-- | Pixel type storing 8bit Luminance (Y) and alpha (A) information.

-- Values are stored in the following order:

--

--  * Luminance

--

--  * Alpha

--

data PixelYA8 = PixelYA8 {-# UNPACK #-} !Pixel8  -- Luminance

                         {-# UNPACK #-} !Pixel8  -- Alpha value

              deriving (PixelYA8 -> PixelYA8 -> Bool
(PixelYA8 -> PixelYA8 -> Bool)
-> (PixelYA8 -> PixelYA8 -> Bool) -> Eq PixelYA8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelYA8 -> PixelYA8 -> Bool
== :: PixelYA8 -> PixelYA8 -> Bool
$c/= :: PixelYA8 -> PixelYA8 -> Bool
/= :: PixelYA8 -> PixelYA8 -> Bool
Eq, Eq PixelYA8
Eq PixelYA8 =>
(PixelYA8 -> PixelYA8 -> Ordering)
-> (PixelYA8 -> PixelYA8 -> Bool)
-> (PixelYA8 -> PixelYA8 -> Bool)
-> (PixelYA8 -> PixelYA8 -> Bool)
-> (PixelYA8 -> PixelYA8 -> Bool)
-> (PixelYA8 -> PixelYA8 -> PixelYA8)
-> (PixelYA8 -> PixelYA8 -> PixelYA8)
-> Ord PixelYA8
PixelYA8 -> PixelYA8 -> Bool
PixelYA8 -> PixelYA8 -> Ordering
PixelYA8 -> PixelYA8 -> PixelYA8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelYA8 -> PixelYA8 -> Ordering
compare :: PixelYA8 -> PixelYA8 -> Ordering
$c< :: PixelYA8 -> PixelYA8 -> Bool
< :: PixelYA8 -> PixelYA8 -> Bool
$c<= :: PixelYA8 -> PixelYA8 -> Bool
<= :: PixelYA8 -> PixelYA8 -> Bool
$c> :: PixelYA8 -> PixelYA8 -> Bool
> :: PixelYA8 -> PixelYA8 -> Bool
$c>= :: PixelYA8 -> PixelYA8 -> Bool
>= :: PixelYA8 -> PixelYA8 -> Bool
$cmax :: PixelYA8 -> PixelYA8 -> PixelYA8
max :: PixelYA8 -> PixelYA8 -> PixelYA8
$cmin :: PixelYA8 -> PixelYA8 -> PixelYA8
min :: PixelYA8 -> PixelYA8 -> PixelYA8
Ord, Int -> PixelYA8 -> [Char] -> [Char]
[PixelYA8] -> [Char] -> [Char]
PixelYA8 -> [Char]
(Int -> PixelYA8 -> [Char] -> [Char])
-> (PixelYA8 -> [Char])
-> ([PixelYA8] -> [Char] -> [Char])
-> Show PixelYA8
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelYA8 -> [Char] -> [Char]
showsPrec :: Int -> PixelYA8 -> [Char] -> [Char]
$cshow :: PixelYA8 -> [Char]
show :: PixelYA8 -> [Char]
$cshowList :: [PixelYA8] -> [Char] -> [Char]
showList :: [PixelYA8] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing 16bit Luminance (Y) and alpha (A) information.

-- Values are stored in the following order:

--

--  * Luminance

--

--  * Alpha

--

data PixelYA16 = PixelYA16 {-# UNPACK #-} !Pixel16  -- Luminance

                           {-# UNPACK #-} !Pixel16  -- Alpha value

              deriving (PixelYA16 -> PixelYA16 -> Bool
(PixelYA16 -> PixelYA16 -> Bool)
-> (PixelYA16 -> PixelYA16 -> Bool) -> Eq PixelYA16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelYA16 -> PixelYA16 -> Bool
== :: PixelYA16 -> PixelYA16 -> Bool
$c/= :: PixelYA16 -> PixelYA16 -> Bool
/= :: PixelYA16 -> PixelYA16 -> Bool
Eq, Eq PixelYA16
Eq PixelYA16 =>
(PixelYA16 -> PixelYA16 -> Ordering)
-> (PixelYA16 -> PixelYA16 -> Bool)
-> (PixelYA16 -> PixelYA16 -> Bool)
-> (PixelYA16 -> PixelYA16 -> Bool)
-> (PixelYA16 -> PixelYA16 -> Bool)
-> (PixelYA16 -> PixelYA16 -> PixelYA16)
-> (PixelYA16 -> PixelYA16 -> PixelYA16)
-> Ord PixelYA16
PixelYA16 -> PixelYA16 -> Bool
PixelYA16 -> PixelYA16 -> Ordering
PixelYA16 -> PixelYA16 -> PixelYA16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelYA16 -> PixelYA16 -> Ordering
compare :: PixelYA16 -> PixelYA16 -> Ordering
$c< :: PixelYA16 -> PixelYA16 -> Bool
< :: PixelYA16 -> PixelYA16 -> Bool
$c<= :: PixelYA16 -> PixelYA16 -> Bool
<= :: PixelYA16 -> PixelYA16 -> Bool
$c> :: PixelYA16 -> PixelYA16 -> Bool
> :: PixelYA16 -> PixelYA16 -> Bool
$c>= :: PixelYA16 -> PixelYA16 -> Bool
>= :: PixelYA16 -> PixelYA16 -> Bool
$cmax :: PixelYA16 -> PixelYA16 -> PixelYA16
max :: PixelYA16 -> PixelYA16 -> PixelYA16
$cmin :: PixelYA16 -> PixelYA16 -> PixelYA16
min :: PixelYA16 -> PixelYA16 -> PixelYA16
Ord, Int -> PixelYA16 -> [Char] -> [Char]
[PixelYA16] -> [Char] -> [Char]
PixelYA16 -> [Char]
(Int -> PixelYA16 -> [Char] -> [Char])
-> (PixelYA16 -> [Char])
-> ([PixelYA16] -> [Char] -> [Char])
-> Show PixelYA16
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelYA16 -> [Char] -> [Char]
showsPrec :: Int -> PixelYA16 -> [Char] -> [Char]
$cshow :: PixelYA16 -> [Char]
show :: PixelYA16 -> [Char]
$cshowList :: [PixelYA16] -> [Char] -> [Char]
showList :: [PixelYA16] -> [Char] -> [Char]
Show, Typeable)

-- | Classic pixel type storing 8bit red, green and blue (RGB) information.

-- Values are stored in the following order:

--

--  * Red

--

--  * Green

--

--  * Blue

--

data PixelRGB8 = PixelRGB8 {-# UNPACK #-} !Pixel8 -- Red

                           {-# UNPACK #-} !Pixel8 -- Green

                           {-# UNPACK #-} !Pixel8 -- Blue

               deriving (PixelRGB8 -> PixelRGB8 -> Bool
(PixelRGB8 -> PixelRGB8 -> Bool)
-> (PixelRGB8 -> PixelRGB8 -> Bool) -> Eq PixelRGB8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelRGB8 -> PixelRGB8 -> Bool
== :: PixelRGB8 -> PixelRGB8 -> Bool
$c/= :: PixelRGB8 -> PixelRGB8 -> Bool
/= :: PixelRGB8 -> PixelRGB8 -> Bool
Eq, Eq PixelRGB8
Eq PixelRGB8 =>
(PixelRGB8 -> PixelRGB8 -> Ordering)
-> (PixelRGB8 -> PixelRGB8 -> Bool)
-> (PixelRGB8 -> PixelRGB8 -> Bool)
-> (PixelRGB8 -> PixelRGB8 -> Bool)
-> (PixelRGB8 -> PixelRGB8 -> Bool)
-> (PixelRGB8 -> PixelRGB8 -> PixelRGB8)
-> (PixelRGB8 -> PixelRGB8 -> PixelRGB8)
-> Ord PixelRGB8
PixelRGB8 -> PixelRGB8 -> Bool
PixelRGB8 -> PixelRGB8 -> Ordering
PixelRGB8 -> PixelRGB8 -> PixelRGB8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelRGB8 -> PixelRGB8 -> Ordering
compare :: PixelRGB8 -> PixelRGB8 -> Ordering
$c< :: PixelRGB8 -> PixelRGB8 -> Bool
< :: PixelRGB8 -> PixelRGB8 -> Bool
$c<= :: PixelRGB8 -> PixelRGB8 -> Bool
<= :: PixelRGB8 -> PixelRGB8 -> Bool
$c> :: PixelRGB8 -> PixelRGB8 -> Bool
> :: PixelRGB8 -> PixelRGB8 -> Bool
$c>= :: PixelRGB8 -> PixelRGB8 -> Bool
>= :: PixelRGB8 -> PixelRGB8 -> Bool
$cmax :: PixelRGB8 -> PixelRGB8 -> PixelRGB8
max :: PixelRGB8 -> PixelRGB8 -> PixelRGB8
$cmin :: PixelRGB8 -> PixelRGB8 -> PixelRGB8
min :: PixelRGB8 -> PixelRGB8 -> PixelRGB8
Ord, Int -> PixelRGB8 -> [Char] -> [Char]
[PixelRGB8] -> [Char] -> [Char]
PixelRGB8 -> [Char]
(Int -> PixelRGB8 -> [Char] -> [Char])
-> (PixelRGB8 -> [Char])
-> ([PixelRGB8] -> [Char] -> [Char])
-> Show PixelRGB8
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelRGB8 -> [Char] -> [Char]
showsPrec :: Int -> PixelRGB8 -> [Char] -> [Char]
$cshow :: PixelRGB8 -> [Char]
show :: PixelRGB8 -> [Char]
$cshowList :: [PixelRGB8] -> [Char] -> [Char]
showList :: [PixelRGB8] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing value for the YCCK color space:

--

-- * Y (Luminance)

--

-- * Cb

--

-- * Cr

--

-- * Black

--

data PixelYCbCrK8 = PixelYCbCrK8 {-# UNPACK #-} !Pixel8
                                 {-# UNPACK #-} !Pixel8
                                 {-# UNPACK #-} !Pixel8
                                 {-# UNPACK #-} !Pixel8
               deriving (PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
(PixelYCbCrK8 -> PixelYCbCrK8 -> Bool)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> Bool) -> Eq PixelYCbCrK8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
== :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
$c/= :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
/= :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
Eq, Eq PixelYCbCrK8
Eq PixelYCbCrK8 =>
(PixelYCbCrK8 -> PixelYCbCrK8 -> Ordering)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> Bool)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> Bool)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> Bool)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> Bool)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8)
-> (PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8)
-> Ord PixelYCbCrK8
PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
PixelYCbCrK8 -> PixelYCbCrK8 -> Ordering
PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelYCbCrK8 -> PixelYCbCrK8 -> Ordering
compare :: PixelYCbCrK8 -> PixelYCbCrK8 -> Ordering
$c< :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
< :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
$c<= :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
<= :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
$c> :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
> :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
$c>= :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
>= :: PixelYCbCrK8 -> PixelYCbCrK8 -> Bool
$cmax :: PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8
max :: PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8
$cmin :: PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8
min :: PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8
Ord, Int -> PixelYCbCrK8 -> [Char] -> [Char]
[PixelYCbCrK8] -> [Char] -> [Char]
PixelYCbCrK8 -> [Char]
(Int -> PixelYCbCrK8 -> [Char] -> [Char])
-> (PixelYCbCrK8 -> [Char])
-> ([PixelYCbCrK8] -> [Char] -> [Char])
-> Show PixelYCbCrK8
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelYCbCrK8 -> [Char] -> [Char]
showsPrec :: Int -> PixelYCbCrK8 -> [Char] -> [Char]
$cshow :: PixelYCbCrK8 -> [Char]
show :: PixelYCbCrK8 -> [Char]
$cshowList :: [PixelYCbCrK8] -> [Char] -> [Char]
showList :: [PixelYCbCrK8] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing 16bit red, green and blue (RGB) information.

-- Values are stored in the following order:

--

--  * Red

--

--  * Green

--

--  * Blue

--

data PixelRGB16 = PixelRGB16 {-# UNPACK #-} !Pixel16 -- Red

                             {-# UNPACK #-} !Pixel16 -- Green

                             {-# UNPACK #-} !Pixel16 -- Blue

               deriving (PixelRGB16 -> PixelRGB16 -> Bool
(PixelRGB16 -> PixelRGB16 -> Bool)
-> (PixelRGB16 -> PixelRGB16 -> Bool) -> Eq PixelRGB16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelRGB16 -> PixelRGB16 -> Bool
== :: PixelRGB16 -> PixelRGB16 -> Bool
$c/= :: PixelRGB16 -> PixelRGB16 -> Bool
/= :: PixelRGB16 -> PixelRGB16 -> Bool
Eq, Eq PixelRGB16
Eq PixelRGB16 =>
(PixelRGB16 -> PixelRGB16 -> Ordering)
-> (PixelRGB16 -> PixelRGB16 -> Bool)
-> (PixelRGB16 -> PixelRGB16 -> Bool)
-> (PixelRGB16 -> PixelRGB16 -> Bool)
-> (PixelRGB16 -> PixelRGB16 -> Bool)
-> (PixelRGB16 -> PixelRGB16 -> PixelRGB16)
-> (PixelRGB16 -> PixelRGB16 -> PixelRGB16)
-> Ord PixelRGB16
PixelRGB16 -> PixelRGB16 -> Bool
PixelRGB16 -> PixelRGB16 -> Ordering
PixelRGB16 -> PixelRGB16 -> PixelRGB16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelRGB16 -> PixelRGB16 -> Ordering
compare :: PixelRGB16 -> PixelRGB16 -> Ordering
$c< :: PixelRGB16 -> PixelRGB16 -> Bool
< :: PixelRGB16 -> PixelRGB16 -> Bool
$c<= :: PixelRGB16 -> PixelRGB16 -> Bool
<= :: PixelRGB16 -> PixelRGB16 -> Bool
$c> :: PixelRGB16 -> PixelRGB16 -> Bool
> :: PixelRGB16 -> PixelRGB16 -> Bool
$c>= :: PixelRGB16 -> PixelRGB16 -> Bool
>= :: PixelRGB16 -> PixelRGB16 -> Bool
$cmax :: PixelRGB16 -> PixelRGB16 -> PixelRGB16
max :: PixelRGB16 -> PixelRGB16 -> PixelRGB16
$cmin :: PixelRGB16 -> PixelRGB16 -> PixelRGB16
min :: PixelRGB16 -> PixelRGB16 -> PixelRGB16
Ord, Int -> PixelRGB16 -> [Char] -> [Char]
[PixelRGB16] -> [Char] -> [Char]
PixelRGB16 -> [Char]
(Int -> PixelRGB16 -> [Char] -> [Char])
-> (PixelRGB16 -> [Char])
-> ([PixelRGB16] -> [Char] -> [Char])
-> Show PixelRGB16
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelRGB16 -> [Char] -> [Char]
showsPrec :: Int -> PixelRGB16 -> [Char] -> [Char]
$cshow :: PixelRGB16 -> [Char]
show :: PixelRGB16 -> [Char]
$cshowList :: [PixelRGB16] -> [Char] -> [Char]
showList :: [PixelRGB16] -> [Char] -> [Char]
Show, Typeable)

-- | HDR pixel type storing floating point 32bit red, green and blue (RGB) information.

-- Same value range and comments apply as for 'PixelF'.

-- Values are stored in the following order:

--

--  * Red

--

--  * Green

--

--  * Blue

--

data PixelRGBF = PixelRGBF {-# UNPACK #-} !PixelF -- Red

                           {-# UNPACK #-} !PixelF -- Green

                           {-# UNPACK #-} !PixelF -- Blue

               deriving (PixelRGBF -> PixelRGBF -> Bool
(PixelRGBF -> PixelRGBF -> Bool)
-> (PixelRGBF -> PixelRGBF -> Bool) -> Eq PixelRGBF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelRGBF -> PixelRGBF -> Bool
== :: PixelRGBF -> PixelRGBF -> Bool
$c/= :: PixelRGBF -> PixelRGBF -> Bool
/= :: PixelRGBF -> PixelRGBF -> Bool
Eq, Eq PixelRGBF
Eq PixelRGBF =>
(PixelRGBF -> PixelRGBF -> Ordering)
-> (PixelRGBF -> PixelRGBF -> Bool)
-> (PixelRGBF -> PixelRGBF -> Bool)
-> (PixelRGBF -> PixelRGBF -> Bool)
-> (PixelRGBF -> PixelRGBF -> Bool)
-> (PixelRGBF -> PixelRGBF -> PixelRGBF)
-> (PixelRGBF -> PixelRGBF -> PixelRGBF)
-> Ord PixelRGBF
PixelRGBF -> PixelRGBF -> Bool
PixelRGBF -> PixelRGBF -> Ordering
PixelRGBF -> PixelRGBF -> PixelRGBF
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelRGBF -> PixelRGBF -> Ordering
compare :: PixelRGBF -> PixelRGBF -> Ordering
$c< :: PixelRGBF -> PixelRGBF -> Bool
< :: PixelRGBF -> PixelRGBF -> Bool
$c<= :: PixelRGBF -> PixelRGBF -> Bool
<= :: PixelRGBF -> PixelRGBF -> Bool
$c> :: PixelRGBF -> PixelRGBF -> Bool
> :: PixelRGBF -> PixelRGBF -> Bool
$c>= :: PixelRGBF -> PixelRGBF -> Bool
>= :: PixelRGBF -> PixelRGBF -> Bool
$cmax :: PixelRGBF -> PixelRGBF -> PixelRGBF
max :: PixelRGBF -> PixelRGBF -> PixelRGBF
$cmin :: PixelRGBF -> PixelRGBF -> PixelRGBF
min :: PixelRGBF -> PixelRGBF -> PixelRGBF
Ord, Int -> PixelRGBF -> [Char] -> [Char]
[PixelRGBF] -> [Char] -> [Char]
PixelRGBF -> [Char]
(Int -> PixelRGBF -> [Char] -> [Char])
-> (PixelRGBF -> [Char])
-> ([PixelRGBF] -> [Char] -> [Char])
-> Show PixelRGBF
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelRGBF -> [Char] -> [Char]
showsPrec :: Int -> PixelRGBF -> [Char] -> [Char]
$cshow :: PixelRGBF -> [Char]
show :: PixelRGBF -> [Char]
$cshowList :: [PixelRGBF] -> [Char] -> [Char]
showList :: [PixelRGBF] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing 8bit luminance, blue difference and red difference (YCbCr) information.

-- Values are stored in the following order:

--

--  * Y (luminance)

--

--  * Cb

--

--  * Cr

--

data PixelYCbCr8 = PixelYCbCr8 {-# UNPACK #-} !Pixel8 -- Y luminance

                               {-# UNPACK #-} !Pixel8 -- Cb blue difference

                               {-# UNPACK #-} !Pixel8 -- Cr red difference

                 deriving (PixelYCbCr8 -> PixelYCbCr8 -> Bool
(PixelYCbCr8 -> PixelYCbCr8 -> Bool)
-> (PixelYCbCr8 -> PixelYCbCr8 -> Bool) -> Eq PixelYCbCr8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
== :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
$c/= :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
/= :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
Eq, Eq PixelYCbCr8
Eq PixelYCbCr8 =>
(PixelYCbCr8 -> PixelYCbCr8 -> Ordering)
-> (PixelYCbCr8 -> PixelYCbCr8 -> Bool)
-> (PixelYCbCr8 -> PixelYCbCr8 -> Bool)
-> (PixelYCbCr8 -> PixelYCbCr8 -> Bool)
-> (PixelYCbCr8 -> PixelYCbCr8 -> Bool)
-> (PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8)
-> (PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8)
-> Ord PixelYCbCr8
PixelYCbCr8 -> PixelYCbCr8 -> Bool
PixelYCbCr8 -> PixelYCbCr8 -> Ordering
PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelYCbCr8 -> PixelYCbCr8 -> Ordering
compare :: PixelYCbCr8 -> PixelYCbCr8 -> Ordering
$c< :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
< :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
$c<= :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
<= :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
$c> :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
> :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
$c>= :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
>= :: PixelYCbCr8 -> PixelYCbCr8 -> Bool
$cmax :: PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8
max :: PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8
$cmin :: PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8
min :: PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8
Ord, Int -> PixelYCbCr8 -> [Char] -> [Char]
[PixelYCbCr8] -> [Char] -> [Char]
PixelYCbCr8 -> [Char]
(Int -> PixelYCbCr8 -> [Char] -> [Char])
-> (PixelYCbCr8 -> [Char])
-> ([PixelYCbCr8] -> [Char] -> [Char])
-> Show PixelYCbCr8
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelYCbCr8 -> [Char] -> [Char]
showsPrec :: Int -> PixelYCbCr8 -> [Char] -> [Char]
$cshow :: PixelYCbCr8 -> [Char]
show :: PixelYCbCr8 -> [Char]
$cshowList :: [PixelYCbCr8] -> [Char] -> [Char]
showList :: [PixelYCbCr8] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing 8bit cyan, magenta, yellow and black (CMYK) information.

-- Values are stored in the following order:

--

--   * Cyan

--

--   * Magenta

--

--   * Yellow

--

--   * Black

--

data PixelCMYK8 = PixelCMYK8 {-# UNPACK #-} !Pixel8 -- Cyan

                             {-# UNPACK #-} !Pixel8 -- Magenta

                             {-# UNPACK #-} !Pixel8 -- Yellow

                             {-# UNPACK #-} !Pixel8 -- Black

                 deriving (PixelCMYK8 -> PixelCMYK8 -> Bool
(PixelCMYK8 -> PixelCMYK8 -> Bool)
-> (PixelCMYK8 -> PixelCMYK8 -> Bool) -> Eq PixelCMYK8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelCMYK8 -> PixelCMYK8 -> Bool
== :: PixelCMYK8 -> PixelCMYK8 -> Bool
$c/= :: PixelCMYK8 -> PixelCMYK8 -> Bool
/= :: PixelCMYK8 -> PixelCMYK8 -> Bool
Eq, Eq PixelCMYK8
Eq PixelCMYK8 =>
(PixelCMYK8 -> PixelCMYK8 -> Ordering)
-> (PixelCMYK8 -> PixelCMYK8 -> Bool)
-> (PixelCMYK8 -> PixelCMYK8 -> Bool)
-> (PixelCMYK8 -> PixelCMYK8 -> Bool)
-> (PixelCMYK8 -> PixelCMYK8 -> Bool)
-> (PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8)
-> (PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8)
-> Ord PixelCMYK8
PixelCMYK8 -> PixelCMYK8 -> Bool
PixelCMYK8 -> PixelCMYK8 -> Ordering
PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelCMYK8 -> PixelCMYK8 -> Ordering
compare :: PixelCMYK8 -> PixelCMYK8 -> Ordering
$c< :: PixelCMYK8 -> PixelCMYK8 -> Bool
< :: PixelCMYK8 -> PixelCMYK8 -> Bool
$c<= :: PixelCMYK8 -> PixelCMYK8 -> Bool
<= :: PixelCMYK8 -> PixelCMYK8 -> Bool
$c> :: PixelCMYK8 -> PixelCMYK8 -> Bool
> :: PixelCMYK8 -> PixelCMYK8 -> Bool
$c>= :: PixelCMYK8 -> PixelCMYK8 -> Bool
>= :: PixelCMYK8 -> PixelCMYK8 -> Bool
$cmax :: PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8
max :: PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8
$cmin :: PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8
min :: PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8
Ord, Int -> PixelCMYK8 -> [Char] -> [Char]
[PixelCMYK8] -> [Char] -> [Char]
PixelCMYK8 -> [Char]
(Int -> PixelCMYK8 -> [Char] -> [Char])
-> (PixelCMYK8 -> [Char])
-> ([PixelCMYK8] -> [Char] -> [Char])
-> Show PixelCMYK8
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelCMYK8 -> [Char] -> [Char]
showsPrec :: Int -> PixelCMYK8 -> [Char] -> [Char]
$cshow :: PixelCMYK8 -> [Char]
show :: PixelCMYK8 -> [Char]
$cshowList :: [PixelCMYK8] -> [Char] -> [Char]
showList :: [PixelCMYK8] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing 16bit cyan, magenta, yellow and black (CMYK) information.

-- Values are stored in the following order:

--

--   * Cyan

--

--   * Magenta

--

--   * Yellow

--

--   * Black

--

data PixelCMYK16 = PixelCMYK16 {-# UNPACK #-} !Pixel16 -- Cyan

                               {-# UNPACK #-} !Pixel16 -- Magenta

                               {-# UNPACK #-} !Pixel16 -- Yellow

                               {-# UNPACK #-} !Pixel16 -- Black

                 deriving (PixelCMYK16 -> PixelCMYK16 -> Bool
(PixelCMYK16 -> PixelCMYK16 -> Bool)
-> (PixelCMYK16 -> PixelCMYK16 -> Bool) -> Eq PixelCMYK16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelCMYK16 -> PixelCMYK16 -> Bool
== :: PixelCMYK16 -> PixelCMYK16 -> Bool
$c/= :: PixelCMYK16 -> PixelCMYK16 -> Bool
/= :: PixelCMYK16 -> PixelCMYK16 -> Bool
Eq, Eq PixelCMYK16
Eq PixelCMYK16 =>
(PixelCMYK16 -> PixelCMYK16 -> Ordering)
-> (PixelCMYK16 -> PixelCMYK16 -> Bool)
-> (PixelCMYK16 -> PixelCMYK16 -> Bool)
-> (PixelCMYK16 -> PixelCMYK16 -> Bool)
-> (PixelCMYK16 -> PixelCMYK16 -> Bool)
-> (PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16)
-> (PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16)
-> Ord PixelCMYK16
PixelCMYK16 -> PixelCMYK16 -> Bool
PixelCMYK16 -> PixelCMYK16 -> Ordering
PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelCMYK16 -> PixelCMYK16 -> Ordering
compare :: PixelCMYK16 -> PixelCMYK16 -> Ordering
$c< :: PixelCMYK16 -> PixelCMYK16 -> Bool
< :: PixelCMYK16 -> PixelCMYK16 -> Bool
$c<= :: PixelCMYK16 -> PixelCMYK16 -> Bool
<= :: PixelCMYK16 -> PixelCMYK16 -> Bool
$c> :: PixelCMYK16 -> PixelCMYK16 -> Bool
> :: PixelCMYK16 -> PixelCMYK16 -> Bool
$c>= :: PixelCMYK16 -> PixelCMYK16 -> Bool
>= :: PixelCMYK16 -> PixelCMYK16 -> Bool
$cmax :: PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16
max :: PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16
$cmin :: PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16
min :: PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16
Ord, Int -> PixelCMYK16 -> [Char] -> [Char]
[PixelCMYK16] -> [Char] -> [Char]
PixelCMYK16 -> [Char]
(Int -> PixelCMYK16 -> [Char] -> [Char])
-> (PixelCMYK16 -> [Char])
-> ([PixelCMYK16] -> [Char] -> [Char])
-> Show PixelCMYK16
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelCMYK16 -> [Char] -> [Char]
showsPrec :: Int -> PixelCMYK16 -> [Char] -> [Char]
$cshow :: PixelCMYK16 -> [Char]
show :: PixelCMYK16 -> [Char]
$cshowList :: [PixelCMYK16] -> [Char] -> [Char]
showList :: [PixelCMYK16] -> [Char] -> [Char]
Show, Typeable)


-- | Classical pixel type storing 8bit red, green, blue and alpha (RGBA) information.

-- Values are stored in the following order:

--

--  * Red

--

--  * Green

--

--  * Blue

--

--  * Alpha

--

data PixelRGBA8 = PixelRGBA8 {-# UNPACK #-} !Pixel8 -- Red

                             {-# UNPACK #-} !Pixel8 -- Green

                             {-# UNPACK #-} !Pixel8 -- Blue

                             {-# UNPACK #-} !Pixel8 -- Alpha

                deriving (PixelRGBA8 -> PixelRGBA8 -> Bool
(PixelRGBA8 -> PixelRGBA8 -> Bool)
-> (PixelRGBA8 -> PixelRGBA8 -> Bool) -> Eq PixelRGBA8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelRGBA8 -> PixelRGBA8 -> Bool
== :: PixelRGBA8 -> PixelRGBA8 -> Bool
$c/= :: PixelRGBA8 -> PixelRGBA8 -> Bool
/= :: PixelRGBA8 -> PixelRGBA8 -> Bool
Eq, Eq PixelRGBA8
Eq PixelRGBA8 =>
(PixelRGBA8 -> PixelRGBA8 -> Ordering)
-> (PixelRGBA8 -> PixelRGBA8 -> Bool)
-> (PixelRGBA8 -> PixelRGBA8 -> Bool)
-> (PixelRGBA8 -> PixelRGBA8 -> Bool)
-> (PixelRGBA8 -> PixelRGBA8 -> Bool)
-> (PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8)
-> (PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8)
-> Ord PixelRGBA8
PixelRGBA8 -> PixelRGBA8 -> Bool
PixelRGBA8 -> PixelRGBA8 -> Ordering
PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelRGBA8 -> PixelRGBA8 -> Ordering
compare :: PixelRGBA8 -> PixelRGBA8 -> Ordering
$c< :: PixelRGBA8 -> PixelRGBA8 -> Bool
< :: PixelRGBA8 -> PixelRGBA8 -> Bool
$c<= :: PixelRGBA8 -> PixelRGBA8 -> Bool
<= :: PixelRGBA8 -> PixelRGBA8 -> Bool
$c> :: PixelRGBA8 -> PixelRGBA8 -> Bool
> :: PixelRGBA8 -> PixelRGBA8 -> Bool
$c>= :: PixelRGBA8 -> PixelRGBA8 -> Bool
>= :: PixelRGBA8 -> PixelRGBA8 -> Bool
$cmax :: PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8
max :: PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8
$cmin :: PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8
min :: PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8
Ord, Int -> PixelRGBA8 -> [Char] -> [Char]
[PixelRGBA8] -> [Char] -> [Char]
PixelRGBA8 -> [Char]
(Int -> PixelRGBA8 -> [Char] -> [Char])
-> (PixelRGBA8 -> [Char])
-> ([PixelRGBA8] -> [Char] -> [Char])
-> Show PixelRGBA8
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelRGBA8 -> [Char] -> [Char]
showsPrec :: Int -> PixelRGBA8 -> [Char] -> [Char]
$cshow :: PixelRGBA8 -> [Char]
show :: PixelRGBA8 -> [Char]
$cshowList :: [PixelRGBA8] -> [Char] -> [Char]
showList :: [PixelRGBA8] -> [Char] -> [Char]
Show, Typeable)

-- | Pixel type storing 16bit red, green, blue and alpha (RGBA) information.

-- Values are stored in the following order:

--

--  * Red

--

--  * Green

--

--  * Blue

--

--  * Alpha

--

data PixelRGBA16 = PixelRGBA16 {-# UNPACK #-} !Pixel16 -- Red

                               {-# UNPACK #-} !Pixel16 -- Green

                               {-# UNPACK #-} !Pixel16 -- Blue

                               {-# UNPACK #-} !Pixel16 -- Alpha

                deriving (PixelRGBA16 -> PixelRGBA16 -> Bool
(PixelRGBA16 -> PixelRGBA16 -> Bool)
-> (PixelRGBA16 -> PixelRGBA16 -> Bool) -> Eq PixelRGBA16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelRGBA16 -> PixelRGBA16 -> Bool
== :: PixelRGBA16 -> PixelRGBA16 -> Bool
$c/= :: PixelRGBA16 -> PixelRGBA16 -> Bool
/= :: PixelRGBA16 -> PixelRGBA16 -> Bool
Eq, Eq PixelRGBA16
Eq PixelRGBA16 =>
(PixelRGBA16 -> PixelRGBA16 -> Ordering)
-> (PixelRGBA16 -> PixelRGBA16 -> Bool)
-> (PixelRGBA16 -> PixelRGBA16 -> Bool)
-> (PixelRGBA16 -> PixelRGBA16 -> Bool)
-> (PixelRGBA16 -> PixelRGBA16 -> Bool)
-> (PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16)
-> (PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16)
-> Ord PixelRGBA16
PixelRGBA16 -> PixelRGBA16 -> Bool
PixelRGBA16 -> PixelRGBA16 -> Ordering
PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PixelRGBA16 -> PixelRGBA16 -> Ordering
compare :: PixelRGBA16 -> PixelRGBA16 -> Ordering
$c< :: PixelRGBA16 -> PixelRGBA16 -> Bool
< :: PixelRGBA16 -> PixelRGBA16 -> Bool
$c<= :: PixelRGBA16 -> PixelRGBA16 -> Bool
<= :: PixelRGBA16 -> PixelRGBA16 -> Bool
$c> :: PixelRGBA16 -> PixelRGBA16 -> Bool
> :: PixelRGBA16 -> PixelRGBA16 -> Bool
$c>= :: PixelRGBA16 -> PixelRGBA16 -> Bool
>= :: PixelRGBA16 -> PixelRGBA16 -> Bool
$cmax :: PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16
max :: PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16
$cmin :: PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16
min :: PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16
Ord, Int -> PixelRGBA16 -> [Char] -> [Char]
[PixelRGBA16] -> [Char] -> [Char]
PixelRGBA16 -> [Char]
(Int -> PixelRGBA16 -> [Char] -> [Char])
-> (PixelRGBA16 -> [Char])
-> ([PixelRGBA16] -> [Char] -> [Char])
-> Show PixelRGBA16
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PixelRGBA16 -> [Char] -> [Char]
showsPrec :: Int -> PixelRGBA16 -> [Char] -> [Char]
$cshow :: PixelRGBA16 -> [Char]
show :: PixelRGBA16 -> [Char]
$cshowList :: [PixelRGBA16] -> [Char] -> [Char]
showList :: [PixelRGBA16] -> [Char] -> [Char]
Show, Typeable)

-- | Definition of pixels used in images. Each pixel has a color space, and a representative

-- component (Word8 or Float).

class ( Storable (PixelBaseComponent a)
      , Num (PixelBaseComponent a), Eq a ) => Pixel a where
    -- | Type of the pixel component, "classical" images

    -- would have Word8 type as their PixelBaseComponent,

    -- HDR image would have Float for instance

    type PixelBaseComponent a :: *

    -- | Call the function for every component of the pixels.

    -- For example for RGB pixels mixWith is declared like this:

    --

    -- > mixWith f (PixelRGB8 ra ga ba) (PixelRGB8 rb gb bb) =

    -- >    PixelRGB8 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb)

    --

    mixWith :: (Int -> PixelBaseComponent a -> PixelBaseComponent a -> PixelBaseComponent a)
            -> a -> a -> a

    -- | Extension of the `mixWith` which separate the treatment

    -- of the color components of the alpha value (transparency component).

    -- For pixel without alpha components, it is equivalent to mixWith.

    --

    -- > mixWithAlpha f fa (PixelRGBA8 ra ga ba aa) (PixelRGB8 rb gb bb ab) =

    -- >    PixelRGBA8 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb) (fa aa ab)

    --

    mixWithAlpha :: (Int -> PixelBaseComponent a -> PixelBaseComponent a
                         -> PixelBaseComponent a)  -- ^ Function for color component

                 -> (PixelBaseComponent a -> PixelBaseComponent a
                         -> PixelBaseComponent a) -- ^ Function for alpha component

                 -> a -> a -> a
    {-# INLINE mixWithAlpha #-}
    mixWithAlpha Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a
f PixelBaseComponent a
-> PixelBaseComponent a -> PixelBaseComponent a
_ = (Int
 -> PixelBaseComponent a
 -> PixelBaseComponent a
 -> PixelBaseComponent a)
-> a -> a -> a
forall a.
Pixel a =>
(Int
 -> PixelBaseComponent a
 -> PixelBaseComponent a
 -> PixelBaseComponent a)
-> a -> a -> a
mixWith Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a
f

    -- | Return the opacity of a pixel, if the pixel has an

    -- alpha layer, return the alpha value. If the pixel

    -- doesn't have an alpha value, return a value

    -- representing the opaqueness.

    pixelOpacity :: a -> PixelBaseComponent a

    -- | Return the number of components of the pixel

    componentCount :: a -> Int

    -- | Apply a function to each component of a pixel.

    -- If the color type possess an alpha (transparency channel),

    -- it is treated like the other color components.

    colorMap :: (PixelBaseComponent a -> PixelBaseComponent a) -> a -> a

    -- | Calculate the index for the begining of the pixel

    pixelBaseIndex :: Image a -> Int -> Int -> Int
    pixelBaseIndex (Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w }) Int
x Int
y =
            (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)

    -- | Calculate theindex for the begining of the pixel at position x y

    mutablePixelBaseIndex :: MutableImage s a -> Int -> Int -> Int
    mutablePixelBaseIndex (MutableImage { mutableImageWidth :: forall s a. MutableImage s a -> Int
mutableImageWidth = Int
w }) Int
x Int
y =
            (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)

    -- | Extract a pixel at a given position, (x, y), the origin

    -- is assumed to be at the corner top left, positive y to the

    -- bottom of the image

    pixelAt :: Image a -> Int -> Int -> a

    -- | Same as pixelAt but for mutable images.

    readPixel :: PrimMonad m => MutableImage (PrimState m) a -> Int -> Int -> m a

    -- | Write a pixel in a mutable image at position x y

    writePixel :: PrimMonad m => MutableImage (PrimState m) a -> Int -> Int -> a -> m ()

    -- | Unsafe version of pixelAt, read a pixel at the given

    -- index without bound checking (if possible).

    -- The index is expressed in number (PixelBaseComponent a)

    unsafePixelAt :: V.Vector (PixelBaseComponent a) -> Int -> a

    -- | Unsafe version of readPixel,  read a pixel at the given

    -- position without bound checking (if possible). The index

    -- is expressed in number (PixelBaseComponent a)

    unsafeReadPixel :: PrimMonad m => M.STVector (PrimState m) (PixelBaseComponent a) -> Int -> m a

    -- | Unsafe version of writePixel, write a pixel at the

    -- given position without bound checking. This can be _really_ unsafe.

    -- The index is expressed in number (PixelBaseComponent a)

    unsafeWritePixel :: PrimMonad m => M.STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()


-- | Implement upcasting for pixel types.

-- Minimal declaration of `promotePixel`.

-- It is strongly recommended to overload promoteImage to keep

-- performance acceptable

class (Pixel a, Pixel b) => ColorConvertible a b where
    -- | Convert a pixel type to another pixel type. This

    -- operation should never lose any data.

    promotePixel :: a -> b

    -- | Change the underlying pixel type of an image by performing a full copy

    -- of it.

    promoteImage :: Image a -> Image b
    promoteImage = (a -> b) -> Image a -> Image b
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap a -> b
forall a b. ColorConvertible a b => a -> b
promotePixel

-- | This class abstract colorspace conversion. This

-- conversion can be lossy, which ColorConvertible cannot

class (Pixel a, Pixel b) => ColorSpaceConvertible a b where
    -- | Pass a pixel from a colorspace (say RGB) to the second one

    -- (say YCbCr)

    convertPixel :: a -> b

    -- | Helper function to convert a whole image by taking a

    -- copy it.

    convertImage :: Image a -> Image b
    convertImage = (a -> b) -> Image a -> Image b
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap a -> b
forall a b. ColorSpaceConvertible a b => a -> b
convertPixel

generateMutableImage :: forall m px. (Pixel px, PrimMonad m)
                     => (Int -> Int -> px)  -- ^ Generating function, with `x` and `y` params.

                     -> Int        -- ^ Width in pixels

                     -> Int        -- ^ Height in pixels

                     -> m (MutableImage (PrimState m) px)
{-# INLINE generateMutableImage #-}
generateMutableImage :: forall (m :: * -> *) px.
(Pixel px, PrimMonad m) =>
(Int -> Int -> px)
-> Int -> Int -> m (MutableImage (PrimState m) px)
generateMutableImage Int -> Int -> px
f Int
w Int
h = Int
-> Int
-> MVector (PrimState m) (PixelBaseComponent px)
-> MutableImage (PrimState m) px
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
w Int
h (MVector (PrimState m) (PixelBaseComponent px)
 -> MutableImage (PrimState m) px)
-> m (MVector (PrimState m) (PixelBaseComponent px))
-> m (MutableImage (PrimState m) px)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (MVector (PrimState m) (PixelBaseComponent px))
generated where
  compCount :: Int
compCount = px -> Int
forall a. Pixel a => a -> Int
componentCount (px
forall a. HasCallStack => a
undefined :: px)

  generated :: m (MVector (PrimState m) (PixelBaseComponent px))
generated = do
    MVector (PrimState m) (PixelBaseComponent px)
arr <- Int -> m (MVector (PrimState m) (PixelBaseComponent px))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compCount)
    let lineGenerator :: Int -> Int -> m ()
lineGenerator Int
_ !Int
y | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
h = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        lineGenerator !Int
lineIdx Int
y = Int -> Int -> m ()
column Int
lineIdx Int
0
          where column :: Int -> Int -> m ()
column !Int
idx !Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Int -> Int -> m ()
lineGenerator Int
idx (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                column Int
idx Int
x = do
                    MVector (PrimState m) (PixelBaseComponent px) -> Int -> px -> m ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent px) -> Int -> px -> m ()
unsafeWritePixel MVector (PrimState m) (PixelBaseComponent px)
arr Int
idx (px -> m ()) -> px -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> px
f Int
x Int
y
                    Int -> Int -> m ()
column (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
compCount) (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Int -> Int -> m ()
lineGenerator Int
0 Int
0
    MVector (PrimState m) (PixelBaseComponent px)
-> m (MVector (PrimState m) (PixelBaseComponent px))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector (PrimState m) (PixelBaseComponent px)
arr

-- | Create an image given a function to generate pixels.

-- The function will receive values from 0 to width-1 for the x parameter

-- and 0 to height-1 for the y parameter. The coordinates 0,0 are the upper

-- left corner of the image, and (width-1, height-1) the lower right corner.

--

-- for example, to create a small gradient image:

--

-- > imageCreator :: String -> IO ()

-- > imageCreator path = writePng path $ generateImage pixelRenderer 250 300

-- >    where pixelRenderer x y = PixelRGB8 (fromIntegral x) (fromIntegral y) 128

--

generateImage :: forall px. (Pixel px)
              => (Int -> Int -> px)  -- ^ Generating function, with `x` and `y` params.

              -> Int        -- ^ Width in pixels

              -> Int        -- ^ Height in pixels

              -> Image px
{-# INLINE generateImage #-}
generateImage :: forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> px
f Int
w Int
h = (forall s. ST s (Image px)) -> Image px
forall a. (forall s. ST s a) -> a
runST ST s (Image px)
forall s. ST s (Image px)
img where
  img :: ST s (Image px)
  img :: forall s. ST s (Image px)
img = (Int -> Int -> px)
-> Int -> Int -> ST s (MutableImage (PrimState (ST s)) px)
forall (m :: * -> *) px.
(Pixel px, PrimMonad m) =>
(Int -> Int -> px)
-> Int -> Int -> m (MutableImage (PrimState m) px)
generateMutableImage Int -> Int -> px
f Int
w Int
h ST s (MutableImage s px)
-> (MutableImage s px -> ST s (Image px)) -> ST s (Image px)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableImage s px -> ST s (Image px)
MutableImage (PrimState (ST s)) px -> ST s (Image px)
forall px (m :: * -> *).
(Storable (PixelBaseComponent px), PrimMonad m) =>
MutableImage (PrimState m) px -> m (Image px)
unsafeFreezeImage

-- | Create an image using a monadic initializer function.

-- The function will receive values from 0 to width-1 for the x parameter

-- and 0 to height-1 for the y parameter. The coordinates 0,0 are the upper

-- left corner of the image, and (width-1, height-1) the lower right corner.

--

-- The function is called for each pixel in the line from left to right (0 to width - 1)

-- and for each line (0 to height - 1).

withImage :: forall m pixel. (Pixel pixel, PrimMonad m)
          => Int                     -- ^ Image width

          -> Int                     -- ^ Image height

          -> (Int -> Int -> m pixel) -- ^ Generating functions

          -> m (Image pixel)
withImage :: forall (m :: * -> *) pixel.
(Pixel pixel, PrimMonad m) =>
Int -> Int -> (Int -> Int -> m pixel) -> m (Image pixel)
withImage Int
width Int
height Int -> Int -> m pixel
pixelGenerator = do
  let pixelComponentCount :: Int
pixelComponentCount = pixel -> Int
forall a. Pixel a => a -> Int
componentCount (pixel
forall a. HasCallStack => a
undefined :: pixel)
  MVector (PrimState m) (PixelBaseComponent pixel)
arr <- Int -> m (MVector (PrimState m) (PixelBaseComponent pixel))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pixelComponentCount)
  let mutImage :: MutableImage (PrimState m) pixel
mutImage = MutableImage
        { mutableImageWidth :: Int
mutableImageWidth = Int
width
        , mutableImageHeight :: Int
mutableImageHeight = Int
height
        , mutableImageData :: MVector (PrimState m) (PixelBaseComponent pixel)
mutableImageData = MVector (PrimState m) (PixelBaseComponent pixel)
arr
        }

  let pixelPositions :: [(Int, Int)]
pixelPositions = [(Int
x, Int
y) | Int
y <- [Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
x <- [Int
0..Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
  [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Int -> Int -> m pixel
pixelGenerator Int
x Int
y m pixel -> (pixel -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector (PrimState m) (PixelBaseComponent pixel)
-> Int -> pixel -> m ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent pixel)
-> Int -> pixel -> m ()
unsafeWritePixel MVector (PrimState m) (PixelBaseComponent pixel)
arr Int
idx
                        | ((Int
x,Int
y), Int
idx) <- [(Int, Int)] -> [Int] -> [((Int, Int), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Int)]
pixelPositions [Int
0, Int
pixelComponentCount ..]]
  MutableImage (PrimState m) pixel -> m (Image pixel)
forall px (m :: * -> *).
(Storable (PixelBaseComponent px), PrimMonad m) =>
MutableImage (PrimState m) px -> m (Image px)
unsafeFreezeImage MutableImage (PrimState m) pixel
mutImage

-- | Create an image given a function to generate pixels.

-- The function will receive values from 0 to width-1 for the x parameter

-- and 0 to height-1 for the y parameter. The coordinates 0,0 are the upper

-- left corner of the image, and (width-1, height-1) the lower right corner.

--

-- the acc parameter is a user defined one.

--

-- The function is called for each pixel in the line from left to right (0 to width - 1)

-- and for each line (0 to height - 1).

generateFoldImage :: forall a acc. (Pixel a)
                  => (acc -> Int -> Int -> (acc, a)) -- ^ Function taking the state, x and y

                  -> acc        -- ^ Initial state

                  -> Int        -- ^ Width in pixels

                  -> Int        -- ^ Height in pixels

                  -> (acc, Image a)
generateFoldImage :: forall a acc.
Pixel a =>
(acc -> Int -> Int -> (acc, a))
-> acc -> Int -> Int -> (acc, Image a)
generateFoldImage acc -> Int -> Int -> (acc, a)
f acc
intialAcc Int
w Int
h =
 (acc
finalState, Image { imageWidth :: Int
imageWidth = Int
w, imageHeight :: Int
imageHeight = Int
h, imageData :: Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent a)
generated })
  where compCount :: Int
compCount = a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)
        (acc
finalState, Vector (PixelBaseComponent a)
generated) = (forall s. ST s (acc, Vector (PixelBaseComponent a)))
-> (acc, Vector (PixelBaseComponent a))
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (acc, Vector (PixelBaseComponent a)))
 -> (acc, Vector (PixelBaseComponent a)))
-> (forall s. ST s (acc, Vector (PixelBaseComponent a)))
-> (acc, Vector (PixelBaseComponent a))
forall a b. (a -> b) -> a -> b
$ do
            MVector s (PixelBaseComponent a)
arr <- Int -> ST s (MVector (PrimState (ST s)) (PixelBaseComponent a))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compCount)
            let mutImage :: MutableImage s a
mutImage = MutableImage {
                                mutableImageWidth :: Int
mutableImageWidth = Int
w,
                                mutableImageHeight :: Int
mutableImageHeight = Int
h,
                                mutableImageData :: MVector s (PixelBaseComponent a)
mutableImageData = MVector s (PixelBaseComponent a)
arr }
            acc
foldResult <- (acc -> (Int, Int) -> ST s acc) -> acc -> [(Int, Int)] -> ST s acc
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\acc
acc (Int
x,Int
y) -> do
                    let (acc
acc', a
px) = acc -> Int -> Int -> (acc, a)
f acc
acc Int
x Int
y
                    MutableImage (PrimState (ST s)) a -> Int -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
MutableImage (PrimState m) a -> Int -> Int -> a -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) a -> Int -> Int -> a -> m ()
writePixel MutableImage s a
MutableImage (PrimState (ST s)) a
mutImage Int
x Int
y a
px
                    acc -> ST s acc
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return acc
acc') acc
intialAcc [(Int
x,Int
y) | Int
y <- [Int
0 .. Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
x <- [Int
0 .. Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]

            Vector (PixelBaseComponent a)
frozen <- MVector (PrimState (ST s)) (PixelBaseComponent a)
-> ST s (Vector (PixelBaseComponent a))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector s (PixelBaseComponent a)
MVector (PrimState (ST s)) (PixelBaseComponent a)
arr
            (acc, Vector (PixelBaseComponent a))
-> ST s (acc, Vector (PixelBaseComponent a))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
foldResult, Vector (PixelBaseComponent a)
frozen)

-- | Fold over the pixel of an image with a raster scan order:

-- from top to bottom, left to right

{-# INLINE pixelFold #-}
pixelFold :: forall acc pixel. (Pixel pixel)
          => (acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> acc
pixelFold :: forall acc pixel.
Pixel pixel =>
(acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> acc
pixelFold acc -> Int -> Int -> pixel -> acc
f acc
initialAccumulator img :: Image pixel
img@(Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h }) =
  Int -> acc -> Int -> acc
columnFold Int
0 acc
initialAccumulator Int
0
    where
      !compCount :: Int
compCount = pixel -> Int
forall a. Pixel a => a -> Int
componentCount (pixel
forall a. HasCallStack => a
undefined :: pixel)
      !vec :: Vector (PixelBaseComponent pixel)
vec = Image pixel -> Vector (PixelBaseComponent pixel)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image pixel
img

      lfold :: Int -> acc -> Int -> Int -> acc
lfold !Int
y acc
acc !Int
x !Int
idx
        | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Int -> acc -> Int -> acc
columnFold (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) acc
acc Int
idx
        | Bool
otherwise = 
            Int -> acc -> Int -> Int -> acc
lfold Int
y (acc -> Int -> Int -> pixel -> acc
f acc
acc Int
x Int
y (pixel -> acc) -> pixel -> acc
forall a b. (a -> b) -> a -> b
$ Vector (PixelBaseComponent pixel) -> Int -> pixel
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent pixel)
vec Int
idx) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
compCount)

      columnFold :: Int -> acc -> Int -> acc
columnFold !Int
y acc
lineAcc !Int
readIdx
        | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
h = acc
lineAcc
        | Bool
otherwise = Int -> acc -> Int -> Int -> acc
lfold Int
y acc
lineAcc Int
0 Int
readIdx

-- | Fold over the pixel of an image with a raster scan order:

-- from top to bottom, left to right, carrying out a state

pixelFoldM :: (Pixel pixel, Monad m)
           => (acc -> Int -> Int -> pixel -> m acc) -- ^ monadic mapping function

           -> acc                              -- ^ Initial state

           -> Image pixel                       -- ^ Image to fold over

           -> m acc
{-# INLINE pixelFoldM  #-}
pixelFoldM :: forall pixel (m :: * -> *) acc.
(Pixel pixel, Monad m) =>
(acc -> Int -> Int -> pixel -> m acc)
-> acc -> Image pixel -> m acc
pixelFoldM acc -> Int -> Int -> pixel -> m acc
action acc
initialAccumulator img :: Image pixel
img@(Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h }) =
  acc -> Int -> (acc -> Int -> m acc) -> m acc
forall (m :: * -> *) a.
Monad m =>
a -> Int -> (a -> Int -> m a) -> m a
lineFold acc
initialAccumulator Int
h acc -> Int -> m acc
columnFold
    where
      pixelFolder :: Int -> acc -> Int -> m acc
pixelFolder Int
y acc
acc Int
x = acc -> Int -> Int -> pixel -> m acc
action acc
acc Int
x Int
y (pixel -> m acc) -> pixel -> m acc
forall a b. (a -> b) -> a -> b
$ Image pixel -> Int -> Int -> pixel
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image pixel
img Int
x Int
y
      columnFold :: acc -> Int -> m acc
columnFold acc
lineAcc Int
y = acc -> Int -> (acc -> Int -> m acc) -> m acc
forall (m :: * -> *) a.
Monad m =>
a -> Int -> (a -> Int -> m a) -> m a
lineFold acc
lineAcc Int
w (Int -> acc -> Int -> m acc
pixelFolder Int
y)


-- | Fold over the pixel of an image with a raster scan order:

-- from top to bottom, left to right. This functions is analog

-- to the foldMap from the 'Foldable' typeclass, but due to the

-- Pixel constraint, Image cannot be made an instance of it.

pixelFoldMap :: forall m px. (Pixel px, Monoid m) => (px -> m) -> Image px -> m
pixelFoldMap :: forall m px. (Pixel px, Monoid m) => (px -> m) -> Image px -> m
pixelFoldMap px -> m
f Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent px)
vec } = Int -> m
folder Int
0
  where
    compCount :: Int
compCount = px -> Int
forall a. Pixel a => a -> Int
componentCount (px
forall a. HasCallStack => a
undefined :: px)
    maxi :: Int
maxi = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compCount

    folder :: Int -> m
folder Int
idx | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = m
forall a. Monoid a => a
mempty
    folder Int
idx = px -> m
f (Vector (PixelBaseComponent px) -> Int -> px
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent px)
vec Int
idx) m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> m
folder (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
compCount)

-- | `map` equivalent for an image, working at the pixel level.

-- Little example : a brightness function for an rgb image

--

-- > brightnessRGB8 :: Int -> Image PixelRGB8 -> Image PixelRGB8

-- > brightnessRGB8 add = pixelMap brightFunction

-- >      where up v = fromIntegral (fromIntegral v + add)

-- >            brightFunction (PixelRGB8 r g b) =

-- >                    PixelRGB8 (up r) (up g) (up b)

--

pixelMap :: forall a b. (Pixel a, Pixel b)
         => (a -> b) -> Image a -> Image b
{-# SPECIALIZE INLINE pixelMap :: (PixelYCbCr8 -> PixelRGB8) -> Image PixelYCbCr8 -> Image PixelRGB8 #-}
{-# SPECIALIZE INLINE pixelMap :: (PixelRGB8 -> PixelYCbCr8) -> Image PixelRGB8 -> Image PixelYCbCr8 #-}
{-# SPECIALIZE INLINE pixelMap :: (PixelRGB8 -> PixelRGB8) -> Image PixelRGB8 -> Image PixelRGB8 #-}
{-# SPECIALIZE INLINE pixelMap :: (PixelRGB8 -> PixelRGBA8) -> Image PixelRGB8 -> Image PixelRGBA8 #-}
{-# SPECIALIZE INLINE pixelMap :: (PixelRGBA8 -> PixelRGBA8) -> Image PixelRGBA8 -> Image PixelRGBA8 #-}
{-# SPECIALIZE INLINE pixelMap :: (Pixel8 -> PixelRGB8) -> Image Pixel8 -> Image PixelRGB8 #-}
{-# SPECIALIZE INLINE pixelMap :: (Pixel8 -> Pixel8) -> Image Pixel8 -> Image Pixel8 #-}
pixelMap :: forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap a -> b
f Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent a)
vec } =
  Int -> Int -> Vector (PixelBaseComponent b) -> Image b
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector (PixelBaseComponent b)
pixels
    where sourceComponentCount :: Int
sourceComponentCount = a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)
          destComponentCount :: Int
destComponentCount = b -> Int
forall a. Pixel a => a -> Int
componentCount (b
forall a. HasCallStack => a
undefined :: b)

          pixels :: Vector (PixelBaseComponent b)
pixels = (forall s. ST s (Vector (PixelBaseComponent b)))
-> Vector (PixelBaseComponent b)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (PixelBaseComponent b)))
 -> Vector (PixelBaseComponent b))
-> (forall s. ST s (Vector (PixelBaseComponent b)))
-> Vector (PixelBaseComponent b)
forall a b. (a -> b) -> a -> b
$ do
            MVector s (PixelBaseComponent b)
newArr <- Int -> ST s (MVector (PrimState (ST s)) (PixelBaseComponent b))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
destComponentCount)
            let lineMapper :: Int -> Int -> Int -> ST s ()
lineMapper Int
_ Int
_ Int
y | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
h = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                lineMapper Int
readIdxLine Int
writeIdxLine Int
y = Int -> Int -> Int -> ST s ()
colMapper Int
readIdxLine Int
writeIdxLine Int
0
                  where colMapper :: Int -> Int -> Int -> ST s ()
colMapper Int
readIdx Int
writeIdx Int
x
                            | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Int -> Int -> Int -> ST s ()
lineMapper Int
readIdx Int
writeIdx (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                            | Bool
otherwise = do
                                MVector (PrimState (ST s)) (PixelBaseComponent b)
-> Int -> b -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent b) -> Int -> b -> m ()
unsafeWritePixel MVector s (PixelBaseComponent b)
MVector (PrimState (ST s)) (PixelBaseComponent b)
newArr Int
writeIdx (b -> ST s ()) -> (a -> b) -> a -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$ Vector (PixelBaseComponent a) -> Int -> a
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent a)
vec Int
readIdx
                                Int -> Int -> Int -> ST s ()
colMapper (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sourceComponentCount)
                                          (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
destComponentCount)
                                          (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Int -> Int -> Int -> ST s ()
lineMapper Int
0 Int
0 Int
0

            -- unsafeFreeze avoids making a second copy and it will be

            -- safe because newArray can't be referenced as a mutable array

            -- outside of this where block

            MVector (PrimState (ST s)) (PixelBaseComponent b)
-> ST s (Vector (PixelBaseComponent b))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector s (PixelBaseComponent b)
MVector (PrimState (ST s)) (PixelBaseComponent b)
newArr


-- | Helpers to embed a rankNTypes inside an Applicative

newtype GenST a = GenST { forall a. GenST a -> forall s. ST s (STVector s a)
genAction :: forall s. ST s (M.STVector s a) }

-- | Traversal type matching the definition in the Lens package.

type Traversal s t a b =
    forall f. Applicative f => (a -> f b) -> s -> f t 

writePx :: Pixel px
        => Int -> GenST (PixelBaseComponent px) -> px -> GenST (PixelBaseComponent px)
{-# INLINE writePx #-}
writePx :: forall px.
Pixel px =>
Int
-> GenST (PixelBaseComponent px)
-> px
-> GenST (PixelBaseComponent px)
writePx Int
idx GenST (PixelBaseComponent px)
act px
px = (forall s. ST s (STVector s (PixelBaseComponent px)))
-> GenST (PixelBaseComponent px)
forall a. (forall s. ST s (STVector s a)) -> GenST a
GenST ((forall s. ST s (STVector s (PixelBaseComponent px)))
 -> GenST (PixelBaseComponent px))
-> (forall s. ST s (STVector s (PixelBaseComponent px)))
-> GenST (PixelBaseComponent px)
forall a b. (a -> b) -> a -> b
$ do
   STVector s (PixelBaseComponent px)
vec <- GenST (PixelBaseComponent px)
-> forall s. ST s (STVector s (PixelBaseComponent px))
forall a. GenST a -> forall s. ST s (STVector s a)
genAction GenST (PixelBaseComponent px)
act
   STVector (PrimState (ST s)) (PixelBaseComponent px)
-> Int -> px -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent px) -> Int -> px -> m ()
unsafeWritePixel STVector s (PixelBaseComponent px)
STVector (PrimState (ST s)) (PixelBaseComponent px)
vec Int
idx px
px
   STVector s (PixelBaseComponent px)
-> ST s (STVector s (PixelBaseComponent px))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return STVector s (PixelBaseComponent px)
vec

freezeGenST :: Pixel px
            => Int -> Int -> GenST (PixelBaseComponent px) -> Image px
freezeGenST :: forall px.
Pixel px =>
Int -> Int -> GenST (PixelBaseComponent px) -> Image px
freezeGenST Int
w Int
h GenST (PixelBaseComponent px)
act =
  Int -> Int -> Vector (PixelBaseComponent px) -> Image px
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h ((forall s. ST s (Vector (PixelBaseComponent px)))
-> Vector (PixelBaseComponent px)
forall a. (forall s. ST s a) -> a
runST (GenST (PixelBaseComponent px)
-> forall s. ST s (STVector s (PixelBaseComponent px))
forall a. GenST a -> forall s. ST s (STVector s a)
genAction GenST (PixelBaseComponent px)
act ST s (STVector s (PixelBaseComponent px))
-> (STVector s (PixelBaseComponent px)
    -> ST s (Vector (PixelBaseComponent px)))
-> ST s (Vector (PixelBaseComponent px))
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STVector s (PixelBaseComponent px)
-> ST s (Vector (PixelBaseComponent px))
MVector (PrimState (ST s)) (PixelBaseComponent px)
-> ST s (Vector (PixelBaseComponent px))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze))

-- | Traversal in "raster" order, from left to right the top to bottom.

-- This traversal is matching pixelMap in spirit.

--

-- Since 3.2.4

imagePixels :: forall pxa pxb. (Pixel pxa, Pixel pxb)
            => Traversal (Image pxa) (Image pxb) pxa pxb
{-# INLINE imagePixels #-}
imagePixels :: forall pxa pxb.
(Pixel pxa, Pixel pxb) =>
Traversal (Image pxa) (Image pxb) pxa pxb
imagePixels pxa -> f pxb
f Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent pxa)
vec } =
  Int -> Int -> GenST (PixelBaseComponent pxb) -> Image pxb
forall px.
Pixel px =>
Int -> Int -> GenST (PixelBaseComponent px) -> Image px
freezeGenST Int
w Int
h (GenST (PixelBaseComponent pxb) -> Image pxb)
-> f (GenST (PixelBaseComponent pxb)) -> f (Image pxb)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (GenST (PixelBaseComponent pxb))
pixels
  where
    sourceComponentCount :: Int
sourceComponentCount = pxa -> Int
forall a. Pixel a => a -> Int
componentCount (pxa
forall a. HasCallStack => a
undefined :: pxa)
    destComponentCount :: Int
destComponentCount = pxb -> Int
forall a. Pixel a => a -> Int
componentCount (pxb
forall a. HasCallStack => a
undefined :: pxb)

    maxi :: Int
maxi = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sourceComponentCount
    pixels :: f (GenST (PixelBaseComponent pxb))
pixels =
      f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> f (GenST (PixelBaseComponent pxb))
go (GenST (PixelBaseComponent pxb)
-> f (GenST (PixelBaseComponent pxb))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenST (PixelBaseComponent pxb)
 -> f (GenST (PixelBaseComponent pxb)))
-> GenST (PixelBaseComponent pxb)
-> f (GenST (PixelBaseComponent pxb))
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (STVector s (PixelBaseComponent pxb)))
-> GenST (PixelBaseComponent pxb)
forall a. (forall s. ST s (STVector s a)) -> GenST a
GenST ((forall s. ST s (STVector s (PixelBaseComponent pxb)))
 -> GenST (PixelBaseComponent pxb))
-> (forall s. ST s (STVector s (PixelBaseComponent pxb)))
-> GenST (PixelBaseComponent pxb)
forall a b. (a -> b) -> a -> b
$ Int -> ST s (MVector (PrimState (ST s)) (PixelBaseComponent pxb))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
destComponentCount)) Int
0 Int
0

    go :: f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> f (GenST (PixelBaseComponent pxb))
go f (GenST (PixelBaseComponent pxb))
act Int
readIdx Int
_ | Int
readIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = f (GenST (PixelBaseComponent pxb))
act
    go f (GenST (PixelBaseComponent pxb))
act Int
readIdx Int
writeIdx =
      f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> f (GenST (PixelBaseComponent pxb))
go f (GenST (PixelBaseComponent pxb))
newAct (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sourceComponentCount) (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
destComponentCount)
      where
        px :: f pxb
px = pxa -> f pxb
f (Vector (PixelBaseComponent pxa) -> Int -> pxa
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent pxa)
vec Int
readIdx)
        newAct :: f (GenST (PixelBaseComponent pxb))
newAct = Int
-> GenST (PixelBaseComponent pxb)
-> pxb
-> GenST (PixelBaseComponent pxb)
forall px.
Pixel px =>
Int
-> GenST (PixelBaseComponent px)
-> px
-> GenST (PixelBaseComponent px)
writePx Int
writeIdx (GenST (PixelBaseComponent pxb)
 -> pxb -> GenST (PixelBaseComponent pxb))
-> f (GenST (PixelBaseComponent pxb))
-> f (pxb -> GenST (PixelBaseComponent pxb))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (GenST (PixelBaseComponent pxb))
act f (pxb -> GenST (PixelBaseComponent pxb))
-> f pxb -> f (GenST (PixelBaseComponent pxb))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f pxb
px

-- | Traversal providing the pixel position with it's value.

-- The traversal in raster order, from lef to right, then top

-- to bottom. The traversal match pixelMapXY in spirit.

--

-- Since 3.2.4

imageIPixels :: forall pxa pxb. (Pixel pxa, Pixel pxb)
             => Traversal (Image pxa) (Image pxb) (Int, Int, pxa) pxb
{-# INLINE imageIPixels #-}
imageIPixels :: forall pxa pxb.
(Pixel pxa, Pixel pxb) =>
Traversal (Image pxa) (Image pxb) (Int, Int, pxa) pxb
imageIPixels (Int, Int, pxa) -> f pxb
f Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent pxa)
vec } =
  Int -> Int -> GenST (PixelBaseComponent pxb) -> Image pxb
forall px.
Pixel px =>
Int -> Int -> GenST (PixelBaseComponent px) -> Image px
freezeGenST Int
w Int
h (GenST (PixelBaseComponent pxb) -> Image pxb)
-> f (GenST (PixelBaseComponent pxb)) -> f (Image pxb)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (GenST (PixelBaseComponent pxb))
pixels
  where
    sourceComponentCount :: Int
sourceComponentCount = pxa -> Int
forall a. Pixel a => a -> Int
componentCount (pxa
forall a. HasCallStack => a
undefined :: pxa)
    destComponentCount :: Int
destComponentCount = pxb -> Int
forall a. Pixel a => a -> Int
componentCount (pxb
forall a. HasCallStack => a
undefined :: pxb)

    pixels :: f (GenST (PixelBaseComponent pxb))
pixels =
      f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> Int -> f (GenST (PixelBaseComponent pxb))
lineMapper (GenST (PixelBaseComponent pxb)
-> f (GenST (PixelBaseComponent pxb))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenST (PixelBaseComponent pxb)
 -> f (GenST (PixelBaseComponent pxb)))
-> GenST (PixelBaseComponent pxb)
-> f (GenST (PixelBaseComponent pxb))
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (STVector s (PixelBaseComponent pxb)))
-> GenST (PixelBaseComponent pxb)
forall a. (forall s. ST s (STVector s a)) -> GenST a
GenST ((forall s. ST s (STVector s (PixelBaseComponent pxb)))
 -> GenST (PixelBaseComponent pxb))
-> (forall s. ST s (STVector s (PixelBaseComponent pxb)))
-> GenST (PixelBaseComponent pxb)
forall a b. (a -> b) -> a -> b
$ Int -> ST s (MVector (PrimState (ST s)) (PixelBaseComponent pxb))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
destComponentCount)) Int
0 Int
0 Int
0

    lineMapper :: f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> Int -> f (GenST (PixelBaseComponent pxb))
lineMapper f (GenST (PixelBaseComponent pxb))
act Int
_ Int
_ Int
y | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
h = f (GenST (PixelBaseComponent pxb))
act
    lineMapper f (GenST (PixelBaseComponent pxb))
act Int
readIdxLine Int
writeIdxLine Int
y =
        f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> Int -> f (GenST (PixelBaseComponent pxb))
go f (GenST (PixelBaseComponent pxb))
act Int
readIdxLine Int
writeIdxLine Int
0
      where
        go :: f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> Int -> f (GenST (PixelBaseComponent pxb))
go f (GenST (PixelBaseComponent pxb))
cact Int
readIdx Int
writeIdx Int
x
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> Int -> f (GenST (PixelBaseComponent pxb))
lineMapper f (GenST (PixelBaseComponent pxb))
cact Int
readIdx Int
writeIdx (Int -> f (GenST (PixelBaseComponent pxb)))
-> Int -> f (GenST (PixelBaseComponent pxb))
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          | Bool
otherwise = do
             let px :: f pxb
px = (Int, Int, pxa) -> f pxb
f (Int
x, Int
y, Vector (PixelBaseComponent pxa) -> Int -> pxa
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent pxa)
vec Int
readIdx)
             f (GenST (PixelBaseComponent pxb))
-> Int -> Int -> Int -> f (GenST (PixelBaseComponent pxb))
go (Int
-> GenST (PixelBaseComponent pxb)
-> pxb
-> GenST (PixelBaseComponent pxb)
forall px.
Pixel px =>
Int
-> GenST (PixelBaseComponent px)
-> px
-> GenST (PixelBaseComponent px)
writePx Int
writeIdx (GenST (PixelBaseComponent pxb)
 -> pxb -> GenST (PixelBaseComponent pxb))
-> f (GenST (PixelBaseComponent pxb))
-> f (pxb -> GenST (PixelBaseComponent pxb))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (GenST (PixelBaseComponent pxb))
cact f (pxb -> GenST (PixelBaseComponent pxb))
-> f pxb -> f (GenST (PixelBaseComponent pxb))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f pxb
px)
                (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sourceComponentCount)
                (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
destComponentCount)
                (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Just like `pixelMap` only the function takes the pixel coordinates as

--   additional parameters.

pixelMapXY :: forall a b. (Pixel a, Pixel b)
           => (Int -> Int -> a -> b) -> Image a -> Image b
{-# SPECIALIZE INLINE pixelMapXY :: (Int -> Int -> PixelYCbCr8 -> PixelRGB8)
                                 -> Image PixelYCbCr8 -> Image PixelRGB8 #-}
{-# SPECIALIZE INLINE pixelMapXY :: (Int -> Int -> PixelRGB8 -> PixelYCbCr8)
                                 -> Image PixelRGB8 -> Image PixelYCbCr8 #-}
{-# SPECIALIZE INLINE pixelMapXY :: (Int -> Int -> PixelRGB8 -> PixelRGB8)
                                 -> Image PixelRGB8 -> Image PixelRGB8 #-}
{-# SPECIALIZE INLINE pixelMapXY :: (Int -> Int -> PixelRGB8 -> PixelRGBA8)
                                 -> Image PixelRGB8 -> Image PixelRGBA8 #-}
{-# SPECIALIZE INLINE pixelMapXY :: (Int -> Int -> PixelRGBA8 -> PixelRGBA8)
                                 -> Image PixelRGBA8 -> Image PixelRGBA8 #-}
{-# SPECIALIZE INLINE pixelMapXY :: (Int -> Int -> Pixel8 -> PixelRGB8)
                                 -> Image Pixel8 -> Image PixelRGB8 #-}
pixelMapXY :: forall a b.
(Pixel a, Pixel b) =>
(Int -> Int -> a -> b) -> Image a -> Image b
pixelMapXY Int -> Int -> a -> b
f Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent a)
vec } =
  Int -> Int -> Vector (PixelBaseComponent b) -> Image b
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector (PixelBaseComponent b)
pixels
    where sourceComponentCount :: Int
sourceComponentCount = a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)
          destComponentCount :: Int
destComponentCount = b -> Int
forall a. Pixel a => a -> Int
componentCount (b
forall a. HasCallStack => a
undefined :: b)

          pixels :: Vector (PixelBaseComponent b)
pixels = (forall s. ST s (Vector (PixelBaseComponent b)))
-> Vector (PixelBaseComponent b)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (PixelBaseComponent b)))
 -> Vector (PixelBaseComponent b))
-> (forall s. ST s (Vector (PixelBaseComponent b)))
-> Vector (PixelBaseComponent b)
forall a b. (a -> b) -> a -> b
$ do
            MVector s (PixelBaseComponent b)
newArr <- Int -> ST s (MVector (PrimState (ST s)) (PixelBaseComponent b))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
destComponentCount)
            let lineMapper :: Int -> Int -> Int -> ST s ()
lineMapper Int
_ Int
_ Int
y | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
h = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                lineMapper Int
readIdxLine Int
writeIdxLine Int
y = Int -> Int -> Int -> ST s ()
colMapper Int
readIdxLine Int
writeIdxLine Int
0
                  where colMapper :: Int -> Int -> Int -> ST s ()
colMapper Int
readIdx Int
writeIdx Int
x
                            | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Int -> Int -> Int -> ST s ()
lineMapper Int
readIdx Int
writeIdx (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                            | Bool
otherwise = do
                                MVector (PrimState (ST s)) (PixelBaseComponent b)
-> Int -> b -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent b) -> Int -> b -> m ()
unsafeWritePixel MVector s (PixelBaseComponent b)
MVector (PrimState (ST s)) (PixelBaseComponent b)
newArr Int
writeIdx (b -> ST s ()) -> (a -> b) -> a -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> b
f Int
x Int
y (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$ Vector (PixelBaseComponent a) -> Int -> a
forall a. Pixel a => Vector (PixelBaseComponent a) -> Int -> a
unsafePixelAt Vector (PixelBaseComponent a)
vec Int
readIdx
                                Int -> Int -> Int -> ST s ()
colMapper (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sourceComponentCount)
                                          (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
destComponentCount)
                                          (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Int -> Int -> Int -> ST s ()
lineMapper Int
0 Int
0 Int
0

            -- unsafeFreeze avoids making a second copy and it will be

            -- safe because newArray can't be referenced as a mutable array

            -- outside of this where block

            MVector (PrimState (ST s)) (PixelBaseComponent b)
-> ST s (Vector (PixelBaseComponent b))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector s (PixelBaseComponent b)
MVector (PrimState (ST s)) (PixelBaseComponent b)
newArr

-- | Combine, pixel by pixel and component by component

-- the values of 3 different images. Usage example:

--

-- > averageBrightNess c1 c2 c3 = clamp $ toInt c1 + toInt c2 + toInt c3

-- >   where clamp = fromIntegral . min 0 . max 255

-- >         toInt :: a -> Int

-- >         toInt = fromIntegral

-- > ziPixelComponent3 averageBrightNess img1 img2 img3

--

zipPixelComponent3
    :: forall px. ( V.Storable (PixelBaseComponent px))
    => (PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px
            -> PixelBaseComponent px)
    -> Image px -> Image px -> Image px -> Image px
{-# INLINE zipPixelComponent3 #-}
zipPixelComponent3 :: forall px.
Storable (PixelBaseComponent px) =>
(PixelBaseComponent px
 -> PixelBaseComponent px
 -> PixelBaseComponent px
 -> PixelBaseComponent px)
-> Image px -> Image px -> Image px -> Image px
zipPixelComponent3 PixelBaseComponent px
-> PixelBaseComponent px
-> PixelBaseComponent px
-> PixelBaseComponent px
f i1 :: Image px
i1@(Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h }) Image px
i2 Image px
i3
  | Bool -> Bool
not Bool
isDimensionEqual = [Char] -> Image px
forall a. HasCallStack => [Char] -> a
error [Char]
"Different image size zipPairwisePixelComponent"
  | Bool
otherwise = Image { imageWidth :: Int
imageWidth = Int
w
                      , imageHeight :: Int
imageHeight = Int
h
                      , imageData :: Vector (PixelBaseComponent px)
imageData = (PixelBaseComponent px
 -> PixelBaseComponent px
 -> PixelBaseComponent px
 -> PixelBaseComponent px)
-> Vector (PixelBaseComponent px)
-> Vector (PixelBaseComponent px)
-> Vector (PixelBaseComponent px)
-> Vector (PixelBaseComponent px)
forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
V.zipWith3 PixelBaseComponent px
-> PixelBaseComponent px
-> PixelBaseComponent px
-> PixelBaseComponent px
f Vector (PixelBaseComponent px)
data1 Vector (PixelBaseComponent px)
data2 Vector (PixelBaseComponent px)
data3
                      }
       where data1 :: Vector (PixelBaseComponent px)
data1 = Image px -> Vector (PixelBaseComponent px)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image px
i1
             data2 :: Vector (PixelBaseComponent px)
data2 = Image px -> Vector (PixelBaseComponent px)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image px
i2
             data3 :: Vector (PixelBaseComponent px)
data3 = Image px -> Vector (PixelBaseComponent px)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image px
i3

             isDimensionEqual :: Bool
isDimensionEqual =
                 Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image px -> Int
forall a. Image a -> Int
imageWidth Image px
i2 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image px -> Int
forall a. Image a -> Int
imageWidth Image px
i3 Bool -> Bool -> Bool
&&
                     Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image px -> Int
forall a. Image a -> Int
imageHeight Image px
i2 Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image px -> Int
forall a. Image a -> Int
imageHeight Image px
i3

-- | Helper class to help extract a luma plane out

-- of an image or a pixel

class (Pixel a, Pixel (PixelBaseComponent a)) => LumaPlaneExtractable a where
    -- | Compute the luminance part of a pixel

    computeLuma      :: a -> PixelBaseComponent a

    -- | Extract a luma plane out of an image. This

    -- method is in the typeclass to help performant

    -- implementation.

    --

    -- > jpegToGrayScale :: FilePath -> FilePath -> IO ()

    -- > jpegToGrayScale source dest

    extractLumaPlane :: Image a -> Image (PixelBaseComponent a)
    extractLumaPlane = (a -> PixelBaseComponent a)
-> Image a -> Image (PixelBaseComponent a)
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap a -> PixelBaseComponent a
forall a. LumaPlaneExtractable a => a -> PixelBaseComponent a
computeLuma

instance LumaPlaneExtractable Pixel8 where
    {-# INLINE computeLuma #-}
    computeLuma :: Pixel8 -> PixelBaseComponent Pixel8
computeLuma = Pixel8 -> Pixel8
Pixel8 -> PixelBaseComponent Pixel8
forall a. a -> a
id
    extractLumaPlane :: Image Pixel8 -> Image (PixelBaseComponent Pixel8)
extractLumaPlane = Image Pixel8 -> Image Pixel8
Image Pixel8 -> Image (PixelBaseComponent Pixel8)
forall a. a -> a
id

instance LumaPlaneExtractable Pixel16 where
    {-# INLINE computeLuma #-}
    computeLuma :: Pixel16 -> PixelBaseComponent Pixel16
computeLuma = Pixel16 -> Pixel16
Pixel16 -> PixelBaseComponent Pixel16
forall a. a -> a
id
    extractLumaPlane :: Image Pixel16 -> Image (PixelBaseComponent Pixel16)
extractLumaPlane = Image Pixel16 -> Image Pixel16
Image Pixel16 -> Image (PixelBaseComponent Pixel16)
forall a. a -> a
id

instance LumaPlaneExtractable Pixel32 where
    {-# INLINE computeLuma #-}
    computeLuma :: Pixel32 -> PixelBaseComponent Pixel32
computeLuma = Pixel32 -> Pixel32
Pixel32 -> PixelBaseComponent Pixel32
forall a. a -> a
id
    extractLumaPlane :: Image Pixel32 -> Image (PixelBaseComponent Pixel32)
extractLumaPlane = Image Pixel32 -> Image Pixel32
Image Pixel32 -> Image (PixelBaseComponent Pixel32)
forall a. a -> a
id

instance LumaPlaneExtractable PixelF where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelF -> PixelBaseComponent PixelF
computeLuma = PixelF -> PixelF
PixelF -> PixelBaseComponent PixelF
forall a. a -> a
id
    extractLumaPlane :: Image PixelF -> Image (PixelBaseComponent PixelF)
extractLumaPlane = Image PixelF -> Image PixelF
Image PixelF -> Image (PixelBaseComponent PixelF)
forall a. a -> a
id

instance LumaPlaneExtractable PixelRGBF where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelRGBF -> PixelBaseComponent PixelRGBF
computeLuma (PixelRGBF PixelF
r PixelF
g PixelF
b) =
        PixelF
0.3 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
r PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
0.59 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
g PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
0.11 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
b

instance LumaPlaneExtractable PixelRGBA8 where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelRGBA8 -> PixelBaseComponent PixelRGBA8
computeLuma (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
_) =
       Double -> PixelBaseComponent PixelRGBA8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> PixelBaseComponent PixelRGBA8)
-> Double -> PixelBaseComponent PixelRGBA8
forall a b. (a -> b) -> a -> b
$ (Double
0.3 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
r
             Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.59 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
g
             Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.11 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
b

instance LumaPlaneExtractable PixelYCbCr8 where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8
computeLuma (PixelYCbCr8 Pixel8
y Pixel8
_ Pixel8
_) = Pixel8
PixelBaseComponent PixelYCbCr8
y
    extractLumaPlane :: Image PixelYCbCr8 -> Image (PixelBaseComponent PixelYCbCr8)
extractLumaPlane = PlaneLuma
-> Image PixelYCbCr8 -> Image (PixelBaseComponent PixelYCbCr8)
forall px plane.
(Pixel px, Pixel (PixelBaseComponent px),
 PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px,
 ColorPlane px plane) =>
plane -> Image px -> Image (PixelBaseComponent px)
extractComponent PlaneLuma
PlaneLuma

-- | Free promotion for identic pixel types

instance (Pixel a) => ColorConvertible a a where
    {-# INLINE promotePixel #-}
    promotePixel :: a -> a
promotePixel = a -> a
forall a. a -> a
id

    {-# INLINE promoteImage #-}
    promoteImage :: Image a -> Image a
promoteImage = Image a -> Image a
forall a. a -> a
id

--------------------------------------------------

----            Pixel8 instances

--------------------------------------------------

instance Pixel Pixel8 where
    type PixelBaseComponent Pixel8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: Pixel8 -> PixelBaseComponent Pixel8
pixelOpacity = Pixel8 -> Pixel8 -> Pixel8
forall a b. a -> b -> a
const Pixel8
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent Pixel8
 -> PixelBaseComponent Pixel8
 -> PixelBaseComponent Pixel8)
-> Pixel8 -> Pixel8 -> Pixel8
mixWith Int
-> PixelBaseComponent Pixel8
-> PixelBaseComponent Pixel8
-> PixelBaseComponent Pixel8
f = Int
-> PixelBaseComponent Pixel8
-> PixelBaseComponent Pixel8
-> PixelBaseComponent Pixel8
f Int
0

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent Pixel8 -> PixelBaseComponent Pixel8)
-> Pixel8 -> Pixel8
colorMap PixelBaseComponent Pixel8 -> PixelBaseComponent Pixel8
f = Pixel8 -> Pixel8
PixelBaseComponent Pixel8 -> PixelBaseComponent Pixel8
f

    {-# INLINE componentCount #-}
    componentCount :: Pixel8 -> Int
componentCount Pixel8
_ = Int
1

    {-# INLINE pixelAt #-}
    pixelAt :: Image Pixel8 -> Int -> Int -> Pixel8
pixelAt (Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent Pixel8)
arr }) Int
x Int
y = Vector Pixel8
Vector (PixelBaseComponent Pixel8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) Pixel8 -> Int -> Int -> m Pixel8
readPixel image :: MutableImage (PrimState m) Pixel8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent Pixel8)
arr }) Int
x Int
y =
        MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent Pixel8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` MutableImage (PrimState m) Pixel8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s Pixel8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) Pixel8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) Pixel8 -> Int -> Int -> Pixel8 -> m ()
writePixel image :: MutableImage (PrimState m) Pixel8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent Pixel8)
arr }) Int
x Int
y =
        MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent Pixel8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` MutableImage (PrimState m) Pixel8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s Pixel8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) Pixel8
image Int
x Int
y

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent Pixel8) -> Int -> Pixel8
unsafePixelAt = Vector Pixel8 -> Int -> Pixel8
Vector (PixelBaseComponent Pixel8) -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent Pixel8)
-> Int -> m Pixel8
unsafeReadPixel = MVector (PrimState m) Pixel8 -> Int -> m Pixel8
MVector (PrimState m) (PixelBaseComponent Pixel8)
-> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent Pixel8)
-> Int -> Pixel8 -> m ()
unsafeWritePixel = MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
MVector (PrimState m) (PixelBaseComponent Pixel8)
-> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite

instance ColorConvertible Pixel8 PixelYA8 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel8 -> PixelYA8
promotePixel Pixel8
c = Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 Pixel8
c Pixel8
255

instance ColorConvertible Pixel8 PixelF where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel8 -> PixelF
promotePixel Pixel8
c = Pixel8 -> PixelF
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c PixelF -> PixelF -> PixelF
forall a. Fractional a => a -> a -> a
/ PixelF
255.0

instance ColorConvertible Pixel8 Pixel16 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel8 -> Pixel16
promotePixel Pixel8
c = Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257

instance ColorConvertible Pixel8 PixelRGB8 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel8 -> PixelRGB8
promotePixel Pixel8
c = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 Pixel8
c Pixel8
c Pixel8
c

instance ColorConvertible Pixel8 PixelRGB16 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel8 -> PixelRGB16
promotePixel Pixel8
c = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257) (Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257) (Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257)

instance ColorConvertible Pixel8 PixelRGBA8 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel8 -> PixelRGBA8
promotePixel Pixel8
c = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
c Pixel8
c Pixel8
c Pixel8
255

--------------------------------------------------

----            Pixel16 instances

--------------------------------------------------

instance Pixel Pixel16 where
    type PixelBaseComponent Pixel16 = Word16

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: Pixel16 -> PixelBaseComponent Pixel16
pixelOpacity = Pixel16 -> Pixel16 -> Pixel16
forall a b. a -> b -> a
const Pixel16
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent Pixel16
 -> PixelBaseComponent Pixel16
 -> PixelBaseComponent Pixel16)
-> Pixel16 -> Pixel16 -> Pixel16
mixWith Int
-> PixelBaseComponent Pixel16
-> PixelBaseComponent Pixel16
-> PixelBaseComponent Pixel16
f = Int
-> PixelBaseComponent Pixel16
-> PixelBaseComponent Pixel16
-> PixelBaseComponent Pixel16
f Int
0

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent Pixel16 -> PixelBaseComponent Pixel16)
-> Pixel16 -> Pixel16
colorMap PixelBaseComponent Pixel16 -> PixelBaseComponent Pixel16
f = Pixel16 -> Pixel16
PixelBaseComponent Pixel16 -> PixelBaseComponent Pixel16
f

    {-# INLINE componentCount #-}
    componentCount :: Pixel16 -> Int
componentCount Pixel16
_ = Int
1
    {-# INLINE pixelAt #-}
    pixelAt :: Image Pixel16 -> Int -> Int -> Pixel16
pixelAt (Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent Pixel16)
arr }) Int
x Int
y = Vector Pixel16
Vector (PixelBaseComponent Pixel16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) Pixel16 -> Int -> Int -> m Pixel16
readPixel image :: MutableImage (PrimState m) Pixel16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent Pixel16)
arr }) Int
x Int
y =
        MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent Pixel16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` MutableImage (PrimState m) Pixel16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s Pixel16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) Pixel16
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) Pixel16 -> Int -> Int -> Pixel16 -> m ()
writePixel image :: MutableImage (PrimState m) Pixel16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent Pixel16)
arr }) Int
x Int
y =
        MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent Pixel16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` MutableImage (PrimState m) Pixel16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s Pixel16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) Pixel16
image Int
x Int
y

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent Pixel16) -> Int -> Pixel16
unsafePixelAt = Vector Pixel16 -> Int -> Pixel16
Vector (PixelBaseComponent Pixel16) -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent Pixel16)
-> Int -> m Pixel16
unsafeReadPixel = MVector (PrimState m) Pixel16 -> Int -> m Pixel16
MVector (PrimState m) (PixelBaseComponent Pixel16)
-> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent Pixel16)
-> Int -> Pixel16 -> m ()
unsafeWritePixel = MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
MVector (PrimState m) (PixelBaseComponent Pixel16)
-> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite

instance ColorConvertible Pixel16 PixelYA16 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel16 -> PixelYA16
promotePixel Pixel16
c = Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 Pixel16
c Pixel16
forall a. Bounded a => a
maxBound

instance ColorConvertible Pixel16 PixelRGB16 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel16 -> PixelRGB16
promotePixel Pixel16
c = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 Pixel16
c Pixel16
c Pixel16
c

instance ColorConvertible Pixel16 PixelRGBA16 where
    {-# INLINE promotePixel #-}
    promotePixel :: Pixel16 -> PixelRGBA16
promotePixel Pixel16
c = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 Pixel16
c Pixel16
c Pixel16
c Pixel16
forall a. Bounded a => a
maxBound

--------------------------------------------------

----            Pixel32 instances

--------------------------------------------------

instance Pixel Pixel32 where
    type PixelBaseComponent Pixel32 = Word32

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: Pixel32 -> PixelBaseComponent Pixel32
pixelOpacity = Pixel32 -> Pixel32 -> Pixel32
forall a b. a -> b -> a
const Pixel32
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent Pixel32
 -> PixelBaseComponent Pixel32
 -> PixelBaseComponent Pixel32)
-> Pixel32 -> Pixel32 -> Pixel32
mixWith Int
-> PixelBaseComponent Pixel32
-> PixelBaseComponent Pixel32
-> PixelBaseComponent Pixel32
f = Int
-> PixelBaseComponent Pixel32
-> PixelBaseComponent Pixel32
-> PixelBaseComponent Pixel32
f Int
0

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent Pixel32 -> PixelBaseComponent Pixel32)
-> Pixel32 -> Pixel32
colorMap PixelBaseComponent Pixel32 -> PixelBaseComponent Pixel32
f = Pixel32 -> Pixel32
PixelBaseComponent Pixel32 -> PixelBaseComponent Pixel32
f

    {-# INLINE componentCount #-}
    componentCount :: Pixel32 -> Int
componentCount Pixel32
_ = Int
1

    {-# INLINE pixelAt #-}
    pixelAt :: Image Pixel32 -> Int -> Int -> Pixel32
pixelAt (Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent Pixel32)
arr }) Int
x Int
y = Vector Pixel32
Vector (PixelBaseComponent Pixel32)
arr Vector Pixel32 -> Int -> Pixel32
forall a. Storable a => Vector a -> Int -> a
! (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) Pixel32 -> Int -> Int -> m Pixel32
readPixel image :: MutableImage (PrimState m) Pixel32
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent Pixel32)
arr }) Int
x Int
y =
        MVector (PrimState m) Pixel32
STVector (PrimState m) (PixelBaseComponent Pixel32)
arr MVector (PrimState m) Pixel32 -> Int -> m Pixel32
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` MutableImage (PrimState m) Pixel32 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s Pixel32 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) Pixel32
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) Pixel32 -> Int -> Int -> Pixel32 -> m ()
writePixel image :: MutableImage (PrimState m) Pixel32
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent Pixel32)
arr }) Int
x Int
y =
        MVector (PrimState m) Pixel32
STVector (PrimState m) (PixelBaseComponent Pixel32)
arr MVector (PrimState m) Pixel32 -> Int -> Pixel32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` MutableImage (PrimState m) Pixel32 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s Pixel32 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) Pixel32
image Int
x Int
y

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent Pixel32) -> Int -> Pixel32
unsafePixelAt = Vector Pixel32 -> Int -> Pixel32
Vector (PixelBaseComponent Pixel32) -> Int -> Pixel32
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent Pixel32)
-> Int -> m Pixel32
unsafeReadPixel = MVector (PrimState m) Pixel32 -> Int -> m Pixel32
MVector (PrimState m) (PixelBaseComponent Pixel32)
-> Int -> m Pixel32
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent Pixel32)
-> Int -> Pixel32 -> m ()
unsafeWritePixel = MVector (PrimState m) Pixel32 -> Int -> Pixel32 -> m ()
MVector (PrimState m) (PixelBaseComponent Pixel32)
-> Int -> Pixel32 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite

--------------------------------------------------

----            PixelF instances

--------------------------------------------------

instance Pixel PixelF where
    type PixelBaseComponent PixelF = Float

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelF -> PixelBaseComponent PixelF
pixelOpacity = PixelF -> PixelF -> PixelF
forall a b. a -> b -> a
const PixelF
1.0

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelF
 -> PixelBaseComponent PixelF
 -> PixelBaseComponent PixelF)
-> PixelF -> PixelF -> PixelF
mixWith Int
-> PixelBaseComponent PixelF
-> PixelBaseComponent PixelF
-> PixelBaseComponent PixelF
f = Int
-> PixelBaseComponent PixelF
-> PixelBaseComponent PixelF
-> PixelBaseComponent PixelF
f Int
0

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelF -> PixelBaseComponent PixelF)
-> PixelF -> PixelF
colorMap PixelBaseComponent PixelF -> PixelBaseComponent PixelF
f = PixelF -> PixelF
PixelBaseComponent PixelF -> PixelBaseComponent PixelF
f
    {-# INLINE componentCount #-}
    componentCount :: PixelF -> Int
componentCount PixelF
_ = Int
1
    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelF -> Int -> Int -> PixelF
pixelAt (Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelF)
arr }) Int
x Int
y =
        Vector PixelF
Vector (PixelBaseComponent PixelF)
arr Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
! (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelF -> Int -> Int -> m PixelF
readPixel image :: MutableImage (PrimState m) PixelF
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelF)
arr }) Int
x Int
y =
        MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelF)
arr MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` MutableImage (PrimState m) PixelF -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelF -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelF
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelF -> Int -> Int -> PixelF -> m ()
writePixel image :: MutableImage (PrimState m) PixelF
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelF)
arr }) Int
x Int
y =
        MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelF)
arr MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` MutableImage (PrimState m) PixelF -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelF -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelF
image Int
x Int
y

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelF) -> Int -> PixelF
unsafePixelAt = Vector PixelF -> Int -> PixelF
Vector (PixelBaseComponent PixelF) -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelF)
-> Int -> m PixelF
unsafeReadPixel = MVector (PrimState m) PixelF -> Int -> m PixelF
MVector (PrimState m) (PixelBaseComponent PixelF)
-> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelF)
-> Int -> PixelF -> m ()
unsafeWritePixel = MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
MVector (PrimState m) (PixelBaseComponent PixelF)
-> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite

instance ColorConvertible PixelF PixelRGBF where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelF -> PixelRGBF
promotePixel PixelF
c = PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF PixelF
c PixelF
c PixelF
c-- (c / 0.3) (c / 0.59)  (c / 0.11)


--------------------------------------------------

----            PixelYA8 instances

--------------------------------------------------

instance Pixel PixelYA8 where
    type PixelBaseComponent PixelYA8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelYA8 -> PixelBaseComponent PixelYA8
pixelOpacity (PixelYA8 Pixel8
_ Pixel8
a) = Pixel8
PixelBaseComponent PixelYA8
a

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelYA8
 -> PixelBaseComponent PixelYA8
 -> PixelBaseComponent PixelYA8)
-> PixelYA8 -> PixelYA8 -> PixelYA8
mixWith Int
-> PixelBaseComponent PixelYA8
-> PixelBaseComponent PixelYA8
-> PixelBaseComponent PixelYA8
f (PixelYA8 Pixel8
ya Pixel8
aa) (PixelYA8 Pixel8
yb Pixel8
ab) =
        Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 (Int
-> PixelBaseComponent PixelYA8
-> PixelBaseComponent PixelYA8
-> PixelBaseComponent PixelYA8
f Int
0 Pixel8
PixelBaseComponent PixelYA8
ya Pixel8
PixelBaseComponent PixelYA8
yb) (Int
-> PixelBaseComponent PixelYA8
-> PixelBaseComponent PixelYA8
-> PixelBaseComponent PixelYA8
f Int
1 Pixel8
PixelBaseComponent PixelYA8
aa Pixel8
PixelBaseComponent PixelYA8
ab)


    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelYA8 -> PixelBaseComponent PixelYA8)
-> PixelYA8 -> PixelYA8
colorMap PixelBaseComponent PixelYA8 -> PixelBaseComponent PixelYA8
f (PixelYA8 Pixel8
y Pixel8
a) = Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 (PixelBaseComponent PixelYA8 -> PixelBaseComponent PixelYA8
f Pixel8
PixelBaseComponent PixelYA8
y) (PixelBaseComponent PixelYA8 -> PixelBaseComponent PixelYA8
f Pixel8
PixelBaseComponent PixelYA8
a)
    {-# INLINE componentCount #-}
    componentCount :: PixelYA8 -> Int
componentCount PixelYA8
_ = Int
2
    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelYA8 -> Int -> Int -> PixelYA8
pixelAt image :: Image PixelYA8
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelYA8)
arr }) Int
x Int
y =
        Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 (Vector Pixel8
Vector (PixelBaseComponent PixelYA8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) (Vector Pixel8
Vector (PixelBaseComponent PixelYA8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        where baseIdx :: Int
baseIdx = Image PixelYA8 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelYA8
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYA8 -> Int -> Int -> m PixelYA8
readPixel image :: MutableImage (PrimState m) PixelYA8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYA8)
arr }) Int
x Int
y = do
        Pixel8
yv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel8
av <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        PixelYA8 -> m PixelYA8
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelYA8 -> m PixelYA8) -> PixelYA8 -> m PixelYA8
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 Pixel8
yv Pixel8
av
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYA8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYA8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYA8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYA8
-> Int -> Int -> PixelYA8 -> m ()
writePixel image :: MutableImage (PrimState m) PixelYA8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYA8)
arr }) Int
x Int
y (PixelYA8 Pixel8
yv Pixel8
av) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYA8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYA8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYA8
image Int
x Int
y
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel8
yv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel8
av

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelYA8) -> Int -> PixelYA8
unsafePixelAt Vector (PixelBaseComponent PixelYA8)
v Int
idx =
        Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYA8)
v Int
idx) (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYA8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYA8)
-> Int -> m PixelYA8
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelYA8)
vec Int
idx =
        Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 (Pixel8 -> Pixel8 -> PixelYA8)
-> m Pixel8 -> m (Pixel8 -> PixelYA8)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
vec Int
idx m (Pixel8 -> PixelYA8) -> m Pixel8 -> m PixelYA8
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYA8)
-> Int -> PixelYA8 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelYA8)
v Int
idx (PixelYA8 Pixel8
y Pixel8
a) =
        MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
v Int
idx Pixel8
y m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYA8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel8
a

instance ColorConvertible PixelYA8 PixelRGB8 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelYA8 -> PixelRGB8
promotePixel (PixelYA8 Pixel8
y Pixel8
_) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 Pixel8
y Pixel8
y Pixel8
y

instance ColorConvertible PixelYA8 PixelRGB16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelYA8 -> PixelRGB16
promotePixel (PixelYA8 Pixel8
y Pixel8
_) = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
y Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257) (Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
y Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257) (Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
y Pixel16 -> Pixel16 -> Pixel16
forall a. Num a => a -> a -> a
* Pixel16
257)

instance ColorConvertible PixelYA8 PixelRGBA8 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelYA8 -> PixelRGBA8
promotePixel (PixelYA8 Pixel8
y Pixel8
a) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
y Pixel8
y Pixel8
y Pixel8
a

instance ColorPlane PixelYA8 PlaneLuma where
    toComponentIndex :: PixelYA8 -> PlaneLuma -> Int
toComponentIndex PixelYA8
_ PlaneLuma
_ = Int
0

instance ColorPlane PixelYA8 PlaneAlpha where
    toComponentIndex :: PixelYA8 -> PlaneAlpha -> Int
toComponentIndex PixelYA8
_ PlaneAlpha
_ = Int
1

instance TransparentPixel PixelYA8 Pixel8 where
    {-# INLINE dropTransparency #-}
    dropTransparency :: PixelYA8 -> Pixel8
dropTransparency (PixelYA8 Pixel8
y Pixel8
_) = Pixel8
y
    {-# INLINE getTransparency #-}
    getTransparency :: PixelYA8 -> PixelBaseComponent PixelYA8
getTransparency (PixelYA8 Pixel8
_ Pixel8
a) = Pixel8
PixelBaseComponent PixelYA8
a

instance LumaPlaneExtractable PixelYA8 where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelYA8 -> PixelBaseComponent PixelYA8
computeLuma (PixelYA8 Pixel8
y Pixel8
_) = Pixel8
PixelBaseComponent PixelYA8
y
    extractLumaPlane :: Image PixelYA8 -> Image (PixelBaseComponent PixelYA8)
extractLumaPlane = PlaneLuma -> Image PixelYA8 -> Image (PixelBaseComponent PixelYA8)
forall px plane.
(Pixel px, Pixel (PixelBaseComponent px),
 PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px,
 ColorPlane px plane) =>
plane -> Image px -> Image (PixelBaseComponent px)
extractComponent PlaneLuma
PlaneLuma

--------------------------------------------------

----            PixelYA16 instances

--------------------------------------------------

instance Pixel PixelYA16 where
    type PixelBaseComponent PixelYA16 = Word16

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelYA16 -> PixelBaseComponent PixelYA16
pixelOpacity (PixelYA16 Pixel16
_ Pixel16
a) = Pixel16
PixelBaseComponent PixelYA16
a

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelYA16
 -> PixelBaseComponent PixelYA16
 -> PixelBaseComponent PixelYA16)
-> PixelYA16 -> PixelYA16 -> PixelYA16
mixWith Int
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
f (PixelYA16 Pixel16
ya Pixel16
aa) (PixelYA16 Pixel16
yb Pixel16
ab) =
        Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (Int
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
f Int
0 Pixel16
PixelBaseComponent PixelYA16
ya Pixel16
PixelBaseComponent PixelYA16
yb) (Int
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
f Int
1 Pixel16
PixelBaseComponent PixelYA16
aa Pixel16
PixelBaseComponent PixelYA16
ab)

    {-# INLINE mixWithAlpha #-}
    mixWithAlpha :: (Int
 -> PixelBaseComponent PixelYA16
 -> PixelBaseComponent PixelYA16
 -> PixelBaseComponent PixelYA16)
-> (PixelBaseComponent PixelYA16
    -> PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16)
-> PixelYA16
-> PixelYA16
-> PixelYA16
mixWithAlpha Int
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
f PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16
fa (PixelYA16 Pixel16
ya Pixel16
aa) (PixelYA16 Pixel16
yb Pixel16
ab) =
        Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (Int
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16
f Int
0 Pixel16
PixelBaseComponent PixelYA16
ya Pixel16
PixelBaseComponent PixelYA16
yb) (PixelBaseComponent PixelYA16
-> PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16
fa Pixel16
PixelBaseComponent PixelYA16
aa Pixel16
PixelBaseComponent PixelYA16
ab)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16)
-> PixelYA16 -> PixelYA16
colorMap PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16
f (PixelYA16 Pixel16
y Pixel16
a) = Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16
f Pixel16
PixelBaseComponent PixelYA16
y) (PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16
f Pixel16
PixelBaseComponent PixelYA16
a)
    {-# INLINE componentCount #-}
    componentCount :: PixelYA16 -> Int
componentCount PixelYA16
_ = Int
2
    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelYA16 -> Int -> Int -> PixelYA16
pixelAt image :: Image PixelYA16
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelYA16)
arr }) Int
x Int
y = Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (Vector Pixel16
Vector (PixelBaseComponent PixelYA16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                              (Vector Pixel16
Vector (PixelBaseComponent PixelYA16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        where baseIdx :: Int
baseIdx = Image PixelYA16 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelYA16
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYA16 -> Int -> Int -> m PixelYA16
readPixel image :: MutableImage (PrimState m) PixelYA16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYA16)
arr }) Int
x Int
y = do
        Pixel16
yv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel16
av <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        PixelYA16 -> m PixelYA16
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelYA16 -> m PixelYA16) -> PixelYA16 -> m PixelYA16
forall a b. (a -> b) -> a -> b
$ Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 Pixel16
yv Pixel16
av
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYA16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYA16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYA16
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYA16
-> Int -> Int -> PixelYA16 -> m ()
writePixel image :: MutableImage (PrimState m) PixelYA16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYA16)
arr }) Int
x Int
y (PixelYA16 Pixel16
yv Pixel16
av) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYA16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYA16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYA16
image Int
x Int
y
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel16
yv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel16
av

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelYA16) -> Int -> PixelYA16
unsafePixelAt Vector (PixelBaseComponent PixelYA16)
v Int
idx =
        Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelYA16)
v Int
idx) (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelYA16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYA16)
-> Int -> m PixelYA16
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelYA16)
vec Int
idx =
        Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (Pixel16 -> Pixel16 -> PixelYA16)
-> m Pixel16 -> m (Pixel16 -> PixelYA16)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
vec Int
idx m (Pixel16 -> PixelYA16) -> m Pixel16 -> m PixelYA16
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYA16)
-> Int -> PixelYA16 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelYA16)
v Int
idx (PixelYA16 Pixel16
y Pixel16
a) =
        MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
v Int
idx Pixel16
y m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelYA16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel16
a

instance ColorConvertible PixelYA16 PixelRGB16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelYA16 -> PixelRGB16
promotePixel (PixelYA16 Pixel16
y Pixel16
_) = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 Pixel16
y Pixel16
y Pixel16
y

instance ColorConvertible PixelYA16 PixelRGBA16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelYA16 -> PixelRGBA16
promotePixel (PixelYA16 Pixel16
y Pixel16
a) = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 Pixel16
y Pixel16
y Pixel16
y Pixel16
a

instance ColorPlane PixelYA16 PlaneLuma where
    toComponentIndex :: PixelYA16 -> PlaneLuma -> Int
toComponentIndex PixelYA16
_ PlaneLuma
_ = Int
0

instance ColorPlane PixelYA16 PlaneAlpha where
    toComponentIndex :: PixelYA16 -> PlaneAlpha -> Int
toComponentIndex PixelYA16
_ PlaneAlpha
_ = Int
1

instance TransparentPixel PixelYA16 Pixel16 where
    {-# INLINE dropTransparency #-}
    dropTransparency :: PixelYA16 -> Pixel16
dropTransparency (PixelYA16 Pixel16
y Pixel16
_) = Pixel16
y
    {-# INLINE getTransparency #-}
    getTransparency :: PixelYA16 -> PixelBaseComponent PixelYA16
getTransparency (PixelYA16 Pixel16
_ Pixel16
a) = Pixel16
PixelBaseComponent PixelYA16
a

--------------------------------------------------

----            PixelRGBF instances

--------------------------------------------------

instance Pixel PixelRGBF where
    type PixelBaseComponent PixelRGBF = PixelF

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelRGBF -> PixelBaseComponent PixelRGBF
pixelOpacity = PixelF -> PixelRGBF -> PixelF
forall a b. a -> b -> a
const PixelF
1.0

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelRGBF
 -> PixelBaseComponent PixelRGBF
 -> PixelBaseComponent PixelRGBF)
-> PixelRGBF -> PixelRGBF -> PixelRGBF
mixWith Int
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
f (PixelRGBF PixelF
ra PixelF
ga PixelF
ba) (PixelRGBF PixelF
rb PixelF
gb PixelF
bb) =
        PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (Int
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
f Int
0 PixelF
PixelBaseComponent PixelRGBF
ra PixelF
PixelBaseComponent PixelRGBF
rb) (Int
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
f Int
1 PixelF
PixelBaseComponent PixelRGBF
ga PixelF
PixelBaseComponent PixelRGBF
gb) (Int
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
-> PixelBaseComponent PixelRGBF
f Int
2 PixelF
PixelBaseComponent PixelRGBF
ba PixelF
PixelBaseComponent PixelRGBF
bb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelRGBF -> PixelBaseComponent PixelRGBF)
-> PixelRGBF -> PixelRGBF
colorMap PixelBaseComponent PixelRGBF -> PixelBaseComponent PixelRGBF
f (PixelRGBF PixelF
r PixelF
g PixelF
b) = PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (PixelBaseComponent PixelRGBF -> PixelBaseComponent PixelRGBF
f PixelF
PixelBaseComponent PixelRGBF
r) (PixelBaseComponent PixelRGBF -> PixelBaseComponent PixelRGBF
f PixelF
PixelBaseComponent PixelRGBF
g) (PixelBaseComponent PixelRGBF -> PixelBaseComponent PixelRGBF
f PixelF
PixelBaseComponent PixelRGBF
b)

    {-# INLINE componentCount #-}
    componentCount :: PixelRGBF -> Int
componentCount PixelRGBF
_ = Int
3

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelRGBF -> Int -> Int -> PixelRGBF
pixelAt image :: Image PixelRGBF
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGBF)
arr }) Int
x Int
y = PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
arr Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                              (Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
arr Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                              (Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
arr Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        where baseIdx :: Int
baseIdx = Image PixelRGBF -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelRGBF
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBF -> Int -> Int -> m PixelRGBF
readPixel image :: MutableImage (PrimState m) PixelRGBF
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr }) Int
x Int
y = do
        PixelF
rv <- MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        PixelF
gv <- MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        PixelF
bv <- MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        PixelRGBF -> m PixelRGBF
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelRGBF -> m PixelRGBF) -> PixelRGBF -> m PixelRGBF
forall a b. (a -> b) -> a -> b
$ PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF PixelF
rv PixelF
gv PixelF
bv
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGBF -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGBF -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGBF
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBF
-> Int -> Int -> PixelRGBF -> m ()
writePixel image :: MutableImage (PrimState m) PixelRGBF
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr }) Int
x Int
y (PixelRGBF PixelF
rv PixelF
gv PixelF
bv) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGBF -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGBF -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGBF
image Int
x Int
y
        (MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) PixelF
rv
        (MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) PixelF
gv
        (MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
arr MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) PixelF
bv

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelRGBF) -> Int -> PixelRGBF
unsafePixelAt Vector (PixelBaseComponent PixelRGBF)
v Int
idx =
        PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
v Int
idx) (Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
v (Int -> PixelF) -> Int -> PixelF
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Vector PixelF -> Int -> PixelF
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
v (Int -> PixelF) -> Int -> PixelF
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
-> Int -> m PixelRGBF
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelRGBF)
vec Int
idx =
        PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (PixelF -> PixelF -> PixelF -> PixelRGBF)
-> m PixelF -> m (PixelF -> PixelF -> PixelRGBF)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
vec Int
idx
                  m (PixelF -> PixelF -> PixelRGBF)
-> m PixelF -> m (PixelF -> PixelRGBF)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  m (PixelF -> PixelRGBF) -> m PixelF -> m PixelRGBF
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) PixelF -> Int -> m PixelF
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
-> Int -> PixelRGBF -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelRGBF)
v Int
idx (PixelRGBF PixelF
r PixelF
g PixelF
b) =
        MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
v Int
idx PixelF
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PixelF
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) PixelF -> Int -> PixelF -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) PixelF
STVector (PrimState m) (PixelBaseComponent PixelRGBF)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) PixelF
b

instance ColorPlane PixelRGBF PlaneRed where
    toComponentIndex :: PixelRGBF -> PlaneRed -> Int
toComponentIndex PixelRGBF
_ PlaneRed
_ = Int
0

instance ColorPlane PixelRGBF PlaneGreen where
    toComponentIndex :: PixelRGBF -> PlaneGreen -> Int
toComponentIndex PixelRGBF
_ PlaneGreen
_ = Int
1

instance ColorPlane PixelRGBF PlaneBlue where
    toComponentIndex :: PixelRGBF -> PlaneBlue -> Int
toComponentIndex PixelRGBF
_ PlaneBlue
_ = Int
2

--------------------------------------------------

----            PixelRGB16 instances

--------------------------------------------------

instance Pixel PixelRGB16 where
    type PixelBaseComponent PixelRGB16 = Pixel16

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelRGB16 -> PixelBaseComponent PixelRGB16
pixelOpacity = Pixel16 -> PixelRGB16 -> Pixel16
forall a b. a -> b -> a
const Pixel16
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelRGB16
 -> PixelBaseComponent PixelRGB16
 -> PixelBaseComponent PixelRGB16)
-> PixelRGB16 -> PixelRGB16 -> PixelRGB16
mixWith Int
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
f (PixelRGB16 Pixel16
ra Pixel16
ga Pixel16
ba) (PixelRGB16 Pixel16
rb Pixel16
gb Pixel16
bb) =
        Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Int
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
f Int
0 Pixel16
PixelBaseComponent PixelRGB16
ra Pixel16
PixelBaseComponent PixelRGB16
rb) (Int
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
f Int
1 Pixel16
PixelBaseComponent PixelRGB16
ga Pixel16
PixelBaseComponent PixelRGB16
gb) (Int
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
-> PixelBaseComponent PixelRGB16
f Int
2 Pixel16
PixelBaseComponent PixelRGB16
ba Pixel16
PixelBaseComponent PixelRGB16
bb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelRGB16 -> PixelBaseComponent PixelRGB16)
-> PixelRGB16 -> PixelRGB16
colorMap PixelBaseComponent PixelRGB16 -> PixelBaseComponent PixelRGB16
f (PixelRGB16 Pixel16
r Pixel16
g Pixel16
b) = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (PixelBaseComponent PixelRGB16 -> PixelBaseComponent PixelRGB16
f Pixel16
PixelBaseComponent PixelRGB16
r) (PixelBaseComponent PixelRGB16 -> PixelBaseComponent PixelRGB16
f Pixel16
PixelBaseComponent PixelRGB16
g) (PixelBaseComponent PixelRGB16 -> PixelBaseComponent PixelRGB16
f Pixel16
PixelBaseComponent PixelRGB16
b)

    {-# INLINE componentCount #-}
    componentCount :: PixelRGB16 -> Int
componentCount PixelRGB16
_ = Int
3

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelRGB16 -> Int -> Int -> PixelRGB16
pixelAt image :: Image PixelRGB16
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGB16)
arr }) Int
x Int
y = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Vector Pixel16
Vector (PixelBaseComponent PixelRGB16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                               (Vector Pixel16
Vector (PixelBaseComponent PixelRGB16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                               (Vector Pixel16
Vector (PixelBaseComponent PixelRGB16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        where baseIdx :: Int
baseIdx = Image PixelRGB16 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelRGB16
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGB16 -> Int -> Int -> m PixelRGB16
readPixel image :: MutableImage (PrimState m) PixelRGB16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr }) Int
x Int
y = do
        Pixel16
rv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel16
gv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel16
bv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        PixelRGB16 -> m PixelRGB16
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelRGB16 -> m PixelRGB16) -> PixelRGB16 -> m PixelRGB16
forall a b. (a -> b) -> a -> b
$ Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 Pixel16
rv Pixel16
gv Pixel16
bv
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGB16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGB16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGB16
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGB16
-> Int -> Int -> PixelRGB16 -> m ()
writePixel image :: MutableImage (PrimState m) PixelRGB16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr }) Int
x Int
y (PixelRGB16 Pixel16
rv Pixel16
gv Pixel16
bv) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGB16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGB16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGB16
image Int
x Int
y
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel16
rv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel16
gv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel16
bv

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelRGB16) -> Int -> PixelRGB16
unsafePixelAt Vector (PixelBaseComponent PixelRGB16)
v Int
idx =
        Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGB16)
v Int
idx) (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGB16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGB16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
-> Int -> m PixelRGB16
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelRGB16)
vec Int
idx =
        Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16)
-> m Pixel16 -> m (Pixel16 -> Pixel16 -> PixelRGB16)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
vec Int
idx
                   m (Pixel16 -> Pixel16 -> PixelRGB16)
-> m Pixel16 -> m (Pixel16 -> PixelRGB16)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   m (Pixel16 -> PixelRGB16) -> m Pixel16 -> m PixelRGB16
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
-> Int -> PixelRGB16 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelRGB16)
v Int
idx (PixelRGB16 Pixel16
r Pixel16
g Pixel16
b) =
        MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
v Int
idx Pixel16
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel16
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGB16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel16
b

instance ColorPlane PixelRGB16 PlaneRed where
    toComponentIndex :: PixelRGB16 -> PlaneRed -> Int
toComponentIndex PixelRGB16
_ PlaneRed
_ = Int
0

instance ColorPlane PixelRGB16 PlaneGreen where
    toComponentIndex :: PixelRGB16 -> PlaneGreen -> Int
toComponentIndex PixelRGB16
_ PlaneGreen
_ = Int
1

instance ColorPlane PixelRGB16 PlaneBlue where
    toComponentIndex :: PixelRGB16 -> PlaneBlue -> Int
toComponentIndex PixelRGB16
_ PlaneBlue
_ = Int
2

instance ColorSpaceConvertible PixelRGB16 PixelCMYK16 where
    {-# INLINE convertPixel #-}
    convertPixel :: PixelRGB16 -> PixelCMYK16
convertPixel (PixelRGB16 Pixel16
r Pixel16
g Pixel16
b) = (Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16)
-> (Pixel16, Pixel16, Pixel16) -> PixelCMYK16
forall a b.
(Bounded a, Integral a) =>
(a -> a -> a -> a -> b) -> (a, a, a) -> b
integralRGBToCMYK Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (Pixel16
r, Pixel16
g, Pixel16
b)

instance ColorConvertible PixelRGB16 PixelRGBA16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelRGB16 -> PixelRGBA16
promotePixel (PixelRGB16 Pixel16
r Pixel16
g Pixel16
b) = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 Pixel16
r Pixel16
g Pixel16
b Pixel16
forall a. Bounded a => a
maxBound

instance LumaPlaneExtractable PixelRGB16 where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelRGB16 -> PixelBaseComponent PixelRGB16
computeLuma (PixelRGB16 Pixel16
r Pixel16
g Pixel16
b) =
        Double -> PixelBaseComponent PixelRGB16
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> PixelBaseComponent PixelRGB16)
-> Double -> PixelBaseComponent PixelRGB16
forall a b. (a -> b) -> a -> b
$ (Double
0.3 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
r
              Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.59 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
g
              Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.11 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
b

--------------------------------------------------

----            PixelRGB8 instances

--------------------------------------------------

instance Pixel PixelRGB8 where
    type PixelBaseComponent PixelRGB8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelRGB8 -> PixelBaseComponent PixelRGB8
pixelOpacity = Pixel8 -> PixelRGB8 -> Pixel8
forall a b. a -> b -> a
const Pixel8
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelRGB8
 -> PixelBaseComponent PixelRGB8
 -> PixelBaseComponent PixelRGB8)
-> PixelRGB8 -> PixelRGB8 -> PixelRGB8
mixWith Int
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
f (PixelRGB8 Pixel8
ra Pixel8
ga Pixel8
ba) (PixelRGB8 Pixel8
rb Pixel8
gb Pixel8
bb) =
        Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Int
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
f Int
0 Pixel8
PixelBaseComponent PixelRGB8
ra Pixel8
PixelBaseComponent PixelRGB8
rb) (Int
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
f Int
1 Pixel8
PixelBaseComponent PixelRGB8
ga Pixel8
PixelBaseComponent PixelRGB8
gb) (Int
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
-> PixelBaseComponent PixelRGB8
f Int
2 Pixel8
PixelBaseComponent PixelRGB8
ba Pixel8
PixelBaseComponent PixelRGB8
bb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8)
-> PixelRGB8 -> PixelRGB8
colorMap PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8
f (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8
f Pixel8
PixelBaseComponent PixelRGB8
r) (PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8
f Pixel8
PixelBaseComponent PixelRGB8
g) (PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8
f Pixel8
PixelBaseComponent PixelRGB8
b)

    {-# INLINE componentCount #-}
    componentCount :: PixelRGB8 -> Int
componentCount PixelRGB8
_ = Int
3

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelRGB8 -> Int -> Int -> PixelRGB8
pixelAt image :: Image PixelRGB8
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGB8)
arr }) Int
x Int
y = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                              (Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                              (Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        where baseIdx :: Int
baseIdx = Image PixelRGB8 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelRGB8
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGB8 -> Int -> Int -> m PixelRGB8
readPixel image :: MutableImage (PrimState m) PixelRGB8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr }) Int
x Int
y = do
        Pixel8
rv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel8
gv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel8
bv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        PixelRGB8 -> m PixelRGB8
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelRGB8 -> m PixelRGB8) -> PixelRGB8 -> m PixelRGB8
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 Pixel8
rv Pixel8
gv Pixel8
bv
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGB8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGB8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGB8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGB8
-> Int -> Int -> PixelRGB8 -> m ()
writePixel image :: MutableImage (PrimState m) PixelRGB8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr }) Int
x Int
y (PixelRGB8 Pixel8
rv Pixel8
gv Pixel8
bv) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGB8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGB8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGB8
image Int
x Int
y
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel8
rv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel8
gv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel8
bv

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelRGB8) -> Int -> PixelRGB8
unsafePixelAt Vector (PixelBaseComponent PixelRGB8)
v Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
v Int
idx) (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
-> Int -> m PixelRGB8
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelRGB8)
vec Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> PixelRGB8)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
vec Int
idx
                  m (Pixel8 -> Pixel8 -> PixelRGB8)
-> m Pixel8 -> m (Pixel8 -> PixelRGB8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  m (Pixel8 -> PixelRGB8) -> m Pixel8 -> m PixelRGB8
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
-> Int -> PixelRGB8 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelRGB8)
v Int
idx (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) =
        MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
v Int
idx Pixel8
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel8
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGB8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel8
b

instance ColorConvertible PixelRGB8 PixelRGBA8 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelRGB8 -> PixelRGBA8
promotePixel (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
forall a. Bounded a => a
maxBound

instance ColorConvertible PixelRGB8 PixelRGBF where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelRGB8 -> PixelRGBF
promotePixel (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (Pixel8 -> PixelF
forall {a} {a}. (Fractional a, Integral a) => a -> a
toF Pixel8
r) (Pixel8 -> PixelF
forall {a} {a}. (Fractional a, Integral a) => a -> a
toF Pixel8
g) (Pixel8 -> PixelF
forall {a} {a}. (Fractional a, Integral a) => a -> a
toF Pixel8
b)
        where toF :: a -> a
toF a
v = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
255.0

instance ColorConvertible PixelRGB8 PixelRGB16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelRGB8 -> PixelRGB16
promotePixel (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
r) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
g) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
b)

instance ColorConvertible PixelRGB8 PixelRGBA16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelRGB8 -> PixelRGBA16
promotePixel (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
r) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
g) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
b) Pixel16
forall a. Bounded a => a
maxBound

instance ColorPlane PixelRGB8 PlaneRed where
    toComponentIndex :: PixelRGB8 -> PlaneRed -> Int
toComponentIndex PixelRGB8
_ PlaneRed
_ = Int
0

instance ColorPlane PixelRGB8 PlaneGreen where
    toComponentIndex :: PixelRGB8 -> PlaneGreen -> Int
toComponentIndex PixelRGB8
_ PlaneGreen
_ = Int
1

instance ColorPlane PixelRGB8 PlaneBlue where
    toComponentIndex :: PixelRGB8 -> PlaneBlue -> Int
toComponentIndex PixelRGB8
_ PlaneBlue
_ = Int
2

instance LumaPlaneExtractable PixelRGB8 where
    {-# INLINE computeLuma #-}
    computeLuma :: PixelRGB8 -> PixelBaseComponent PixelRGB8
computeLuma (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) =
        Double -> PixelBaseComponent PixelRGB8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> PixelBaseComponent PixelRGB8)
-> Double -> PixelBaseComponent PixelRGB8
forall a b. (a -> b) -> a -> b
$ (Double
0.3 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
r
              Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.59 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
g
              Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.11 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
b

--------------------------------------------------

----            PixelRGBA8 instances

--------------------------------------------------

instance Pixel PixelRGBA8 where
    type PixelBaseComponent PixelRGBA8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelRGBA8 -> PixelBaseComponent PixelRGBA8
pixelOpacity (PixelRGBA8 Pixel8
_ Pixel8
_ Pixel8
_ Pixel8
a) = Pixel8
PixelBaseComponent PixelRGBA8
a

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelRGBA8
 -> PixelBaseComponent PixelRGBA8
 -> PixelBaseComponent PixelRGBA8)
-> PixelRGBA8 -> PixelRGBA8 -> PixelRGBA8
mixWith Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f (PixelRGBA8 Pixel8
ra Pixel8
ga Pixel8
ba Pixel8
aa) (PixelRGBA8 Pixel8
rb Pixel8
gb Pixel8
bb Pixel8
ab) =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
0 Pixel8
PixelBaseComponent PixelRGBA8
ra Pixel8
PixelBaseComponent PixelRGBA8
rb) (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
1 Pixel8
PixelBaseComponent PixelRGBA8
ga Pixel8
PixelBaseComponent PixelRGBA8
gb) (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
2 Pixel8
PixelBaseComponent PixelRGBA8
ba Pixel8
PixelBaseComponent PixelRGBA8
bb) (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
3 Pixel8
PixelBaseComponent PixelRGBA8
aa Pixel8
PixelBaseComponent PixelRGBA8
ab)

    {-# INLINE mixWithAlpha #-}
    mixWithAlpha :: (Int
 -> PixelBaseComponent PixelRGBA8
 -> PixelBaseComponent PixelRGBA8
 -> PixelBaseComponent PixelRGBA8)
-> (PixelBaseComponent PixelRGBA8
    -> PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8)
-> PixelRGBA8
-> PixelRGBA8
-> PixelRGBA8
mixWithAlpha Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
fa (PixelRGBA8 Pixel8
ra Pixel8
ga Pixel8
ba Pixel8
aa) (PixelRGBA8 Pixel8
rb Pixel8
gb Pixel8
bb Pixel8
ab) =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
0 Pixel8
PixelBaseComponent PixelRGBA8
ra Pixel8
PixelBaseComponent PixelRGBA8
rb) (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
1 Pixel8
PixelBaseComponent PixelRGBA8
ga Pixel8
PixelBaseComponent PixelRGBA8
gb) (Int
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8
f Int
2 Pixel8
PixelBaseComponent PixelRGBA8
ba Pixel8
PixelBaseComponent PixelRGBA8
bb) (PixelBaseComponent PixelRGBA8
-> PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
fa Pixel8
PixelBaseComponent PixelRGBA8
aa Pixel8
PixelBaseComponent PixelRGBA8
ab)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8)
-> PixelRGBA8 -> PixelRGBA8
colorMap PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
f (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
f Pixel8
PixelBaseComponent PixelRGBA8
r) (PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
f Pixel8
PixelBaseComponent PixelRGBA8
g) (PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
f Pixel8
PixelBaseComponent PixelRGBA8
b) (PixelBaseComponent PixelRGBA8 -> PixelBaseComponent PixelRGBA8
f Pixel8
PixelBaseComponent PixelRGBA8
a)

    {-# INLINE componentCount #-}
    componentCount :: PixelRGBA8 -> Int
componentCount PixelRGBA8
_ = Int
4

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelRGBA8 -> Int -> Int -> PixelRGBA8
pixelAt image :: Image PixelRGBA8
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGBA8)
arr }) Int
x Int
y = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                               (Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                               (Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
                                                               (Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
        where baseIdx :: Int
baseIdx = Image PixelRGBA8 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelRGBA8
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBA8 -> Int -> Int -> m PixelRGBA8
readPixel image :: MutableImage (PrimState m) PixelRGBA8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr }) Int
x Int
y = do
        Pixel8
rv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel8
gv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel8
bv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        Pixel8
av <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        PixelRGBA8 -> m PixelRGBA8
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelRGBA8 -> m PixelRGBA8) -> PixelRGBA8 -> m PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
rv Pixel8
gv Pixel8
bv Pixel8
av
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGBA8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGBA8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGBA8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBA8
-> Int -> Int -> PixelRGBA8 -> m ()
writePixel image :: MutableImage (PrimState m) PixelRGBA8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr }) Int
x Int
y (PixelRGBA8 Pixel8
rv Pixel8
gv Pixel8
bv Pixel8
av) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGBA8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGBA8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGBA8
image Int
x Int
y
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel8
rv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel8
gv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel8
bv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Pixel8
av

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelRGBA8) -> Int -> PixelRGBA8
unsafePixelAt Vector (PixelBaseComponent PixelRGBA8)
v Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
v Int
idx)
                   (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
-> Int -> m PixelRGBA8
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
vec Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
vec Int
idx
                   m (Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> PixelRGBA8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   m (Pixel8 -> Pixel8 -> PixelRGBA8)
-> m Pixel8 -> m (Pixel8 -> PixelRGBA8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   m (Pixel8 -> PixelRGBA8) -> m Pixel8 -> m PixelRGBA8
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
-> Int -> PixelRGBA8 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
v Int
idx (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a) =
        MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
v Int
idx Pixel8
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel8
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel8
b
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelRGBA8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Pixel8
a

instance ColorConvertible PixelRGBA8 PixelRGBA16 where
    {-# INLINE promotePixel #-}
    promotePixel :: PixelRGBA8 -> PixelRGBA16
promotePixel (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a) = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
r) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
g) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
b) (Pixel8 -> Pixel16
forall a b. ColorConvertible a b => a -> b
promotePixel Pixel8
a)

instance ColorPlane PixelRGBA8 PlaneRed where
    toComponentIndex :: PixelRGBA8 -> PlaneRed -> Int
toComponentIndex PixelRGBA8
_ PlaneRed
_ = Int
0

instance ColorPlane PixelRGBA8 PlaneGreen where
    toComponentIndex :: PixelRGBA8 -> PlaneGreen -> Int
toComponentIndex PixelRGBA8
_ PlaneGreen
_ = Int
1

instance ColorPlane PixelRGBA8 PlaneBlue where
    toComponentIndex :: PixelRGBA8 -> PlaneBlue -> Int
toComponentIndex PixelRGBA8
_ PlaneBlue
_ = Int
2

instance ColorPlane PixelRGBA8 PlaneAlpha where
    toComponentIndex :: PixelRGBA8 -> PlaneAlpha -> Int
toComponentIndex PixelRGBA8
_ PlaneAlpha
_ = Int
3

--------------------------------------------------

----            PixelRGBA16 instances

--------------------------------------------------

instance Pixel PixelRGBA16 where
    type PixelBaseComponent PixelRGBA16 = Pixel16

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelRGBA16 -> PixelBaseComponent PixelRGBA16
pixelOpacity (PixelRGBA16 Pixel16
_ Pixel16
_ Pixel16
_ Pixel16
a) = Pixel16
PixelBaseComponent PixelRGBA16
a

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelRGBA16
 -> PixelBaseComponent PixelRGBA16
 -> PixelBaseComponent PixelRGBA16)
-> PixelRGBA16 -> PixelRGBA16 -> PixelRGBA16
mixWith Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f (PixelRGBA16 Pixel16
ra Pixel16
ga Pixel16
ba Pixel16
aa) (PixelRGBA16 Pixel16
rb Pixel16
gb Pixel16
bb Pixel16
ab) =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
0 Pixel16
PixelBaseComponent PixelRGBA16
ra Pixel16
PixelBaseComponent PixelRGBA16
rb) (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
1 Pixel16
PixelBaseComponent PixelRGBA16
ga Pixel16
PixelBaseComponent PixelRGBA16
gb) (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
2 Pixel16
PixelBaseComponent PixelRGBA16
ba Pixel16
PixelBaseComponent PixelRGBA16
bb) (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
3 Pixel16
PixelBaseComponent PixelRGBA16
aa Pixel16
PixelBaseComponent PixelRGBA16
ab)

    {-# INLINE mixWithAlpha #-}
    mixWithAlpha :: (Int
 -> PixelBaseComponent PixelRGBA16
 -> PixelBaseComponent PixelRGBA16
 -> PixelBaseComponent PixelRGBA16)
-> (PixelBaseComponent PixelRGBA16
    -> PixelBaseComponent PixelRGBA16
    -> PixelBaseComponent PixelRGBA16)
-> PixelRGBA16
-> PixelRGBA16
-> PixelRGBA16
mixWithAlpha Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
fa (PixelRGBA16 Pixel16
ra Pixel16
ga Pixel16
ba Pixel16
aa) (PixelRGBA16 Pixel16
rb Pixel16
gb Pixel16
bb Pixel16
ab) =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
0 Pixel16
PixelBaseComponent PixelRGBA16
ra Pixel16
PixelBaseComponent PixelRGBA16
rb) (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
1 Pixel16
PixelBaseComponent PixelRGBA16
ga Pixel16
PixelBaseComponent PixelRGBA16
gb) (Int
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16
f Int
2 Pixel16
PixelBaseComponent PixelRGBA16
ba Pixel16
PixelBaseComponent PixelRGBA16
bb) (PixelBaseComponent PixelRGBA16
-> PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
fa Pixel16
PixelBaseComponent PixelRGBA16
aa Pixel16
PixelBaseComponent PixelRGBA16
ab)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16)
-> PixelRGBA16 -> PixelRGBA16
colorMap PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
f (PixelRGBA16 Pixel16
r Pixel16
g Pixel16
b Pixel16
a) = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
f Pixel16
PixelBaseComponent PixelRGBA16
r) (PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
f Pixel16
PixelBaseComponent PixelRGBA16
g) (PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
f Pixel16
PixelBaseComponent PixelRGBA16
b) (PixelBaseComponent PixelRGBA16 -> PixelBaseComponent PixelRGBA16
f Pixel16
PixelBaseComponent PixelRGBA16
a)

    {-# INLINE componentCount #-}
    componentCount :: PixelRGBA16 -> Int
componentCount PixelRGBA16
_ = Int
4

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelRGBA16 -> Int -> Int -> PixelRGBA16
pixelAt image :: Image PixelRGBA16
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGBA16)
arr }) Int
x Int
y =
                Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) (Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                            (Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) (Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
        where baseIdx :: Int
baseIdx = Image PixelRGBA16 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelRGBA16
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBA16
-> Int -> Int -> m PixelRGBA16
readPixel image :: MutableImage (PrimState m) PixelRGBA16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr }) Int
x Int
y = do
        Pixel16
rv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel16
gv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel16
bv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        Pixel16
av <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        PixelRGBA16 -> m PixelRGBA16
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelRGBA16 -> m PixelRGBA16) -> PixelRGBA16 -> m PixelRGBA16
forall a b. (a -> b) -> a -> b
$ Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 Pixel16
rv Pixel16
gv Pixel16
bv Pixel16
av
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGBA16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGBA16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGBA16
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBA16
-> Int -> Int -> PixelRGBA16 -> m ()
writePixel image :: MutableImage (PrimState m) PixelRGBA16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr }) Int
x Int
y (PixelRGBA16 Pixel16
rv Pixel16
gv Pixel16
bv Pixel16
av) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelRGBA16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelRGBA16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelRGBA16
image Int
x Int
y
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel16
rv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel16
gv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel16
bv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Pixel16
av

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelRGBA16) -> Int -> PixelRGBA16
unsafePixelAt Vector (PixelBaseComponent PixelRGBA16)
v Int
idx =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
v Int
idx)
                    (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                    (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelRGBA16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
-> Int -> m PixelRGBA16
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
vec Int
idx =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16)
-> m Pixel16 -> m (Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
vec Int
idx
                    m (Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16)
-> m Pixel16 -> m (Pixel16 -> Pixel16 -> PixelRGBA16)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    m (Pixel16 -> Pixel16 -> PixelRGBA16)
-> m Pixel16 -> m (Pixel16 -> PixelRGBA16)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                    m (Pixel16 -> PixelRGBA16) -> m Pixel16 -> m PixelRGBA16
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
-> Int -> PixelRGBA16 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
v Int
idx (PixelRGBA16 Pixel16
r Pixel16
g Pixel16
b Pixel16
a) =
        MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
v Int
idx Pixel16
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel16
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel16
b
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelRGBA16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Pixel16
a


instance TransparentPixel PixelRGBA16 PixelRGB16 where
    {-# INLINE dropTransparency #-}
    dropTransparency :: PixelRGBA16 -> PixelRGB16
dropTransparency (PixelRGBA16 Pixel16
r Pixel16
g Pixel16
b Pixel16
_) = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 Pixel16
r Pixel16
g Pixel16
b
    {-# INLINE getTransparency #-}
    getTransparency :: PixelRGBA16 -> PixelBaseComponent PixelRGBA16
getTransparency (PixelRGBA16 Pixel16
_ Pixel16
_ Pixel16
_ Pixel16
a) = Pixel16
PixelBaseComponent PixelRGBA16
a

instance ColorPlane PixelRGBA16 PlaneRed where
    toComponentIndex :: PixelRGBA16 -> PlaneRed -> Int
toComponentIndex PixelRGBA16
_ PlaneRed
_ = Int
0

instance ColorPlane PixelRGBA16 PlaneGreen where
    toComponentIndex :: PixelRGBA16 -> PlaneGreen -> Int
toComponentIndex PixelRGBA16
_ PlaneGreen
_ = Int
1

instance ColorPlane PixelRGBA16 PlaneBlue where
    toComponentIndex :: PixelRGBA16 -> PlaneBlue -> Int
toComponentIndex PixelRGBA16
_ PlaneBlue
_ = Int
2

instance ColorPlane PixelRGBA16 PlaneAlpha where
    toComponentIndex :: PixelRGBA16 -> PlaneAlpha -> Int
toComponentIndex PixelRGBA16
_ PlaneAlpha
_ = Int
3

--------------------------------------------------

----            PixelYCbCr8 instances

--------------------------------------------------

instance Pixel PixelYCbCr8 where
    type PixelBaseComponent PixelYCbCr8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8
pixelOpacity = Pixel8 -> PixelYCbCr8 -> Pixel8
forall a b. a -> b -> a
const Pixel8
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelYCbCr8
 -> PixelBaseComponent PixelYCbCr8
 -> PixelBaseComponent PixelYCbCr8)
-> PixelYCbCr8 -> PixelYCbCr8 -> PixelYCbCr8
mixWith Int
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
f (PixelYCbCr8 Pixel8
ya Pixel8
cba Pixel8
cra) (PixelYCbCr8 Pixel8
yb Pixel8
cbb Pixel8
crb) =
        Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 (Int
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
f Int
0 Pixel8
PixelBaseComponent PixelYCbCr8
ya Pixel8
PixelBaseComponent PixelYCbCr8
yb) (Int
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
f Int
1 Pixel8
PixelBaseComponent PixelYCbCr8
cba Pixel8
PixelBaseComponent PixelYCbCr8
cbb) (Int
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
-> PixelBaseComponent PixelYCbCr8
f Int
2 Pixel8
PixelBaseComponent PixelYCbCr8
cra Pixel8
PixelBaseComponent PixelYCbCr8
crb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8)
-> PixelYCbCr8 -> PixelYCbCr8
colorMap PixelBaseComponent PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8
f (PixelYCbCr8 Pixel8
y Pixel8
cb Pixel8
cr) = Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 (PixelBaseComponent PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8
f Pixel8
PixelBaseComponent PixelYCbCr8
y) (PixelBaseComponent PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8
f Pixel8
PixelBaseComponent PixelYCbCr8
cb) (PixelBaseComponent PixelYCbCr8 -> PixelBaseComponent PixelYCbCr8
f Pixel8
PixelBaseComponent PixelYCbCr8
cr)
    {-# INLINE componentCount #-}
    componentCount :: PixelYCbCr8 -> Int
componentCount PixelYCbCr8
_ = Int
3
    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelYCbCr8 -> Int -> Int -> PixelYCbCr8
pixelAt image :: Image PixelYCbCr8
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelYCbCr8)
arr }) Int
x Int
y = Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                                (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                                (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        where baseIdx :: Int
baseIdx = Image PixelYCbCr8 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelYCbCr8
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYCbCr8
-> Int -> Int -> m PixelYCbCr8
readPixel image :: MutableImage (PrimState m) PixelYCbCr8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr }) Int
x Int
y = do
        Pixel8
yv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel8
cbv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel8
crv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        PixelYCbCr8 -> m PixelYCbCr8
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelYCbCr8 -> m PixelYCbCr8) -> PixelYCbCr8 -> m PixelYCbCr8
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 Pixel8
yv Pixel8
cbv Pixel8
crv
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYCbCr8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYCbCr8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYCbCr8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYCbCr8
-> Int -> Int -> PixelYCbCr8 -> m ()
writePixel image :: MutableImage (PrimState m) PixelYCbCr8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr }) Int
x Int
y (PixelYCbCr8 Pixel8
yv Pixel8
cbv Pixel8
crv) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYCbCr8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYCbCr8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYCbCr8
image Int
x Int
y
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel8
yv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel8
cbv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel8
crv

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelYCbCr8) -> Int -> PixelYCbCr8
unsafePixelAt Vector (PixelBaseComponent PixelYCbCr8)
v Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
v Int
idx) (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
-> Int -> m PixelYCbCr8
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
vec Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 (Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> PixelYCbCr8)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
vec Int
idx
                    m (Pixel8 -> Pixel8 -> PixelYCbCr8)
-> m Pixel8 -> m (Pixel8 -> PixelYCbCr8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    m (Pixel8 -> PixelYCbCr8) -> m Pixel8 -> m PixelYCbCr8
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
-> Int -> PixelYCbCr8 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
v Int
idx (PixelYCbCr8 Pixel8
y Pixel8
cb Pixel8
cr) =
        MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
v Int
idx Pixel8
y m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel8
cb
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCr8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel8
cr

instance (Pixel a) => ColorSpaceConvertible a a where
    convertPixel :: a -> a
convertPixel = a -> a
forall a. a -> a
id
    convertImage :: Image a -> Image a
convertImage = Image a -> Image a
forall a. a -> a
id

scaleBits, oneHalf :: Int
scaleBits :: Int
scaleBits = Int
16
oneHalf :: Int
oneHalf = Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
scaleBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

fix :: Float -> Int
fix :: PixelF -> Int
fix PixelF
x = PixelF -> Int
forall b. Integral b => PixelF -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Int) -> PixelF -> Int
forall a b. (a -> b) -> a -> b
$ PixelF
x PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Int -> PixelF
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
1 :: Int) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
scaleBits) PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
0.5


rYTab, gYTab, bYTab, rCbTab, gCbTab, bCbTab, gCrTab, bCrTab :: V.Vector Int
rYTab :: Vector Int
rYTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [PixelF -> Int
fix PixelF
0.29900 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i | Int
i <- [Int
0..Int
255] ]
gYTab :: Vector Int
gYTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [PixelF -> Int
fix PixelF
0.58700 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i | Int
i <- [Int
0..Int
255] ]
bYTab :: Vector Int
bYTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [PixelF -> Int
fix PixelF
0.11400 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf | Int
i <- [Int
0..Int
255] ]
rCbTab :: Vector Int
rCbTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [(- PixelF -> Int
fix PixelF
0.16874) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i | Int
i <- [Int
0..Int
255] ]
gCbTab :: Vector Int
gCbTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [(- PixelF -> Int
fix PixelF
0.33126) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i | Int
i <- [Int
0..Int
255] ]
bCbTab :: Vector Int
bCbTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [PixelF -> Int
fix PixelF
0.5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
128 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
scaleBits) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1| Int
i <- [Int
0..Int
255] ]
gCrTab :: Vector Int
gCrTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [(- PixelF -> Int
fix PixelF
0.41869) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i | Int
i <- [Int
0..Int
255] ]
bCrTab :: Vector Int
bCrTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [(- PixelF -> Int
fix PixelF
0.08131) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i | Int
i <- [Int
0..Int
255] ]


instance ColorSpaceConvertible PixelRGB8 PixelYCbCr8 where
    {-# INLINE convertPixel #-}
    convertPixel :: PixelRGB8 -> PixelYCbCr8
convertPixel (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCr8
PixelYCbCr8 (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cb) (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr)
      where ri :: Int
ri = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
r
            gi :: Int
gi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
g
            bi :: Int
bi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
b

            y :: Int
y  = (Vector Int
rYTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
gYTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
gi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
bYTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
bi) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits
            cb :: Int
cb = (Vector Int
rCbTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
gCbTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
gi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
bCbTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
bi) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits
            cr :: Int
cr = (Vector Int
bCbTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
gCrTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
gi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
bCrTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
bi) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits

    convertImage :: Image PixelRGB8 -> Image PixelYCbCr8
convertImage Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGB8)
d } = Int
-> Int
-> Vector (PixelBaseComponent PixelYCbCr8)
-> Image PixelYCbCr8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
newData
        where maxi :: Int
maxi = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h

              rY :: Int
rY  = PixelF -> Int
fix PixelF
0.29900
              gY :: Int
gY  = PixelF -> Int
fix PixelF
0.58700
              bY :: Int
bY  = PixelF -> Int
fix PixelF
0.11400
              rCb :: Int
rCb = - PixelF -> Int
fix PixelF
0.16874
              gCb :: Int
gCb = - PixelF -> Int
fix PixelF
0.33126
              bCb :: Int
bCb = PixelF -> Int
fix PixelF
0.5
              gCr :: Int
gCr = - PixelF -> Int
fix PixelF
0.41869
              bCr :: Int
bCr = - PixelF -> Int
fix PixelF
0.08131

              newData :: Vector Pixel8
newData = (forall s. ST s (Vector Pixel8)) -> Vector Pixel8
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Pixel8)) -> Vector Pixel8)
-> (forall s. ST s (Vector Pixel8)) -> Vector Pixel8
forall a b. (a -> b) -> a -> b
$ do
                MVector s Pixel8
block <- Int -> ST s (MVector (PrimState (ST s)) Pixel8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int -> ST s (MVector (PrimState (ST s)) Pixel8))
-> Int -> ST s (MVector (PrimState (ST s)) Pixel8)
forall a b. (a -> b) -> a -> b
$ Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3
                let traductor :: Int -> Int -> ST s (MVector s Pixel8)
traductor Int
_ Int
idx | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = MVector s Pixel8 -> ST s (MVector s Pixel8)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Pixel8
block
                    traductor Int
readIdx Int
idx = do
                        let ri :: Int
ri = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel8 -> Int) -> Pixel8 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
d Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
readIdx
                            gi :: Int
gi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel8 -> Int) -> Pixel8 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
d Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            bi :: Int
bi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel8 -> Int) -> Pixel8 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
d Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

                            y :: Int
y  = (Int
rY Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gY Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
gi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bY Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits
                            cb :: Int
cb = (Int
rCb Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gCb Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
gi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bCb Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
128 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
scaleBits) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits
                            cr :: Int
cr = (Int
bCb Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
128 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
scaleBits) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gCr Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
gi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bCr Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bi) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits

                        (MVector s Pixel8
MVector (PrimState (ST s)) Pixel8
block MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y
                        (MVector s Pixel8
MVector (PrimState (ST s)) Pixel8
block MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cb
                        (MVector s Pixel8
MVector (PrimState (ST s)) Pixel8
block MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr
                        Int -> Int -> ST s (MVector s Pixel8)
traductor (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

                Int -> Int -> ST s (MVector s Pixel8)
traductor Int
0 Int
0 ST s (MVector s Pixel8)
-> (MVector s Pixel8 -> ST s (Vector Pixel8))
-> ST s (Vector Pixel8)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector s Pixel8 -> ST s (Vector Pixel8)
MVector (PrimState (ST s)) Pixel8 -> ST s (Vector Pixel8)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.freeze

crRTab, cbBTab, crGTab, cbGTab :: V.Vector Int
crRTab :: Vector Int
crRTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [(PixelF -> Int
fix PixelF
1.40200 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits | Int
x <- [-Int
128 .. Int
127]]
cbBTab :: Vector Int
cbBTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [(PixelF -> Int
fix PixelF
1.77200 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits | Int
x <- [-Int
128 .. Int
127]]
crGTab :: Vector Int
crGTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [Int -> Int
forall a. Num a => a -> a
negate (PixelF -> Int
fix PixelF
0.71414) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x | Int
x <- [-Int
128 .. Int
127]]
cbGTab :: Vector Int
cbGTab = Int -> [Int] -> Vector Int
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN Int
256 [Int -> Int
forall a. Num a => a -> a
negate (PixelF -> Int
fix PixelF
0.34414) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oneHalf | Int
x <- [-Int
128 .. Int
127]]

instance ColorSpaceConvertible PixelYCbCr8 PixelRGB8 where
    {-# INLINE convertPixel #-}
    convertPixel :: PixelYCbCr8 -> PixelRGB8
convertPixel (PixelYCbCr8 Pixel8
y Pixel8
cb Pixel8
cr) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Int -> Pixel8
clampWord8 Int
r) (Int -> Pixel8
clampWord8 Int
g) (Int -> Pixel8
clampWord8 Int
b)
        where clampWord8 :: Int -> Pixel8
clampWord8 = Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pixel8) -> (Int -> Int) -> Int -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
255
              yi :: Int
yi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
y
              cbi :: Int
cbi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
cb
              cri :: Int
cri = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
cr

              r :: Int
r = Int
yi Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Vector Int
crRTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cri
              g :: Int
g = Int
yi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Int
cbGTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cbi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
crGTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cri) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits
              b :: Int
b = Int
yi Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Vector Int
cbBTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cbi

    convertImage :: Image PixelYCbCr8 -> Image PixelRGB8
convertImage Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelYCbCr8)
d } = Int
-> Int -> Vector (PixelBaseComponent PixelRGB8) -> Image PixelRGB8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector Pixel8
Vector (PixelBaseComponent PixelRGB8)
newData
        where maxi :: Int
maxi = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h
              clampWord8 :: a -> a
clampWord8 a
v | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a
0
                           | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
255 = a
255
                           | Bool
otherwise = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v

              newData :: Vector Pixel8
newData = (forall s. ST s (Vector Pixel8)) -> Vector Pixel8
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Pixel8)) -> Vector Pixel8)
-> (forall s. ST s (Vector Pixel8)) -> Vector Pixel8
forall a b. (a -> b) -> a -> b
$ do
                MVector s Pixel8
block <- Int -> ST s (MVector (PrimState (ST s)) Pixel8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int -> ST s (MVector (PrimState (ST s)) Pixel8))
-> Int -> ST s (MVector (PrimState (ST s)) Pixel8)
forall a b. (a -> b) -> a -> b
$ Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3
                let traductor :: Int -> Int -> ST s (MVector s Pixel8)
traductor Int
_ Int
idx | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = MVector s Pixel8 -> ST s (MVector s Pixel8)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Pixel8
block
                    traductor Int
readIdx Int
idx = do
                        let yi :: Int
yi =  Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel8 -> Int) -> Pixel8 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
d Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
readIdx
                            cbi :: Int
cbi = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel8 -> Int) -> Pixel8 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
d Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            cri :: Int
cri = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel8 -> Int) -> Pixel8 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Pixel8
Vector (PixelBaseComponent PixelYCbCr8)
d Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

                            r :: Int
r = Int
yi Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Vector Int
crRTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cri
                            g :: Int
g = Int
yi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Int
cbGTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cbi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
crGTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cri) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
scaleBits
                            b :: Int
b = Int
yi Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Vector Int
cbBTab Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`V.unsafeIndex` Int
cbi

                        (MVector s Pixel8
MVector (PrimState (ST s)) Pixel8
block MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Pixel8
forall {a} {a}. (Num a, Integral a) => a -> a
clampWord8 Int
r
                        (MVector s Pixel8
MVector (PrimState (ST s)) Pixel8
block MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Pixel8
forall {a} {a}. (Num a, Integral a) => a -> a
clampWord8 Int
g
                        (MVector s Pixel8
MVector (PrimState (ST s)) Pixel8
block MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Pixel8
forall {a} {a}. (Num a, Integral a) => a -> a
clampWord8 Int
b
                        Int -> Int -> ST s (MVector s Pixel8)
traductor (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

                Int -> Int -> ST s (MVector s Pixel8)
traductor Int
0 Int
0 ST s (MVector s Pixel8)
-> (MVector s Pixel8 -> ST s (Vector Pixel8))
-> ST s (Vector Pixel8)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector s Pixel8 -> ST s (Vector Pixel8)
MVector (PrimState (ST s)) Pixel8 -> ST s (Vector Pixel8)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.freeze

instance ColorPlane PixelYCbCr8 PlaneLuma where
    toComponentIndex :: PixelYCbCr8 -> PlaneLuma -> Int
toComponentIndex PixelYCbCr8
_ PlaneLuma
_ = Int
0

instance ColorPlane PixelYCbCr8 PlaneCb where
    toComponentIndex :: PixelYCbCr8 -> PlaneCb -> Int
toComponentIndex PixelYCbCr8
_ PlaneCb
_ = Int
1

instance ColorPlane PixelYCbCr8 PlaneCr where
    toComponentIndex :: PixelYCbCr8 -> PlaneCr -> Int
toComponentIndex PixelYCbCr8
_ PlaneCr
_ = Int
2

--------------------------------------------------

----            PixelCMYK8 instances

--------------------------------------------------

instance Pixel PixelCMYK8 where
    type PixelBaseComponent PixelCMYK8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelCMYK8 -> PixelBaseComponent PixelCMYK8
pixelOpacity = Pixel8 -> PixelCMYK8 -> Pixel8
forall a b. a -> b -> a
const Pixel8
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelCMYK8
 -> PixelBaseComponent PixelCMYK8
 -> PixelBaseComponent PixelCMYK8)
-> PixelCMYK8 -> PixelCMYK8 -> PixelCMYK8
mixWith Int
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
f (PixelCMYK8 Pixel8
ca Pixel8
ma Pixel8
ya Pixel8
ka) (PixelCMYK8 Pixel8
cb Pixel8
mb Pixel8
yb Pixel8
kb) =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Int
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
f Int
0 Pixel8
PixelBaseComponent PixelCMYK8
ca Pixel8
PixelBaseComponent PixelCMYK8
cb) (Int
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
f Int
1 Pixel8
PixelBaseComponent PixelCMYK8
ma Pixel8
PixelBaseComponent PixelCMYK8
mb) (Int
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
f Int
2 Pixel8
PixelBaseComponent PixelCMYK8
ya Pixel8
PixelBaseComponent PixelCMYK8
yb) (Int
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
-> PixelBaseComponent PixelCMYK8
f Int
3 Pixel8
PixelBaseComponent PixelCMYK8
ka Pixel8
PixelBaseComponent PixelCMYK8
kb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelCMYK8 -> PixelBaseComponent PixelCMYK8)
-> PixelCMYK8 -> PixelCMYK8
colorMap PixelBaseComponent PixelCMYK8 -> PixelBaseComponent PixelCMYK8
f (PixelCMYK8 Pixel8
c Pixel8
m Pixel8
y Pixel8
k) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (PixelBaseComponent PixelCMYK8 -> PixelBaseComponent PixelCMYK8
f Pixel8
PixelBaseComponent PixelCMYK8
c) (PixelBaseComponent PixelCMYK8 -> PixelBaseComponent PixelCMYK8
f Pixel8
PixelBaseComponent PixelCMYK8
m) (PixelBaseComponent PixelCMYK8 -> PixelBaseComponent PixelCMYK8
f Pixel8
PixelBaseComponent PixelCMYK8
y) (PixelBaseComponent PixelCMYK8 -> PixelBaseComponent PixelCMYK8
f Pixel8
PixelBaseComponent PixelCMYK8
k)

    {-# INLINE componentCount #-}
    componentCount :: PixelCMYK8 -> Int
componentCount PixelCMYK8
_ = Int
4

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelCMYK8 -> Int -> Int -> PixelCMYK8
pixelAt image :: Image PixelCMYK8
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelCMYK8)
arr }) Int
x Int
y = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                               (Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                               (Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
                                                               (Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
        where baseIdx :: Int
baseIdx = Image PixelCMYK8 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelCMYK8
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelCMYK8 -> Int -> Int -> m PixelCMYK8
readPixel image :: MutableImage (PrimState m) PixelCMYK8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr }) Int
x Int
y = do
        Pixel8
rv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel8
gv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel8
bv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        Pixel8
av <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        PixelCMYK8 -> m PixelCMYK8
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelCMYK8 -> m PixelCMYK8) -> PixelCMYK8 -> m PixelCMYK8
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 Pixel8
rv Pixel8
gv Pixel8
bv Pixel8
av
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelCMYK8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelCMYK8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelCMYK8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelCMYK8
-> Int -> Int -> PixelCMYK8 -> m ()
writePixel image :: MutableImage (PrimState m) PixelCMYK8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr }) Int
x Int
y (PixelCMYK8 Pixel8
rv Pixel8
gv Pixel8
bv Pixel8
av) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelCMYK8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelCMYK8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelCMYK8
image Int
x Int
y
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel8
rv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel8
gv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel8
bv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Pixel8
av

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelCMYK8) -> Int -> PixelCMYK8
unsafePixelAt Vector (PixelBaseComponent PixelCMYK8)
v Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
v Int
idx)
                   (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelCMYK8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
-> Int -> m PixelCMYK8
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
vec Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
vec Int
idx
                   m (Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> PixelCMYK8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   m (Pixel8 -> Pixel8 -> PixelCMYK8)
-> m Pixel8 -> m (Pixel8 -> PixelCMYK8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   m (Pixel8 -> PixelCMYK8) -> m Pixel8 -> m PixelCMYK8
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
-> Int -> PixelCMYK8 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
v Int
idx (PixelCMYK8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a) =
        MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
v Int
idx Pixel8
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel8
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel8
b
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelCMYK8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Pixel8
a

instance ColorSpaceConvertible PixelCMYK8 PixelRGB8 where
  convertPixel :: PixelCMYK8 -> PixelRGB8
convertPixel (PixelCMYK8 Pixel8
c Pixel8
m Pixel8
y Pixel8
k) =
      Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Int -> Pixel8
clampWord8 Int
r) (Int -> Pixel8
clampWord8 Int
g) (Int -> Pixel8
clampWord8 Int
b)
    where
      clampWord8 :: Int -> Pixel8
clampWord8 = Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pixel8) -> (Int -> Int) -> Int -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
255 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
255)
      ik :: Int
      ik :: Int
ik = Int
255 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
k

      r :: Int
r = (Int
255 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
      g :: Int
g = (Int
255 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
      b :: Int
b = (Int
255 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
y) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik

--------------------------------------------------

----            PixelYCbCrK8 instances

--------------------------------------------------

instance Pixel PixelYCbCrK8 where
    type PixelBaseComponent PixelYCbCrK8 = Word8

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelYCbCrK8 -> PixelBaseComponent PixelYCbCrK8
pixelOpacity = Pixel8 -> PixelYCbCrK8 -> Pixel8
forall a b. a -> b -> a
const Pixel8
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelYCbCrK8
 -> PixelBaseComponent PixelYCbCrK8
 -> PixelBaseComponent PixelYCbCrK8)
-> PixelYCbCrK8 -> PixelYCbCrK8 -> PixelYCbCrK8
mixWith Int
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
f (PixelYCbCrK8 Pixel8
ya Pixel8
cba Pixel8
cra Pixel8
ka) (PixelYCbCrK8 Pixel8
yb Pixel8
cbb Pixel8
crb Pixel8
kb) =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8
PixelYCbCrK8 (Int
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
f Int
0 Pixel8
PixelBaseComponent PixelYCbCrK8
ya Pixel8
PixelBaseComponent PixelYCbCrK8
yb) (Int
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
f Int
1 Pixel8
PixelBaseComponent PixelYCbCrK8
cba Pixel8
PixelBaseComponent PixelYCbCrK8
cbb) (Int
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
f Int
2 Pixel8
PixelBaseComponent PixelYCbCrK8
cra Pixel8
PixelBaseComponent PixelYCbCrK8
crb) (Int
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
-> PixelBaseComponent PixelYCbCrK8
f Int
3 Pixel8
PixelBaseComponent PixelYCbCrK8
ka Pixel8
PixelBaseComponent PixelYCbCrK8
kb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelYCbCrK8
 -> PixelBaseComponent PixelYCbCrK8)
-> PixelYCbCrK8 -> PixelYCbCrK8
colorMap PixelBaseComponent PixelYCbCrK8 -> PixelBaseComponent PixelYCbCrK8
f (PixelYCbCrK8 Pixel8
y Pixel8
cb Pixel8
cr Pixel8
k) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8
PixelYCbCrK8 (PixelBaseComponent PixelYCbCrK8 -> PixelBaseComponent PixelYCbCrK8
f Pixel8
PixelBaseComponent PixelYCbCrK8
y) (PixelBaseComponent PixelYCbCrK8 -> PixelBaseComponent PixelYCbCrK8
f Pixel8
PixelBaseComponent PixelYCbCrK8
cb) (PixelBaseComponent PixelYCbCrK8 -> PixelBaseComponent PixelYCbCrK8
f Pixel8
PixelBaseComponent PixelYCbCrK8
cr) (PixelBaseComponent PixelYCbCrK8 -> PixelBaseComponent PixelYCbCrK8
f Pixel8
PixelBaseComponent PixelYCbCrK8
k)

    {-# INLINE componentCount #-}
    componentCount :: PixelYCbCrK8 -> Int
componentCount PixelYCbCrK8
_ = Int
4

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelYCbCrK8 -> Int -> Int -> PixelYCbCrK8
pixelAt image :: Image PixelYCbCrK8
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelYCbCrK8)
arr }) Int
x Int
y =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8
PixelYCbCrK8 (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                     (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) (Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
arr Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
        where baseIdx :: Int
baseIdx = Image PixelYCbCrK8 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelYCbCrK8
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYCbCrK8
-> Int -> Int -> m PixelYCbCrK8
readPixel image :: MutableImage (PrimState m) PixelYCbCrK8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr }) Int
x Int
y = do
        Pixel8
yv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel8
cbv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel8
crv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        Pixel8
kv <- MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        PixelYCbCrK8 -> m PixelYCbCrK8
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelYCbCrK8 -> m PixelYCbCrK8) -> PixelYCbCrK8 -> m PixelYCbCrK8
forall a b. (a -> b) -> a -> b
$ Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8
PixelYCbCrK8 Pixel8
yv Pixel8
cbv Pixel8
crv Pixel8
kv
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYCbCrK8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYCbCrK8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYCbCrK8
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelYCbCrK8
-> Int -> Int -> PixelYCbCrK8 -> m ()
writePixel image :: MutableImage (PrimState m) PixelYCbCrK8
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr }) Int
x Int
y (PixelYCbCrK8 Pixel8
yv Pixel8
cbv Pixel8
crv Pixel8
kv) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelYCbCrK8 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelYCbCrK8 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelYCbCrK8
image Int
x Int
y
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel8
yv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel8
cbv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel8
crv
        (MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
arr MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Pixel8
kv

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelYCbCrK8) -> Int -> PixelYCbCrK8
unsafePixelAt Vector (PixelBaseComponent PixelYCbCrK8)
v Int
idx =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8
PixelYCbCrK8 (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
v Int
idx)
                     (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                     (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                     (Vector Pixel8 -> Int -> Pixel8
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel8
Vector (PixelBaseComponent PixelYCbCrK8)
v (Int -> Pixel8) -> Int -> Pixel8
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
-> Int -> m PixelYCbCrK8
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
vec Int
idx =
      Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8
PixelYCbCrK8 (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
vec Int
idx
                   m (Pixel8 -> Pixel8 -> Pixel8 -> PixelYCbCrK8)
-> m Pixel8 -> m (Pixel8 -> Pixel8 -> PixelYCbCrK8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   m (Pixel8 -> Pixel8 -> PixelYCbCrK8)
-> m Pixel8 -> m (Pixel8 -> PixelYCbCrK8)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   m (Pixel8 -> PixelYCbCrK8) -> m Pixel8 -> m PixelYCbCrK8
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel8 -> Int -> m Pixel8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
-> Int -> PixelYCbCrK8 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
v Int
idx (PixelYCbCrK8 Pixel8
y Pixel8
cb Pixel8
cr Pixel8
k) =
        MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
v Int
idx Pixel8
y m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel8
cb
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel8
cr
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel8 -> Int -> Pixel8 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel8
STVector (PrimState m) (PixelBaseComponent PixelYCbCrK8)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Pixel8
k

instance ColorSpaceConvertible PixelYCbCrK8 PixelRGB8 where
  convertPixel :: PixelYCbCrK8 -> PixelRGB8
convertPixel (PixelYCbCrK8 Pixel8
y Pixel8
cb Pixel8
cr Pixel8
_k) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (PixelF -> Pixel8
clamp PixelF
r) (PixelF -> Pixel8
clamp PixelF
g) (PixelF -> Pixel8
clamp PixelF
b)
    where
      tof :: Word8 -> Float
      tof :: Pixel8 -> PixelF
tof = Pixel8 -> PixelF
forall a b. (Integral a, Num b) => a -> b
fromIntegral

      clamp :: Float -> Word8
      clamp :: PixelF -> Pixel8
clamp = PixelF -> Pixel8
forall b. Integral b => PixelF -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Pixel8) -> (PixelF -> PixelF) -> PixelF -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
0 (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
min PixelF
255

      yf :: PixelF
yf = Pixel8 -> PixelF
tof Pixel8
y

      r :: PixelF
r = PixelF
yf PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
1.402 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cr PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
179.456
      g :: PixelF
g = PixelF
yf PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
0.3441363 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cb PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
0.71413636 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cr PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
135.4589
      b :: PixelF
b = PixelF
yf PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
1.772 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cb PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
226.816

instance ColorSpaceConvertible PixelYCbCrK8 PixelCMYK8 where
  convertPixel :: PixelYCbCrK8 -> PixelCMYK8
convertPixel (PixelYCbCrK8 Pixel8
y Pixel8
cb Pixel8
cr Pixel8
k) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 Pixel8
c Pixel8
m Pixel8
ye Pixel8
k
    where
      tof :: Word8 -> Float
      tof :: Pixel8 -> PixelF
tof = Pixel8 -> PixelF
forall a b. (Integral a, Num b) => a -> b
fromIntegral

      clamp :: Float -> Word8
      clamp :: PixelF -> Pixel8
clamp = PixelF -> Pixel8
forall b. Integral b => PixelF -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Pixel8) -> (PixelF -> PixelF) -> PixelF -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
0 (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
min PixelF
255

      yf :: PixelF
yf = Pixel8 -> PixelF
tof Pixel8
y

      r :: PixelF
r = PixelF
yf PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
1.402 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cr PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
179.456
      g :: PixelF
g = PixelF
yf PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
0.3441363 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cb PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
0.71413636 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cr PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
135.4589
      b :: PixelF
b = PixelF
yf PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
1.772 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* Pixel8 -> PixelF
tof Pixel8
cb PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
226.816

      c :: Pixel8
c = PixelF -> Pixel8
clamp (PixelF -> Pixel8) -> PixelF -> Pixel8
forall a b. (a -> b) -> a -> b
$ PixelF
255 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
r
      m :: Pixel8
m = PixelF -> Pixel8
clamp (PixelF -> Pixel8) -> PixelF -> Pixel8
forall a b. (a -> b) -> a -> b
$ PixelF
255 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
g
      ye :: Pixel8
ye = PixelF -> Pixel8
clamp (PixelF -> Pixel8) -> PixelF -> Pixel8
forall a b. (a -> b) -> a -> b
$ PixelF
255 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
- PixelF
b

{-# SPECIALIZE integralRGBToCMYK :: (Word8 -> Word8 -> Word8 -> Word8 -> b)
                                 -> (Word8, Word8, Word8) -> b #-}
{-# SPECIALIZE integralRGBToCMYK :: (Word16 -> Word16 -> Word16 -> Word16 -> b)
                                 -> (Word16, Word16, Word16) -> b #-}
-- | Convert RGB8 or RGB16 to CMYK8 and CMYK16 respectfully.

--

-- /Note/ - 32bit precision is not supported. Make sure to adjust implementation if ever

-- used with Word32.

integralRGBToCMYK :: (Bounded a, Integral a)
                  => (a -> a -> a -> a -> b)    -- ^ Pixel building function

                  -> (a, a, a)                  -- ^ RGB sample

                  -> b                          -- ^ Resulting sample

integralRGBToCMYK :: forall a b.
(Bounded a, Integral a) =>
(a -> a -> a -> a -> b) -> (a, a, a) -> b
integralRGBToCMYK a -> a -> a -> a -> b
build (a
r, a
g, a
b)
  | a
kMax a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> a -> a -> a -> b
build a
0 a
0 a
0 a
maxVal -- prevent division by zero

  | Bool
otherwise = a -> a -> a -> a -> b
build (Pixel32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel32
c) (Pixel32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel32
m) (Pixel32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel32
y) a
k
    where maxVal :: a
maxVal = a
forall a. Bounded a => a
maxBound
          max32 :: Pixel32
max32 = a -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
maxVal :: Word32
          kMax32 :: Pixel32
kMax32 = a -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
kMax :: Word32
          kMax :: a
kMax = a -> a -> a
forall a. Ord a => a -> a -> a
max a
r (a -> a -> a
forall a. Ord a => a -> a -> a
max a
g a
b)
          k :: a
k = a
maxVal a -> a -> a
forall a. Num a => a -> a -> a
- a
kMax
          c :: Pixel32
c = Pixel32
max32 Pixel32 -> Pixel32 -> Pixel32
forall a. Num a => a -> a -> a
* (Pixel32
kMax32 Pixel32 -> Pixel32 -> Pixel32
forall a. Num a => a -> a -> a
- a -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r) Pixel32 -> Pixel32 -> Pixel32
forall a. Integral a => a -> a -> a
`div` Pixel32
kMax32
          m :: Pixel32
m = Pixel32
max32 Pixel32 -> Pixel32 -> Pixel32
forall a. Num a => a -> a -> a
* (Pixel32
kMax32 Pixel32 -> Pixel32 -> Pixel32
forall a. Num a => a -> a -> a
- a -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
g) Pixel32 -> Pixel32 -> Pixel32
forall a. Integral a => a -> a -> a
`div` Pixel32
kMax32
          y :: Pixel32
y = Pixel32
max32 Pixel32 -> Pixel32 -> Pixel32
forall a. Num a => a -> a -> a
* (Pixel32
kMax32 Pixel32 -> Pixel32 -> Pixel32
forall a. Num a => a -> a -> a
- a -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b) Pixel32 -> Pixel32 -> Pixel32
forall a. Integral a => a -> a -> a
`div` Pixel32
kMax32

instance ColorSpaceConvertible PixelRGB8 PixelCMYK8 where
  convertPixel :: PixelRGB8 -> PixelCMYK8
convertPixel (PixelRGB8 Pixel8
r Pixel8
g Pixel8
b) = (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8)
-> (Pixel8, Pixel8, Pixel8) -> PixelCMYK8
forall a b.
(Bounded a, Integral a) =>
(a -> a -> a -> a -> b) -> (a, a, a) -> b
integralRGBToCMYK Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Pixel8
r, Pixel8
g, Pixel8
b)

instance ColorPlane PixelCMYK8 PlaneCyan where
    toComponentIndex :: PixelCMYK8 -> PlaneCyan -> Int
toComponentIndex PixelCMYK8
_ PlaneCyan
_ = Int
0

instance ColorPlane PixelCMYK8 PlaneMagenta where
    toComponentIndex :: PixelCMYK8 -> PlaneMagenta -> Int
toComponentIndex PixelCMYK8
_ PlaneMagenta
_ = Int
1

instance ColorPlane PixelCMYK8 PlaneYellow where
    toComponentIndex :: PixelCMYK8 -> PlaneYellow -> Int
toComponentIndex PixelCMYK8
_ PlaneYellow
_ = Int
2

instance ColorPlane PixelCMYK8 PlaneBlack where
    toComponentIndex :: PixelCMYK8 -> PlaneBlack -> Int
toComponentIndex PixelCMYK8
_ PlaneBlack
_ = Int
3

--------------------------------------------------

----            PixelCMYK16 instances

--------------------------------------------------

instance Pixel PixelCMYK16 where
    type PixelBaseComponent PixelCMYK16 = Word16

    {-# INLINE pixelOpacity #-}
    pixelOpacity :: PixelCMYK16 -> PixelBaseComponent PixelCMYK16
pixelOpacity = Pixel16 -> PixelCMYK16 -> Pixel16
forall a b. a -> b -> a
const Pixel16
forall a. Bounded a => a
maxBound

    {-# INLINE mixWith #-}
    mixWith :: (Int
 -> PixelBaseComponent PixelCMYK16
 -> PixelBaseComponent PixelCMYK16
 -> PixelBaseComponent PixelCMYK16)
-> PixelCMYK16 -> PixelCMYK16 -> PixelCMYK16
mixWith Int
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
f (PixelCMYK16 Pixel16
ca Pixel16
ma Pixel16
ya Pixel16
ka) (PixelCMYK16 Pixel16
cb Pixel16
mb Pixel16
yb Pixel16
kb) =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (Int
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
f Int
0 Pixel16
PixelBaseComponent PixelCMYK16
ca Pixel16
PixelBaseComponent PixelCMYK16
cb) (Int
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
f Int
1 Pixel16
PixelBaseComponent PixelCMYK16
ma Pixel16
PixelBaseComponent PixelCMYK16
mb) (Int
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
f Int
2 Pixel16
PixelBaseComponent PixelCMYK16
ya Pixel16
PixelBaseComponent PixelCMYK16
yb) (Int
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
-> PixelBaseComponent PixelCMYK16
f Int
3 Pixel16
PixelBaseComponent PixelCMYK16
ka Pixel16
PixelBaseComponent PixelCMYK16
kb)

    {-# INLINE colorMap #-}
    colorMap :: (PixelBaseComponent PixelCMYK16 -> PixelBaseComponent PixelCMYK16)
-> PixelCMYK16 -> PixelCMYK16
colorMap PixelBaseComponent PixelCMYK16 -> PixelBaseComponent PixelCMYK16
f (PixelCMYK16 Pixel16
c Pixel16
m Pixel16
y Pixel16
k) = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (PixelBaseComponent PixelCMYK16 -> PixelBaseComponent PixelCMYK16
f Pixel16
PixelBaseComponent PixelCMYK16
c) (PixelBaseComponent PixelCMYK16 -> PixelBaseComponent PixelCMYK16
f Pixel16
PixelBaseComponent PixelCMYK16
m) (PixelBaseComponent PixelCMYK16 -> PixelBaseComponent PixelCMYK16
f Pixel16
PixelBaseComponent PixelCMYK16
y) (PixelBaseComponent PixelCMYK16 -> PixelBaseComponent PixelCMYK16
f Pixel16
PixelBaseComponent PixelCMYK16
k)

    {-# INLINE componentCount #-}
    componentCount :: PixelCMYK16 -> Int
componentCount PixelCMYK16
_ = Int
4

    {-# INLINE pixelAt #-}
    pixelAt :: Image PixelCMYK16 -> Int -> Int -> PixelCMYK16
pixelAt image :: Image PixelCMYK16
image@(Image { imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelCMYK16)
arr }) Int
x Int
y = Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
                                                               (Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                                               (Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
                                                               (Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
arr Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
! (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
        where baseIdx :: Int
baseIdx = Image PixelCMYK16 -> Int -> Int -> Int
forall a. Pixel a => Image a -> Int -> Int -> Int
pixelBaseIndex Image PixelCMYK16
image Int
x Int
y

    {-# INLINE readPixel #-}
    readPixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelCMYK16
-> Int -> Int -> m PixelCMYK16
readPixel image :: MutableImage (PrimState m) PixelCMYK16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr }) Int
x Int
y = do
        Pixel16
rv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
baseIdx
        Pixel16
gv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Pixel16
bv <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        Pixel16
av <- MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        PixelCMYK16 -> m PixelCMYK16
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PixelCMYK16 -> m PixelCMYK16) -> PixelCMYK16 -> m PixelCMYK16
forall a b. (a -> b) -> a -> b
$ Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 Pixel16
rv Pixel16
gv Pixel16
bv Pixel16
av
        where baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelCMYK16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelCMYK16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelCMYK16
image Int
x Int
y

    {-# INLINE writePixel #-}
    writePixel :: forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelCMYK16
-> Int -> Int -> PixelCMYK16 -> m ()
writePixel image :: MutableImage (PrimState m) PixelCMYK16
image@(MutableImage { mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr }) Int
x Int
y (PixelCMYK16 Pixel16
rv Pixel16
gv Pixel16
bv Pixel16
av) = do
        let baseIdx :: Int
baseIdx = MutableImage (PrimState m) PixelCMYK16 -> Int -> Int -> Int
forall a s. Pixel a => MutableImage s a -> Int -> Int -> Int
forall s. MutableImage s PixelCMYK16 -> Int -> Int -> Int
mutablePixelBaseIndex MutableImage (PrimState m) PixelCMYK16
image Int
x Int
y
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)) Pixel16
rv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Pixel16
gv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) Pixel16
bv
        (MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
arr MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) Pixel16
av

    {-# INLINE unsafePixelAt #-}
    unsafePixelAt :: Vector (PixelBaseComponent PixelCMYK16) -> Int -> PixelCMYK16
unsafePixelAt Vector (PixelBaseComponent PixelCMYK16)
v Int
idx =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
v Int
idx)
                   (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   (Vector Pixel16 -> Int -> Pixel16
forall a. Storable a => Vector a -> Int -> a
V.unsafeIndex Vector Pixel16
Vector (PixelBaseComponent PixelCMYK16)
v (Int -> Pixel16) -> Int -> Pixel16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

    {-# INLINE unsafeReadPixel #-}
    unsafeReadPixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
-> Int -> m PixelCMYK16
unsafeReadPixel STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
vec Int
idx =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16)
-> m Pixel16 -> m (Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
vec Int
idx
                   m (Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16)
-> m Pixel16 -> m (Pixel16 -> Pixel16 -> PixelCMYK16)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   m (Pixel16 -> Pixel16 -> PixelCMYK16)
-> m Pixel16 -> m (Pixel16 -> PixelCMYK16)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   m (Pixel16 -> PixelCMYK16) -> m Pixel16 -> m PixelCMYK16
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector (PrimState m) Pixel16 -> Int -> m Pixel16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
vec (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
    {-# INLINE unsafeWritePixel #-}
    unsafeWritePixel :: forall (m :: * -> *).
PrimMonad m =>
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
-> Int -> PixelCMYK16 -> m ()
unsafeWritePixel STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
v Int
idx (PixelCMYK16 Pixel16
r Pixel16
g Pixel16
b Pixel16
a) =
        MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
v Int
idx Pixel16
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Pixel16
g
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Pixel16
b
                              m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) Pixel16 -> Int -> Pixel16 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) Pixel16
STVector (PrimState m) (PixelBaseComponent PixelCMYK16)
v (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Pixel16
a

instance ColorSpaceConvertible PixelCMYK16 PixelRGB16 where
  convertPixel :: PixelCMYK16 -> PixelRGB16
convertPixel (PixelCMYK16 Pixel16
c Pixel16
m Pixel16
y Pixel16
k) =
      Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16 (Int -> Pixel16
clampWord16 Int
r) (Int -> Pixel16
clampWord16 Int
g) (Int -> Pixel16
clampWord16 Int
b)
    where
          clampWord16 :: Int -> Pixel16
clampWord16 = Int -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pixel16) -> (Int -> Int) -> Int -> Pixel16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16)
          ik :: Int
          ik :: Int
ik = Int
65535 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
k

          r :: Int
r = (Int
65535 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
          g :: Int
g = (Int
65535 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
          b :: Int
b = (Int
65535 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
y) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik

instance ColorPlane PixelCMYK16 PlaneCyan where
    toComponentIndex :: PixelCMYK16 -> PlaneCyan -> Int
toComponentIndex PixelCMYK16
_ PlaneCyan
_ = Int
0

instance ColorPlane PixelCMYK16 PlaneMagenta where
    toComponentIndex :: PixelCMYK16 -> PlaneMagenta -> Int
toComponentIndex PixelCMYK16
_ PlaneMagenta
_ = Int
1

instance ColorPlane PixelCMYK16 PlaneYellow where
    toComponentIndex :: PixelCMYK16 -> PlaneYellow -> Int
toComponentIndex PixelCMYK16
_ PlaneYellow
_ = Int
2

instance ColorPlane PixelCMYK16 PlaneBlack where
    toComponentIndex :: PixelCMYK16 -> PlaneBlack -> Int
toComponentIndex PixelCMYK16
_ PlaneBlack
_ = Int
3

-- | Perform a gamma correction for an image with HDR pixels.

gammaCorrection :: PixelF          -- ^ Gamma value, should be between 0.5 and 3.0

                -> Image PixelRGBF -- ^ Image to treat.

                -> Image PixelRGBF
gammaCorrection :: PixelF -> Image PixelRGBF -> Image PixelRGBF
gammaCorrection PixelF
gammaVal = (PixelRGBF -> PixelRGBF) -> Image PixelRGBF -> Image PixelRGBF
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBF -> PixelRGBF
gammaCorrector
  where gammaExponent :: PixelF
gammaExponent = PixelF
1.0 PixelF -> PixelF -> PixelF
forall a. Fractional a => a -> a -> a
/ PixelF
gammaVal
        fixVal :: PixelF -> PixelF
fixVal PixelF
v = PixelF
v PixelF -> PixelF -> PixelF
forall a. Floating a => a -> a -> a
** PixelF
gammaExponent
        gammaCorrector :: PixelRGBF -> PixelRGBF
gammaCorrector (PixelRGBF PixelF
r PixelF
g PixelF
b) =
            PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF (PixelF -> PixelF
fixVal PixelF
r) (PixelF -> PixelF
fixVal PixelF
g) (PixelF -> PixelF
fixVal PixelF
b)

-- | Perform a tone mapping operation on an High dynamic range image.

toneMapping :: PixelF          -- ^ Exposure parameter

            -> Image PixelRGBF -- ^ Image to treat.

            -> Image PixelRGBF
toneMapping :: PixelF -> Image PixelRGBF -> Image PixelRGBF
toneMapping PixelF
exposure Image PixelRGBF
img = Int
-> Int -> Vector (PixelBaseComponent PixelRGBF) -> Image PixelRGBF
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image (Image PixelRGBF -> Int
forall a. Image a -> Int
imageWidth Image PixelRGBF
img) (Image PixelRGBF -> Int
forall a. Image a -> Int
imageHeight Image PixelRGBF
img) Vector PixelF
Vector (PixelBaseComponent PixelRGBF)
scaledData
 where coeff :: PixelF
coeff = PixelF
exposure PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* (PixelF
exposure PixelF -> PixelF -> PixelF
forall a. Fractional a => a -> a -> a
/ PixelF
maxBrightness PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
1.0) PixelF -> PixelF -> PixelF
forall a. Fractional a => a -> a -> a
/ (PixelF
exposure PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
+ PixelF
1.0);
       maxBrightness :: PixelF
maxBrightness = (PixelF -> Int -> Int -> PixelRGBF -> PixelF)
-> PixelF -> Image PixelRGBF -> PixelF
forall acc pixel.
Pixel pixel =>
(acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> acc
pixelFold (\PixelF
luma Int
_ Int
_ PixelRGBF
px -> PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
luma (PixelF -> PixelF) -> PixelF -> PixelF
forall a b. (a -> b) -> a -> b
$ PixelRGBF -> PixelBaseComponent PixelRGBF
forall a. LumaPlaneExtractable a => a -> PixelBaseComponent a
computeLuma PixelRGBF
px) PixelF
0 Image PixelRGBF
img
       scaledData :: Vector PixelF
scaledData = (PixelF -> PixelF) -> Vector PixelF -> Vector PixelF
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map (PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
coeff) (Vector PixelF -> Vector PixelF) -> Vector PixelF -> Vector PixelF
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Vector (PixelBaseComponent PixelRGBF)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image PixelRGBF
img

--------------------------------------------------

----            Packable pixel

--------------------------------------------------


-- | This typeclass exist for performance reason, it allow

-- to pack a pixel value to a simpler "primitive" data

-- type to allow faster writing to moemory.

class PackeablePixel a where
    -- | Primitive type asociated to the current pixel

    -- It's Word32 for PixelRGBA8 for instance

    type PackedRepresentation a

    -- | The packing function, allowing to transform

    -- to a primitive.

    packPixel :: a -> PackedRepresentation a

    -- | Inverse transformation, to speed up

    -- reading

    unpackPixel :: PackedRepresentation a -> a

instance PackeablePixel Pixel8 where
    type PackedRepresentation Pixel8 = Pixel8
    packPixel :: Pixel8 -> PackedRepresentation Pixel8
packPixel = Pixel8 -> Pixel8
Pixel8 -> PackedRepresentation Pixel8
forall a. a -> a
id
    {-# INLINE packPixel #-}
    unpackPixel :: PackedRepresentation Pixel8 -> Pixel8
unpackPixel = Pixel8 -> Pixel8
PackedRepresentation Pixel8 -> Pixel8
forall a. a -> a
id
    {-# INLINE unpackPixel #-}

instance PackeablePixel Pixel16 where
    type PackedRepresentation Pixel16 = Pixel16
    packPixel :: Pixel16 -> PackedRepresentation Pixel16
packPixel = Pixel16 -> Pixel16
Pixel16 -> PackedRepresentation Pixel16
forall a. a -> a
id
    {-# INLINE packPixel #-}
    unpackPixel :: PackedRepresentation Pixel16 -> Pixel16
unpackPixel = Pixel16 -> Pixel16
PackedRepresentation Pixel16 -> Pixel16
forall a. a -> a
id
    {-# INLINE unpackPixel #-}

instance PackeablePixel Pixel32 where
    type PackedRepresentation Pixel32 = Pixel32
    packPixel :: Pixel32 -> PackedRepresentation Pixel32
packPixel = Pixel32 -> Pixel32
Pixel32 -> PackedRepresentation Pixel32
forall a. a -> a
id
    {-# INLINE packPixel #-}
    unpackPixel :: PackedRepresentation Pixel32 -> Pixel32
unpackPixel = Pixel32 -> Pixel32
PackedRepresentation Pixel32 -> Pixel32
forall a. a -> a
id
    {-# INLINE unpackPixel #-}

instance PackeablePixel PixelF where
    type PackedRepresentation PixelF = PixelF
    packPixel :: PixelF -> PackedRepresentation PixelF
packPixel = PixelF -> PixelF
PixelF -> PackedRepresentation PixelF
forall a. a -> a
id
    {-# INLINE packPixel #-}
    unpackPixel :: PackedRepresentation PixelF -> PixelF
unpackPixel = PixelF -> PixelF
PackedRepresentation PixelF -> PixelF
forall a. a -> a
id
    {-# INLINE unpackPixel #-}


instance PackeablePixel PixelRGBA8 where
    type PackedRepresentation PixelRGBA8 = Word32
    {-# INLINE packPixel #-}
    packPixel :: PixelRGBA8 -> PackedRepresentation PixelRGBA8
packPixel (PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a) =
        (Pixel8 -> Pixel32
fi Pixel8
r Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel32
fi Pixel8
g Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel32
fi Pixel8
b Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel32
fi Pixel8
a Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where fi :: Pixel8 -> Pixel32
fi = Pixel8 -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            bitCount :: Int
bitCount = Int
8

    {-# INLINE unpackPixel #-}
    unpackPixel :: PackedRepresentation PixelRGBA8 -> PixelRGBA8
unpackPixel PackedRepresentation PixelRGBA8
w =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low Pixel32
PackedRepresentation PixelRGBA8
w)
                   (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelRGBA8
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitCount)
                   (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelRGBA8
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
                   (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelRGBA8
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where
        low :: a -> b
low a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFF)
        bitCount :: Int
bitCount = Int
8

instance PackeablePixel PixelRGBA16 where
    type PackedRepresentation PixelRGBA16 = Word64
    {-# INLINE packPixel #-}
    packPixel :: PixelRGBA16 -> PackedRepresentation PixelRGBA16
packPixel (PixelRGBA16 Pixel16
r Pixel16
g Pixel16
b Pixel16
a) =
        (Pixel16 -> Word64
fi Pixel16
r Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Word64
fi Pixel16
g Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Word64
fi Pixel16
b Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Word64
fi Pixel16
a Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where fi :: Pixel16 -> Word64
fi = Pixel16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            bitCount :: Int
bitCount = Int
16

    {-# INLINE unpackPixel #-}
    unpackPixel :: PackedRepresentation PixelRGBA16 -> PixelRGBA16
unpackPixel PackedRepresentation PixelRGBA16
w =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low Word64
PackedRepresentation PixelRGBA16
w)
                    (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Word64 -> Pixel16) -> Word64 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Word64
PackedRepresentation PixelRGBA16
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitCount)
                    (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Word64 -> Pixel16) -> Word64 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Word64
PackedRepresentation PixelRGBA16
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
                    (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Word64 -> Pixel16) -> Word64 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Word64
PackedRepresentation PixelRGBA16
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where
        low :: a -> b
low a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF)
        bitCount :: Int
bitCount = Int
16

instance PackeablePixel PixelCMYK8 where
    type PackedRepresentation PixelCMYK8 = Word32
    {-# INLINE packPixel #-}
    packPixel :: PixelCMYK8 -> PackedRepresentation PixelCMYK8
packPixel (PixelCMYK8 Pixel8
c Pixel8
m Pixel8
y Pixel8
k) =
        (Pixel8 -> Pixel32
fi Pixel8
c Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel32
fi Pixel8
m Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel32
fi Pixel8
y Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel32
fi Pixel8
k Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where fi :: Pixel8 -> Pixel32
fi = Pixel8 -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            bitCount :: Int
bitCount = Int
8

    {-# INLINE unpackPixel #-}
    unpackPixel :: PackedRepresentation PixelCMYK8 -> PixelCMYK8
unpackPixel PackedRepresentation PixelCMYK8
w =
        Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low Pixel32
PackedRepresentation PixelCMYK8
w)
                   (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelCMYK8
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitCount)
                   (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelCMYK8
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
                   (Pixel32 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelCMYK8
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where
        low :: a -> b
low a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFF)
        bitCount :: Int
bitCount = Int
8

instance PackeablePixel PixelCMYK16 where
    type PackedRepresentation PixelCMYK16 = Word64
    {-# INLINE packPixel #-}
    packPixel :: PixelCMYK16 -> PackedRepresentation PixelCMYK16
packPixel (PixelCMYK16 Pixel16
c Pixel16
m Pixel16
y Pixel16
k) =
        (Pixel16 -> Word64
fi Pixel16
c Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Word64
fi Pixel16
m Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Word64
fi Pixel16
y Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Word64
fi Pixel16
k Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where fi :: Pixel16 -> Word64
fi = Pixel16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            bitCount :: Int
bitCount = Int
16

    {-# INLINE unpackPixel #-}
    unpackPixel :: PackedRepresentation PixelCMYK16 -> PixelCMYK16
unpackPixel PackedRepresentation PixelCMYK16
w =
        Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelCMYK16
PixelCMYK16 (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low Word64
PackedRepresentation PixelCMYK16
w)
                    (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Word64 -> Pixel16) -> Word64 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Word64
PackedRepresentation PixelCMYK16
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitCount)
                    (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Word64 -> Pixel16) -> Word64 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Word64
PackedRepresentation PixelCMYK16
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
                    (Word64 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Word64 -> Pixel16) -> Word64 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Word64
PackedRepresentation PixelCMYK16
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where
        low :: a -> b
low a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF)
        bitCount :: Int
bitCount = Int
16

instance PackeablePixel PixelYA16 where
    type PackedRepresentation PixelYA16 = Word32
    {-# INLINE packPixel #-}
    packPixel :: PixelYA16 -> PackedRepresentation PixelYA16
packPixel (PixelYA16 Pixel16
y Pixel16
a) =
        (Pixel16 -> Pixel32
fi Pixel16
y Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel32 -> Pixel32 -> Pixel32
forall a. Bits a => a -> a -> a
.|.
        (Pixel16 -> Pixel32
fi Pixel16
a Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where fi :: Pixel16 -> Pixel32
fi = Pixel16 -> Pixel32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            bitCount :: Int
bitCount = Int
16

    {-# INLINE unpackPixel #-}
    unpackPixel :: PackedRepresentation PixelYA16 -> PixelYA16
unpackPixel PackedRepresentation PixelYA16
w = Pixel16 -> Pixel16 -> PixelYA16
PixelYA16 (Pixel32 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low Pixel32
PackedRepresentation PixelYA16
w) (Pixel32 -> Pixel16
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel32 -> Pixel16) -> Pixel32 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Pixel32
PackedRepresentation PixelYA16
w Pixel32 -> Int -> Pixel32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitCount)
      where
        low :: a -> b
low a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF)
        bitCount :: Int
bitCount = Int
16

instance PackeablePixel PixelYA8 where
    type PackedRepresentation PixelYA8 = Word16
    {-# INLINE packPixel #-}
    packPixel :: PixelYA8 -> PackedRepresentation PixelYA8
packPixel (PixelYA8 Pixel8
y Pixel8
a) =
        (Pixel8 -> Pixel16
fi Pixel8
y Pixel16 -> Int -> Pixel16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount)) Pixel16 -> Pixel16 -> Pixel16
forall a. Bits a => a -> a -> a
.|.
        (Pixel8 -> Pixel16
fi Pixel8
a Pixel16 -> Int -> Pixel16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitCount))
      where fi :: Pixel8 -> Pixel16
fi = Pixel8 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            bitCount :: Int
bitCount = Int
8

    {-# INLINE unpackPixel #-}
    unpackPixel :: PackedRepresentation PixelYA8 -> PixelYA8
unpackPixel PackedRepresentation PixelYA8
w = Pixel8 -> Pixel8 -> PixelYA8
PixelYA8 (Pixel16 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low Pixel16
PackedRepresentation PixelYA8
w) (Pixel16 -> Pixel8
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
low (Pixel16 -> Pixel8) -> Pixel16 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel16
PackedRepresentation PixelYA8
w Pixel16 -> Int -> Pixel16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
bitCount)
      where
        low :: a -> b
low a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFF)
        bitCount :: Int
bitCount = Int
8

-- | This function will fill an image with a simple packeable

-- pixel. It will be faster than any unsafeWritePixel.

fillImageWith :: ( Pixel px, PackeablePixel px
                 , PrimMonad m
                 , M.Storable (PackedRepresentation px))
              => MutableImage (PrimState m) px -> px -> m ()
fillImageWith :: forall px (m :: * -> *).
(Pixel px, PackeablePixel px, PrimMonad m,
 Storable (PackedRepresentation px)) =>
MutableImage (PrimState m) px -> px -> m ()
fillImageWith MutableImage (PrimState m) px
img px
px = MVector (PrimState m) (PackedRepresentation px)
-> PackedRepresentation px -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> a -> m ()
M.set MVector (PrimState m) (PackedRepresentation px)
converted (PackedRepresentation px -> m ())
-> PackedRepresentation px -> m ()
forall a b. (a -> b) -> a -> b
$ px -> PackedRepresentation px
forall a. PackeablePixel a => a -> PackedRepresentation a
packPixel px
px
  where
    (ForeignPtr (PixelBaseComponent px)
ptr, Int
s, Int
s2) = MVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall s a. MVector s a -> (ForeignPtr a, Int, Int)
M.unsafeToForeignPtr (MVector (PrimState m) (PixelBaseComponent px)
 -> (ForeignPtr (PixelBaseComponent px), Int, Int))
-> MVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall a b. (a -> b) -> a -> b
$ MutableImage (PrimState m) px
-> MVector (PrimState m) (PixelBaseComponent px)
forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData MutableImage (PrimState m) px
img
    !packedPtr :: ForeignPtr (PackedRepresentation px)
packedPtr = ForeignPtr (PixelBaseComponent px)
-> ForeignPtr (PackedRepresentation px)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (PixelBaseComponent px)
ptr
    !converted :: MVector (PrimState m) (PackedRepresentation px)
converted =
        ForeignPtr (PackedRepresentation px)
-> Int -> Int -> MVector (PrimState m) (PackedRepresentation px)
forall a s. Storable a => ForeignPtr a -> Int -> Int -> MVector s a
M.unsafeFromForeignPtr ForeignPtr (PackedRepresentation px)
packedPtr Int
s (Int
s2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` px -> Int
forall a. Pixel a => a -> Int
componentCount px
px)

-- | Fill a packeable pixel between two bounds.

unsafeWritePixelBetweenAt
    :: ( PrimMonad m
       , Pixel px, PackeablePixel px
       , M.Storable (PackedRepresentation px))
    => MutableImage (PrimState m) px -- ^ Image to write into

    -> px                -- ^ Pixel to write

    -> Int               -- ^ Start index in pixel base component

    -> Int               -- ^ pixel count of pixel to write

    -> m ()
unsafeWritePixelBetweenAt :: forall (m :: * -> *) px.
(PrimMonad m, Pixel px, PackeablePixel px,
 Storable (PackedRepresentation px)) =>
MutableImage (PrimState m) px -> px -> Int -> Int -> m ()
unsafeWritePixelBetweenAt MutableImage (PrimState m) px
img px
px Int
start Int
count = MVector (PrimState m) (PackedRepresentation px)
-> PackedRepresentation px -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> a -> m ()
M.set MVector (PrimState m) (PackedRepresentation px)
converted PackedRepresentation px
packed
  where
    !packed :: PackedRepresentation px
packed = px -> PackedRepresentation px
forall a. PackeablePixel a => a -> PackedRepresentation a
packPixel px
px
    !pixelData :: STVector (PrimState m) (PixelBaseComponent px)
pixelData = MutableImage (PrimState m) px
-> STVector (PrimState m) (PixelBaseComponent px)
forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData MutableImage (PrimState m) px
img

    !toSet :: STVector (PrimState m) (PixelBaseComponent px)
toSet = Int
-> Int
-> STVector (PrimState m) (PixelBaseComponent px)
-> STVector (PrimState m) (PixelBaseComponent px)
forall a s. Storable a => Int -> Int -> MVector s a -> MVector s a
M.slice Int
start Int
count STVector (PrimState m) (PixelBaseComponent px)
pixelData
    (ForeignPtr (PixelBaseComponent px)
ptr, Int
s, Int
s2) = STVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall s a. MVector s a -> (ForeignPtr a, Int, Int)
M.unsafeToForeignPtr STVector (PrimState m) (PixelBaseComponent px)
toSet
    !packedPtr :: ForeignPtr (PackedRepresentation px)
packedPtr = ForeignPtr (PixelBaseComponent px)
-> ForeignPtr (PackedRepresentation px)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (PixelBaseComponent px)
ptr
    !converted :: MVector (PrimState m) (PackedRepresentation px)
converted =
        ForeignPtr (PackedRepresentation px)
-> Int -> Int -> MVector (PrimState m) (PackedRepresentation px)
forall a s. Storable a => ForeignPtr a -> Int -> Int -> MVector s a
M.unsafeFromForeignPtr ForeignPtr (PackedRepresentation px)
packedPtr Int
s Int
s2

-- | Read a packeable pixel from an image. Equivalent to

-- unsafeReadPixel

readPackedPixelAt :: forall m px.
                     ( Pixel px, PackeablePixel px
                     , M.Storable (PackedRepresentation px)
                     , PrimMonad m
                     )
                  => MutableImage (PrimState m) px -- ^ Image to read from

                  -> Int  -- ^ Index in (PixelBaseComponent px) count

                  -> m px
{-# INLINE readPackedPixelAt #-}
readPackedPixelAt :: forall (m :: * -> *) px.
(Pixel px, PackeablePixel px, Storable (PackedRepresentation px),
 PrimMonad m) =>
MutableImage (PrimState m) px -> Int -> m px
readPackedPixelAt MutableImage (PrimState m) px
img Int
idx = do
    PackedRepresentation px
unpacked <- MVector (PrimState m) (PackedRepresentation px)
-> Int -> m (PackedRepresentation px)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead MVector (PrimState m) (PackedRepresentation px)
converted (Int
idx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
compCount)
    px -> m px
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (px -> m px) -> px -> m px
forall a b. (a -> b) -> a -> b
$ PackedRepresentation px -> px
forall a. PackeablePixel a => PackedRepresentation a -> a
unpackPixel PackedRepresentation px
unpacked
    where
    !compCount :: Int
compCount = px -> Int
forall a. Pixel a => a -> Int
componentCount (px
forall a. HasCallStack => a
undefined :: px)
    (ForeignPtr (PixelBaseComponent px)
ptr, Int
s, Int
s2) = MVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall s a. MVector s a -> (ForeignPtr a, Int, Int)
M.unsafeToForeignPtr (MVector (PrimState m) (PixelBaseComponent px)
 -> (ForeignPtr (PixelBaseComponent px), Int, Int))
-> MVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall a b. (a -> b) -> a -> b
$ MutableImage (PrimState m) px
-> MVector (PrimState m) (PixelBaseComponent px)
forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData MutableImage (PrimState m) px
img
    !packedPtr :: ForeignPtr (PackedRepresentation px)
packedPtr = ForeignPtr (PixelBaseComponent px)
-> ForeignPtr (PackedRepresentation px)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (PixelBaseComponent px)
ptr
    !converted :: MVector (PrimState m) (PackedRepresentation px)
converted =
        ForeignPtr (PackedRepresentation px)
-> Int -> Int -> MVector (PrimState m) (PackedRepresentation px)
forall a s. Storable a => ForeignPtr a -> Int -> Int -> MVector s a
M.unsafeFromForeignPtr ForeignPtr (PackedRepresentation px)
packedPtr Int
s Int
s2


-- | Write a packeable pixel into an image. equivalent to unsafeWritePixel.

writePackedPixelAt :: ( Pixel px, PackeablePixel px
                      , M.Storable (PackedRepresentation px)
                      , PrimMonad m
                      )
                   => MutableImage (PrimState m) px -- ^ Image to write into

                   -> Int  -- ^ Index in (PixelBaseComponent px) count

                   -> px   -- ^ Pixel to write

                   -> m ()
{-# INLINE writePackedPixelAt #-}
writePackedPixelAt :: forall px (m :: * -> *).
(Pixel px, PackeablePixel px, Storable (PackedRepresentation px),
 PrimMonad m) =>
MutableImage (PrimState m) px -> Int -> px -> m ()
writePackedPixelAt MutableImage (PrimState m) px
img Int
idx px
px =
    MVector (PrimState m) (PackedRepresentation px)
-> Int -> PackedRepresentation px -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) (PackedRepresentation px)
converted (Int
idx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
compCount) PackedRepresentation px
packed
  where
    !packed :: PackedRepresentation px
packed = px -> PackedRepresentation px
forall a. PackeablePixel a => a -> PackedRepresentation a
packPixel px
px
    !compCount :: Int
compCount = px -> Int
forall a. Pixel a => a -> Int
componentCount px
px

    (ForeignPtr (PixelBaseComponent px)
ptr, Int
s, Int
s2) = MVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall s a. MVector s a -> (ForeignPtr a, Int, Int)
M.unsafeToForeignPtr (MVector (PrimState m) (PixelBaseComponent px)
 -> (ForeignPtr (PixelBaseComponent px), Int, Int))
-> MVector (PrimState m) (PixelBaseComponent px)
-> (ForeignPtr (PixelBaseComponent px), Int, Int)
forall a b. (a -> b) -> a -> b
$ MutableImage (PrimState m) px
-> MVector (PrimState m) (PixelBaseComponent px)
forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData MutableImage (PrimState m) px
img
    !packedPtr :: ForeignPtr (PackedRepresentation px)
packedPtr = ForeignPtr (PixelBaseComponent px)
-> ForeignPtr (PackedRepresentation px)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (PixelBaseComponent px)
ptr
    !converted :: MVector (PrimState m) (PackedRepresentation px)
converted =
        ForeignPtr (PackedRepresentation px)
-> Int -> Int -> MVector (PrimState m) (PackedRepresentation px)
forall a s. Storable a => ForeignPtr a -> Int -> Int -> MVector s a
M.unsafeFromForeignPtr ForeignPtr (PackedRepresentation px)
packedPtr Int
s Int
s2

{-# ANN module "HLint: ignore Reduce duplication" #-}