-- | 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

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

    , 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.

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

instance (Eq (PixelBaseComponent a), Storable (PixelBaseComponent a))
    => Eq (Image a) where
  a :: Image a
a == :: Image a -> Image a -> Bool
== b :: 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 :: plane -> Image px -> Image (PixelBaseComponent px)
extractComponent plane :: 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 :: Int -> Image a -> Image (PixelBaseComponent a)
unsafeExtractComponent comp :: 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
$ "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]
++ ", 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]
++ ")"
  | Bool
otherwise = $WImage :: forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
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 :: 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 r :: Pixel8
r g :: Pixel8
g b :: Pixel8
b _) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 Pixel8
r Pixel8
g Pixel8
b
    {-# INLINE getTransparency #-}
    getTransparency :: PixelRGBA8 -> PixelBaseComponent PixelRGBA8
getTransparency (PixelRGBA8 _ _ _ a :: Pixel8
a) = Pixel8
PixelBaseComponent PixelRGBA8
a

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

stride :: (Storable (PixelBaseComponent a))
       => Image a -> Int -> Int -> V.Vector (PixelBaseComponent a)
stride :: 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 }
        padd :: Int
padd firstComponent :: 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 writeIndex :: Int
writeIndex _ | Int
writeIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cell_count = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go writeIndex :: Int
writeIndex readIndex :: 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
+ 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 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 width :: Int
width height :: Int
height dat :: 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

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

      -- | Height of the image in pixels.

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

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

      -- you should use the helpers functions.

    , 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 :: MutableImage (PrimState m) px -> m (Image px)
freezeImage (MutableImage w :: Int
w h :: Int
h d :: 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 :: Image px -> m (MutableImage (PrimState m) px)
thawImage (Image w :: Int
w h :: Int
h d :: Vector (PixelBaseComponent px)
d) = 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` Vector (PixelBaseComponent px)
-> m (MVector (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 :: Image px -> m (MutableImage (PrimState m) px)
unsafeThawImage (Image w :: Int
w h :: Int
h d :: Vector (PixelBaseComponent px)
d) = 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` Vector (PixelBaseComponent px)
-> m (MVector (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 :: MutableImage (PrimState m) a -> m (Image a)
unsafeFreezeImage (MutableImage w :: Int
w h :: Int
h d :: 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 :: Int -> Int -> px -> m (MutableImage (PrimState m) px)
createMutableImage width :: Int
width height :: Int
height background :: 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 (\_ _ -> 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 :: Int -> Int -> m (MutableImage (PrimState m) px)
newMutableImage w :: Int
w h :: 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` 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)
  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 width :: Int
width height :: Int
height dat :: 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
/= :: DynamicImage -> DynamicImage -> Bool
$c/= :: DynamicImage -> DynamicImage -> Bool
== :: DynamicImage -> DynamicImage -> Bool
$c== :: 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.

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

  , 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 :: Palette' px -> Image px
palettedAsImage p :: 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) 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 img :: PalettedImage
img = case PalettedImage
img of
  TrueColorImage d :: DynamicImage
d -> DynamicImage
d
  PalettedY8    i :: Image Pixel8
i p :: 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 1 (Palette' Pixel8 -> Vector (PixelBaseComponent Pixel8)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' Pixel8
p) Image Pixel8
i
  PalettedRGB8  i :: Image Pixel8
i p :: 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 3 (Palette' PixelRGB8 -> Vector (PixelBaseComponent PixelRGB8)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' PixelRGB8
p) Image Pixel8
i
  PalettedRGBA8 i :: Image Pixel8
i p :: 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 4 (Palette' PixelRGBA8 -> Vector (PixelBaseComponent PixelRGBA8)
forall px. Palette' px -> Vector (PixelBaseComponent px)
_paletteData Palette' PixelRGBA8
p) Image Pixel8
i
  PalettedRGB16 i :: Image Pixel8
i p :: 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 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 c :: Int
c vec :: 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 pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageY8    i :: Image Pixel8
i) = Image Pixel8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image Pixel8
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageY16   i :: Image Pixel16
i) = Image Pixel16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image Pixel16
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageY32   i :: Image Pixel32
i) = Image Pixel32 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image Pixel32
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageYF    i :: Image PixelF
i) = Image PixelF -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelF
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageYA8   i :: Image PixelYA8
i) = Image PixelYA8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelYA8
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageYA16  i :: Image PixelYA16
i) = Image PixelYA16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelYA16
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGB8  i :: Image PixelRGB8
i) = Image PixelRGB8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGB8
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGB16 i :: Image PixelRGB16
i) = Image PixelRGB16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGB16
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGBF  i :: Image PixelRGBF
i) = Image PixelRGBF -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGBF
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGBA8 i :: Image PixelRGBA8
i) = Image PixelRGBA8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGBA8
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageRGBA16 i :: Image PixelRGBA16
i) = Image PixelRGBA16 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelRGBA16
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageYCbCr8 i :: Image PixelYCbCr8
i) = Image PixelYCbCr8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelYCbCr8
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageCMYK8 i :: Image PixelCMYK8
i) = Image PixelCMYK8 -> a
forall pixel. Pixel pixel => Image pixel -> a
f Image PixelCMYK8
i
dynamicMap f :: forall pixel. Pixel pixel => Image pixel -> a
f (ImageCMYK16 i :: 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 f :: forall pixel. Pixel pixel => Image pixel -> Image pixel
f = DynamicImage -> DynamicImage
aux
  where
    aux :: DynamicImage -> DynamicImage
aux (ImageY8    i :: 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   i :: 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   i :: 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    i :: 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   i :: 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  i :: 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  i :: 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 i :: 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  i :: 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 i :: 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 i :: 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 i :: 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 i :: 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 i :: Image PixelCMYK16
i) = Image PixelCMYK16 -> DynamicImage