JuicyPixels-3.1.3.3: Picture loading/serialization (in png, jpeg, bitmap, gif, tiff and radiance)

Safe HaskellNone

Codec.Picture.Types

Contents

Description

Module providing the basic types for image manipulation in the library. Defining the types used to store all those _Juicy Pixels_

Synopsis

Types

Image types

data Image a Source

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.

Constructors

Image 

Fields

imageWidth :: !Int

Width of the image in pixels

imageHeight :: !Int

Height of the image in pixels.

imageData :: Vector (PixelBaseComponent a)

The real image, to extract pixels at some position you should use the helpers functions.

Instances

data MutableImage s a Source

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.

Constructors

MutableImage 

Fields

mutableImageWidth :: !Int

Width of the image in pixels

mutableImageHeight :: !Int

Height of the image in pixels.

mutableImageData :: STVector s (PixelBaseComponent a)

The real image, to extract pixels at some position you should use the helpers functions.

Instances

data DynamicImage Source

Type allowing the loading of an image with different pixel structures

Constructors

ImageY8 (Image Pixel8)

A greyscale image.

ImageY16 (Image Pixel16)

A greyscale image with 16bit components

ImageYF (Image PixelF)

A greyscale HDR image

ImageYA8 (Image PixelYA8)

An image in greyscale with an alpha channel.

ImageYA16 (Image PixelYA16)

An image in greyscale with alpha channel on 16 bits.

ImageRGB8 (Image PixelRGB8)

An image in true color.

ImageRGB16 (Image PixelRGB16)

An image in true color with 16bit depth.

ImageRGBF (Image PixelRGBF)

An image with HDR pixels

ImageRGBA8 (Image PixelRGBA8)

An image in true color and an alpha channel.

ImageRGBA16 (Image PixelRGBA16)

A true color image with alpha on 16 bits.

ImageYCbCr8 (Image PixelYCbCr8)

An image in the colorspace used by Jpeg images.

ImageCMYK8 (Image PixelCMYK8)

An image in the colorspace CMYK

ImageCMYK16 (Image PixelCMYK16)

An image in the colorspace CMYK and 16 bots precision

Instances

type Palette = Image PixelRGB8Source

Type for the palette used in Gif & PNG files.

Image functions

createMutableImageSource

Arguments

:: (Pixel px, PrimMonad m) 
=> Int

Width

-> Int

Height

-> px

Background color

-> m (MutableImage (PrimState m) px) 

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

freezeImage :: (Storable (PixelBaseComponent px), PrimMonad m) => MutableImage (PrimState m) px -> m (Image px)Source

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

unsafeFreezeImage :: (Storable (PixelBaseComponent a), PrimMonad m) => MutableImage (PrimState m) a -> m (Image a)Source

`O(1)` Unsafe convert a mutable image to an immutable one without copying. The mutable image may not be used after this operation.

thawImage :: (Storable (PixelBaseComponent px), PrimMonad m) => Image px -> m (MutableImage (PrimState m) px)Source

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

unsafeThawImage :: (Storable (PixelBaseComponent px), PrimMonad m) => Image px -> m (MutableImage (PrimState m) px)Source

`O(1)` Unsafe convert an imutable image to an mutable one without copying. The source image shouldn't be used after this operation.

Pixel types

type Pixel8 = Word8Source

Simple alias for greyscale value in 8 bits.

type Pixel16 = Word16Source

Simple alias for greyscale value in 16 bits.

type Pixel32 = Word32Source

Simple alias for greyscale value in 16 bits.

type PixelF = FloatSource

Floating greyscale value, the 0 to 255 8 bit range maps to 0 to 1 in this floating version

data PixelYA16 Source

Pixel type storing Luminance (Y) and alpha information on 16 bits. Value are stored in the following order :

  • Luminance
  • Alpha

Constructors

PixelYA16 !Pixel16 !Pixel16 

Type classes

class (Pixel a, Pixel b) => ColorConvertible a b whereSource

Implement upcasting for pixel types Minimal declaration declaration promotePixel It is strongly recommanded to overload promoteImage to keep performance acceptable

Methods

promotePixel :: a -> bSource

Convert a pixel type to another pixel type. This operation should never loss any data.

promoteImage :: Image a -> Image bSource

Change the underlying pixel type of an image by performing a full copy of it.

class (Storable (PixelBaseComponent a), Num (PixelBaseComponent a), Eq a) => Pixel a whereSource

Definition of pixels used in images. Each pixel has a color space, and a representative component (Word8 or Float).

Associated Types

type PixelBaseComponent a :: *Source

Type of the pixel component, classical images would have Word8 type as their PixelBaseComponent, HDR image would have Float for instance

Methods

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

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)

componentCount :: a -> IntSource

Return the number of component of the pixel

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

Apply a function to all color component of a pixel.

pixelBaseIndex :: Image a -> Int -> Int -> IntSource

Calculate the index for the begining of the pixel

mutablePixelBaseIndex :: MutableImage s a -> Int -> Int -> IntSource

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

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

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

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

Same as pixelAt but for mutable images.

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

Write a pixel in a mutable image at position x y

unsafePixelAt :: Vector (PixelBaseComponent a) -> Int -> aSource

Unsafe version of pixelAt, read a pixel at the given index without bound checking (if possible). The index is expressed in number (PixelBaseComponent a)

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

Unsafe version of readPixel, read a pixel at the given position without bound checking (if possible). The index is expressed in number (PixelBaseComponent a)

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

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)

The following graph describe the differents way to convert between pixel types,

  • Nodes describe pixel type
  • Arrows describe functions

class (Pixel a, Pixel b) => ColorSpaceConvertible a b whereSource

This class abstract colorspace conversion. This conversion can be lossy, which ColorConvertible cannot

Methods

convertPixel :: a -> bSource

Pass a pixel from a colorspace (say RGB) to the second one (say YCbCr)

convertImage :: Image a -> Image bSource

Helper function to convert a whole image by taking a copy it.

class (Pixel a, Pixel (PixelBaseComponent a)) => LumaPlaneExtractable a whereSource

Helper class to help extract a luma plane out of an image or a pixel

Methods

computeLuma :: a -> PixelBaseComponent aSource

Compute the luminance part of a pixel

extractLumaPlane :: Image a -> Image (PixelBaseComponent a)Source

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

class (Pixel a, Pixel b) => TransparentPixel a b | a -> b whereSource

Class modeling transparent pixel, should provide a method to combine transparent pixels

Methods

dropTransparency :: a -> bSource

Just return the opaque pixel value

getTransparency :: a -> PixelBaseComponent aSource

access the transparency (alpha layer) of a given transparent pixel type

Helper functions

pixelMap :: forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image bSource

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)

pixelMapXY :: forall a b. (Pixel a, Pixel b) => (Int -> Int -> a -> b) -> Image a -> Image bSource

Just like pixelMap only the function takes the pixel coordinates as additional parameters.

pixelFold :: Pixel pixel => (acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> accSource

Fold over the pixel of an image with a raster scan order : from top to bottom, left to right

dynamicMap :: (forall pixel. Pixel pixel => Image pixel -> a) -> DynamicImage -> aSource

Helper function to help extract information from dynamic image. To get the width of an dynamic image, you can use the following snippet :

 dynWidth :: DynamicImage -> Int
 dynWidth img = dynamicMap imageWidth img

dynamicPixelMap :: (forall pixel. Pixel pixel => Image pixel -> Image pixel) -> DynamicImage -> DynamicImageSource

Equivalent of the pixelMap function for the dynamic images. You can perform pixel colorspace independant operations with this function.

For instance, if you wan't to extract a square crop of any image, without caring about colorspace, you can use the following snippet.

 dynSquare :: DynamicImage -> DynamicImage
 dynSquare = dynMap 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)

dropAlphaLayer :: TransparentPixel a b => Image a -> Image bSource

For any image with an alpha component (transparency), drop it, returning a pure opaque image.

withImageSource

Arguments

:: forall m pixel . (Pixel pixel, PrimMonad m) 
=> Int

Image width

-> Int

Image height

-> (Int -> Int -> m pixel)

Generating functions

-> m (Image pixel) 

Create an image using a monadic initializer function. The function will receive value from 0 to width-1 for the x parameter and 0 to height-1 for the y parameter. The coordinate 0,0 is 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).

zipPixelComponent3 :: forall px. Storable (PixelBaseComponent px) => (PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px) -> Image px -> Image px -> Image px -> Image pxSource

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

generateImageSource

Arguments

:: forall a . Pixel a 
=> (Int -> Int -> a)

Generating function, with x and y params.

-> Int

Width in pixels

-> Int

Height in pixels

-> Image a 

Create an image given a function to generate pixels. The function will receive value from 0 to width-1 for the x parameter and 0 to height-1 for the y parameter. The coordinate 0,0 is 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 x y 128

generateFoldImageSource

Arguments

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

Create an image given a function to generate pixels. The function will receive value from 0 to width-1 for the x parameter and 0 to height-1 for the y parameter. The coordinate 0,0 is 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).

gammaCorrectionSource

Arguments

:: PixelF

Gamma value, should be between 0.5 and 3.0

-> Image PixelRGBF

Image to treat.

-> Image PixelRGBF 

Perform a gamma correction for an image with HDR pixels.

toneMappingSource

Arguments

:: PixelF

Exposure parameter

-> Image PixelRGBF

Image to treat.

-> Image PixelRGBF 

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

Color plane extraction

data PlaneAlpha Source

Define the plane for the alpha (transparency) component

Constructors

PlaneAlpha 

data PlaneLuma Source

Define the plane for the luma component

Constructors

PlaneLuma 

data PlaneCr Source

Define the plane for the Cr component

Constructors

PlaneCr 

data PlaneCb Source

Define the plane for the Cb component

Constructors

PlaneCb 

data PlaneCyan Source

Define plane for the cyan component of the CMYK color space.

Constructors

PlaneCyan 

data PlaneMagenta Source

Define plane for the magenta component of the CMYK color space.

Constructors

PlaneMagenta 

data PlaneYellow Source

Define plane for the yellow component of the CMYK color space.

Constructors

PlaneYellow 

data PlaneBlack Source

Define plane for the black component of the CMYK color space.

Constructors

PlaneBlack 

extractComponent :: forall px plane. (Pixel px, Pixel (PixelBaseComponent px), PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px, ColorPlane px plane) => plane -> Image px -> Image (PixelBaseComponent px)Source

Extract a color plane from an image given a present plane in the image examples :

  extractRedPlane :: Image PixelRGB8-> Image Pixel8
  extractRedPlane = extractComponent PlaneRed

unsafeExtractComponentSource

Arguments

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

Extract an image plane of an image, returning an image which can be represented by a gray scale image. If you ask a component out of bound, the error function will be called