Safe Haskell | None |
---|---|
Language | Haskell2010 |
Module provides basic types for image manipulation in the library.
Synopsis
- data Image a = Image {
- imageWidth :: !Int
- imageHeight :: !Int
- imageData :: Vector (PixelBaseComponent a)
- data MutableImage s a = MutableImage {
- mutableImageWidth :: !Int
- mutableImageHeight :: !Int
- mutableImageData :: STVector s (PixelBaseComponent a)
- data DynamicImage
- = ImageY8 (Image Pixel8)
- | ImageY16 (Image Pixel16)
- | ImageY32 (Image Pixel32)
- | ImageYF (Image PixelF)
- | ImageYA8 (Image PixelYA8)
- | ImageYA16 (Image PixelYA16)
- | ImageRGB8 (Image PixelRGB8)
- | ImageRGB16 (Image PixelRGB16)
- | ImageRGBF (Image PixelRGBF)
- | ImageRGBA8 (Image PixelRGBA8)
- | ImageRGBA16 (Image PixelRGBA16)
- | ImageYCbCr8 (Image PixelYCbCr8)
- | ImageCMYK8 (Image PixelCMYK8)
- | ImageCMYK16 (Image PixelCMYK16)
- data PalettedImage
- type Palette = Image PixelRGB8
- data Palette' px = Palette' {
- _paletteSize :: !Int
- _paletteData :: !(Vector (PixelBaseComponent px))
- createMutableImage :: (Pixel px, PrimMonad m) => Int -> Int -> px -> m (MutableImage (PrimState m) px)
- newMutableImage :: forall px m. (Pixel px, PrimMonad m) => Int -> Int -> m (MutableImage (PrimState m) px)
- freezeImage :: (Storable (PixelBaseComponent px), PrimMonad m) => MutableImage (PrimState m) px -> m (Image px)
- unsafeFreezeImage :: (Storable (PixelBaseComponent a), PrimMonad m) => MutableImage (PrimState m) a -> m (Image a)
- thawImage :: (Storable (PixelBaseComponent px), PrimMonad m) => Image px -> m (MutableImage (PrimState m) px)
- unsafeThawImage :: (Storable (PixelBaseComponent px), PrimMonad m) => Image px -> m (MutableImage (PrimState m) px)
- type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
- imagePixels :: forall pxa pxb. (Pixel pxa, Pixel pxb) => Traversal (Image pxa) (Image pxb) pxa pxb
- imageIPixels :: forall pxa pxb. (Pixel pxa, Pixel pxb) => Traversal (Image pxa) (Image pxb) (Int, Int, pxa) pxb
- type Pixel8 = Word8
- type Pixel16 = Word16
- type Pixel32 = Word32
- type PixelF = Float
- data PixelYA8 = PixelYA8 !Pixel8 !Pixel8
- data PixelYA16 = PixelYA16 !Pixel16 !Pixel16
- data PixelRGB8 = PixelRGB8 !Pixel8 !Pixel8 !Pixel8
- data PixelRGB16 = PixelRGB16 !Pixel16 !Pixel16 !Pixel16
- data PixelRGBF = PixelRGBF !PixelF !PixelF !PixelF
- data PixelRGBA8 = PixelRGBA8 !Pixel8 !Pixel8 !Pixel8 !Pixel8
- data PixelRGBA16 = PixelRGBA16 !Pixel16 !Pixel16 !Pixel16 !Pixel16
- data PixelCMYK8 = PixelCMYK8 !Pixel8 !Pixel8 !Pixel8 !Pixel8
- data PixelCMYK16 = PixelCMYK16 !Pixel16 !Pixel16 !Pixel16 !Pixel16
- data PixelYCbCr8 = PixelYCbCr8 !Pixel8 !Pixel8 !Pixel8
- data PixelYCbCrK8 = PixelYCbCrK8 !Pixel8 !Pixel8 !Pixel8 !Pixel8
- class (Pixel a, Pixel b) => ColorConvertible a b where
- class (Storable (PixelBaseComponent a), Num (PixelBaseComponent a), Eq a) => Pixel a where
- type PixelBaseComponent a :: *
- class (Pixel a, Pixel b) => ColorSpaceConvertible a b where
- class (Pixel a, Pixel (PixelBaseComponent a)) => LumaPlaneExtractable a where
- class (Pixel a, Pixel b) => TransparentPixel a b | a -> b where
- pixelMap :: forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
- pixelMapXY :: forall a b. (Pixel a, Pixel b) => (Int -> Int -> a -> b) -> Image a -> Image b
- pixelFold :: forall acc pixel. Pixel pixel => (acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> acc
- pixelFoldM :: (Pixel pixel, Monad m) => (acc -> Int -> Int -> pixel -> m acc) -> acc -> Image pixel -> m acc
- pixelFoldMap :: forall m px. (Pixel px, Monoid m) => (px -> m) -> Image px -> m
- dynamicMap :: (forall pixel. Pixel pixel => Image pixel -> a) -> DynamicImage -> a
- dynamicPixelMap :: (forall pixel. Pixel pixel => Image pixel -> Image pixel) -> DynamicImage -> DynamicImage
- palettedToTrueColor :: PalettedImage -> DynamicImage
- palettedAsImage :: Palette' px -> Image px
- dropAlphaLayer :: TransparentPixel a b => Image a -> Image b
- withImage :: forall m pixel. (Pixel pixel, PrimMonad m) => Int -> Int -> (Int -> Int -> m pixel) -> m (Image pixel)
- zipPixelComponent3 :: forall px. Storable (PixelBaseComponent px) => (PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px) -> Image px -> Image px -> Image px -> Image px
- generateImage :: forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
- generateFoldImage :: forall a acc. Pixel a => (acc -> Int -> Int -> (acc, a)) -> acc -> Int -> Int -> (acc, Image a)
- gammaCorrection :: PixelF -> Image PixelRGBF -> Image PixelRGBF
- toneMapping :: PixelF -> Image PixelRGBF -> Image PixelRGBF
- class ColorPlane pixel planeToken
- data PlaneRed = PlaneRed
- data PlaneGreen = PlaneGreen
- data PlaneBlue = PlaneBlue
- data PlaneAlpha = PlaneAlpha
- data PlaneLuma = PlaneLuma
- data PlaneCr = PlaneCr
- data PlaneCb = PlaneCb
- data PlaneCyan = PlaneCyan
- data PlaneMagenta = PlaneMagenta
- data PlaneYellow = PlaneYellow
- data PlaneBlack = PlaneBlack
- extractComponent :: forall px plane. (Pixel px, Pixel (PixelBaseComponent px), PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px, ColorPlane px plane) => plane -> Image px -> Image (PixelBaseComponent px)
- unsafeExtractComponent :: forall a. (Pixel a, Pixel (PixelBaseComponent a), PixelBaseComponent (PixelBaseComponent a) ~ PixelBaseComponent a) => Int -> Image a -> Image (PixelBaseComponent a)
- class PackeablePixel a where
- type PackedRepresentation a
- fillImageWith :: (Pixel px, PackeablePixel px, PrimMonad m, Storable (PackedRepresentation px)) => MutableImage (PrimState m) px -> px -> m ()
- readPackedPixelAt :: forall m px. (Pixel px, PackeablePixel px, Storable (PackedRepresentation px), PrimMonad m) => MutableImage (PrimState m) px -> Int -> m px
- writePackedPixelAt :: (Pixel px, PackeablePixel px, Storable (PackedRepresentation px), PrimMonad m) => MutableImage (PrimState m) px -> Int -> px -> m ()
- unsafeWritePixelBetweenAt :: (PrimMonad m, Pixel px, PackeablePixel px, Storable (PackedRepresentation px)) => MutableImage (PrimState m) px -> px -> Int -> Int -> m ()
Types
Image types
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.
Image | |
|
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.
MutableImage | |
|
Instances
NFData (MutableImage s a) Source # | |
Defined in Codec.Picture.Types rnf :: MutableImage s a -> () # |
data DynamicImage Source #
Image type enumerating all predefined pixel types. It enables loading and use of images of different pixel types.
ImageY8 (Image Pixel8) | A greyscale image. |
ImageY16 (Image Pixel16) | A greyscale image with 16bit components |
ImageY32 (Image Pixel32) | A greyscale image with 32bit 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 bits precision |
Instances
Eq DynamicImage Source # | |
Defined in Codec.Picture.Types (==) :: DynamicImage -> DynamicImage -> Bool # (/=) :: DynamicImage -> DynamicImage -> Bool # | |
NFData DynamicImage Source # | |
Defined in Codec.Picture.Types rnf :: DynamicImage -> () # |
data PalettedImage Source #
Describe an image and it's potential associated palette. If no palette is present, fallback to a DynamicImage
Type used to expose a palette extracted during reading. Use palettedAsImage to convert it to a palette usable for writing.
Palette' | |
|
Image functions
:: (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.
Create a mutable image with garbage as content. All data is uninitialized.
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.
Image Lenses
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t Source #
Traversal type matching the definition in the Lens package.
imagePixels :: forall pxa pxb. (Pixel pxa, Pixel pxb) => Traversal (Image pxa) (Image pxb) pxa pxb Source #
Traversal in "raster" order, from left to right the top to bottom. This traversal is matching pixelMap in spirit.
Since 3.2.4
imageIPixels :: forall pxa pxb. (Pixel pxa, Pixel pxb) => Traversal (Image pxa) (Image pxb) (Int, Int, pxa) pxb Source #
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
Pixel types
Type alias for 8bit greyscale pixels. For simplicity, greyscale pixels use plain numbers instead of a separate type.
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]
Pixel type storing 8bit Luminance (Y) and alpha (A) information. Values are stored in the following order:
- Luminance
- Alpha
Instances
Pixel type storing 16bit Luminance (Y) and alpha (A) information. Values are stored in the following order:
- Luminance
- Alpha
Instances
Classic pixel type storing 8bit red, green and blue (RGB) information. Values are stored in the following order:
- Red
- Green
- Blue
Instances
data PixelRGB16 Source #
Pixel type storing 16bit red, green and blue (RGB) information. Values are stored in the following order:
- Red
- Green
- Blue
Instances
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
Instances
data PixelRGBA8 Source #
Classical pixel type storing 8bit red, green, blue and alpha (RGBA) information. Values are stored in the following order:
- Red
- Green
- Blue
- Alpha
Instances
data PixelRGBA16 Source #
Pixel type storing 16bit red, green, blue and alpha (RGBA) information. Values are stored in the following order:
- Red
- Green
- Blue
- Alpha
Instances
data PixelCMYK8 Source #
Pixel type storing 8bit cyan, magenta, yellow and black (CMYK) information. Values are stored in the following order:
- Cyan
- Magenta
- Yellow
- Black
Instances
data PixelCMYK16 Source #
Pixel type storing 16bit cyan, magenta, yellow and black (CMYK) information. Values are stored in the following order:
- Cyan
- Magenta
- Yellow
- Black
Instances
data PixelYCbCr8 Source #
Pixel type storing 8bit luminance, blue difference and red difference (YCbCr) information. Values are stored in the following order:
- Y (luminance)
- Cb
- Cr
Instances
data PixelYCbCrK8 Source #
Pixel type storing value for the YCCK color space:
- Y (Luminance)
- Cb
- Cr
- Black
Instances
Type classes
class (Pixel a, Pixel b) => ColorConvertible a b where Source #
Implement upcasting for pixel types.
Minimal declaration of promotePixel
.
It is strongly recommended to overload promoteImage to keep
performance acceptable
promotePixel :: a -> b Source #
Convert a pixel type to another pixel type. This operation should never lose any data.
promoteImage :: Image a -> Image b Source #
Change the underlying pixel type of an image by performing a full copy of it.
Instances
class (Storable (PixelBaseComponent a), Num (PixelBaseComponent a), Eq a) => Pixel a where Source #
Definition of pixels used in images. Each pixel has a color space, and a representative component (Word8 or Float).
mixWith, pixelOpacity, componentCount, colorMap, pixelAt, readPixel, writePixel, unsafePixelAt, unsafeReadPixel, unsafeWritePixel
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
mixWith :: (Int -> PixelBaseComponent a -> PixelBaseComponent a -> PixelBaseComponent a) -> a -> a -> a Source #
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)
:: (Int -> PixelBaseComponent a -> PixelBaseComponent a -> PixelBaseComponent a) | Function for color component |
-> (PixelBaseComponent a -> PixelBaseComponent a -> PixelBaseComponent a) | Function for alpha component |
-> 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)
pixelOpacity :: a -> PixelBaseComponent a Source #
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.
componentCount :: a -> Int Source #
Return the number of components of the pixel
colorMap :: (PixelBaseComponent a -> PixelBaseComponent a) -> a -> a Source #
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.
pixelBaseIndex :: Image a -> Int -> Int -> Int Source #
Calculate the index for the begining of the pixel
mutablePixelBaseIndex :: MutableImage s a -> Int -> Int -> Int Source #
Calculate theindex for the begining of the pixel at position x y
pixelAt :: Image a -> Int -> Int -> a Source #
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 a Source #
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 -> a Source #
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 a Source #
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)
Instances
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 where Source #
This class abstract colorspace conversion. This conversion can be lossy, which ColorConvertible cannot
convertPixel :: a -> b Source #
Pass a pixel from a colorspace (say RGB) to the second one (say YCbCr)
convertImage :: Image a -> Image b Source #
Helper function to convert a whole image by taking a copy it.
Instances
class (Pixel a, Pixel (PixelBaseComponent a)) => LumaPlaneExtractable a where Source #
Helper class to help extract a luma plane out of an image or a pixel
computeLuma :: a -> PixelBaseComponent a Source #
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
Instances
LumaPlaneExtractable PixelRGBA8 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable PixelYCbCr8 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable PixelRGBF Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable PixelRGB16 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable PixelRGB8 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable PixelYA8 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable PixelF Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable Pixel32 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable Pixel16 Source # | |
Defined in Codec.Picture.Types | |
LumaPlaneExtractable Pixel8 Source # | |
Defined in Codec.Picture.Types |
class (Pixel a, Pixel b) => TransparentPixel a b | a -> b where Source #
Class modeling transparent pixel, should provide a method to combine transparent pixels
dropTransparency :: a -> b Source #
Just return the opaque pixel value
getTransparency :: a -> PixelBaseComponent a Source #
Deprecated: please use pixelOpacity
instead
access the transparency (alpha layer) of a given transparent pixel type.
Instances
TransparentPixel PixelRGBA16 PixelRGB16 Source # | |
Defined in Codec.Picture.Types | |
TransparentPixel PixelRGBA8 PixelRGB8 Source # | |
Defined in Codec.Picture.Types | |
TransparentPixel PixelYA16 Pixel16 Source # | |
Defined in Codec.Picture.Types | |
TransparentPixel PixelYA8 Pixel8 Source # | |
Defined in Codec.Picture.Types |
Helper functions
pixelMap :: forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b Source #
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 b Source #
Just like pixelMap
only the function takes the pixel coordinates as
additional parameters.
pixelFold :: forall acc pixel. Pixel pixel => (acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> acc Source #
Fold over the pixel of an image with a raster scan order: from top to bottom, left to right
:: (Pixel pixel, Monad m) | |
=> (acc -> Int -> Int -> pixel -> m acc) | monadic mapping function |
-> acc | Initial state |
-> Image pixel | Image to fold over |
-> m acc |
Fold over the pixel of an image with a raster scan order: from top to bottom, left to right, carrying out a state
pixelFoldMap :: forall m px. (Pixel px, Monoid m) => (px -> m) -> Image px -> m Source #
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.
dynamicMap :: (forall pixel. Pixel pixel => Image pixel -> a) -> DynamicImage -> a Source #
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
dynamicPixelMap :: (forall pixel. Pixel pixel => Image pixel -> Image pixel) -> DynamicImage -> DynamicImage Source #
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)
palettedToTrueColor :: PalettedImage -> DynamicImage Source #
Flatten a PalettedImage to a DynamicImage
palettedAsImage :: Palette' px -> Image px Source #
Convert a palette to an image. Used mainly for backward compatibility.
dropAlphaLayer :: TransparentPixel a b => Image a -> Image b Source #
For any image with an alpha component (transparency), drop it, returning a pure opaque image.
:: (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 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).
zipPixelComponent3 :: forall px. Storable (PixelBaseComponent px) => (PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px -> PixelBaseComponent px) -> Image px -> Image px -> Image px -> Image px Source #
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
:: Pixel px | |
=> (Int -> Int -> px) | Generating function, with |
-> Int | Width in pixels |
-> Int | Height in pixels |
-> Image px |
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
:: 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 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).
:: 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.
Perform a tone mapping operation on an High dynamic range image.
Color plane extraction
class ColorPlane pixel planeToken Source #
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.
toComponentIndex
Instances
Define the plane for the red color component
Instances
ColorPlane PixelRGBA16 PlaneRed Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA16 -> PlaneRed -> Int | |
ColorPlane PixelRGBA8 PlaneRed Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA8 -> PlaneRed -> Int | |
ColorPlane PixelRGBF PlaneRed Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBF -> PlaneRed -> Int | |
ColorPlane PixelRGB16 PlaneRed Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGB16 -> PlaneRed -> Int | |
ColorPlane PixelRGB8 PlaneRed Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGB8 -> PlaneRed -> Int |
data PlaneGreen Source #
Define the plane for the green color component
Instances
ColorPlane PixelRGBA16 PlaneGreen Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA16 -> PlaneGreen -> Int | |
ColorPlane PixelRGBA8 PlaneGreen Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA8 -> PlaneGreen -> Int | |
ColorPlane PixelRGBF PlaneGreen Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBF -> PlaneGreen -> Int | |
ColorPlane PixelRGB16 PlaneGreen Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGB16 -> PlaneGreen -> Int | |
ColorPlane PixelRGB8 PlaneGreen Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGB8 -> PlaneGreen -> Int |
Define the plane for the blue color component
Instances
ColorPlane PixelRGBA16 PlaneBlue Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA16 -> PlaneBlue -> Int | |
ColorPlane PixelRGBA8 PlaneBlue Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA8 -> PlaneBlue -> Int | |
ColorPlane PixelRGBF PlaneBlue Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBF -> PlaneBlue -> Int | |
ColorPlane PixelRGB16 PlaneBlue Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGB16 -> PlaneBlue -> Int | |
ColorPlane PixelRGB8 PlaneBlue Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGB8 -> PlaneBlue -> Int |
data PlaneAlpha Source #
Define the plane for the alpha (transparency) component
Instances
ColorPlane PixelRGBA16 PlaneAlpha Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA16 -> PlaneAlpha -> Int | |
ColorPlane PixelRGBA8 PlaneAlpha Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelRGBA8 -> PlaneAlpha -> Int | |
ColorPlane PixelYA16 PlaneAlpha Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYA16 -> PlaneAlpha -> Int | |
ColorPlane PixelYA8 PlaneAlpha Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYA8 -> PlaneAlpha -> Int |
Define the plane for the luma component
Instances
ColorPlane PixelYCbCr8 PlaneLuma Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYCbCr8 -> PlaneLuma -> Int | |
ColorPlane PixelYA16 PlaneLuma Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYA16 -> PlaneLuma -> Int | |
ColorPlane PixelYA8 PlaneLuma Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYA8 -> PlaneLuma -> Int |
Define the plane for the Cr component
Instances
ColorPlane PixelYCbCr8 PlaneCr Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYCbCr8 -> PlaneCr -> Int |
Define the plane for the Cb component
Instances
ColorPlane PixelYCbCr8 PlaneCb Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelYCbCr8 -> PlaneCb -> Int |
Define plane for the cyan component of the CMYK color space.
Instances
ColorPlane PixelCMYK16 PlaneCyan Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK16 -> PlaneCyan -> Int | |
ColorPlane PixelCMYK8 PlaneCyan Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK8 -> PlaneCyan -> Int |
data PlaneMagenta Source #
Define plane for the magenta component of the CMYK color space.
Instances
ColorPlane PixelCMYK16 PlaneMagenta Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK16 -> PlaneMagenta -> Int | |
ColorPlane PixelCMYK8 PlaneMagenta Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK8 -> PlaneMagenta -> Int |
data PlaneYellow Source #
Define plane for the yellow component of the CMYK color space.
Instances
ColorPlane PixelCMYK16 PlaneYellow Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK16 -> PlaneYellow -> Int | |
ColorPlane PixelCMYK8 PlaneYellow Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK8 -> PlaneYellow -> Int |
data PlaneBlack Source #
Define plane for the black component of the CMYK color space.
Instances
ColorPlane PixelCMYK16 PlaneBlack Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK16 -> PlaneBlack -> Int | |
ColorPlane PixelCMYK8 PlaneBlack Source # | |
Defined in Codec.Picture.Types toComponentIndex :: PixelCMYK8 -> PlaneBlack -> Int |
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
unsafeExtractComponent Source #
:: (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 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.
Packeable writing (unsafe but faster)
class PackeablePixel a where Source #
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.
type PackedRepresentation a Source #
Primitive type asociated to the current pixel It's Word32 for PixelRGBA8 for instance
packPixel :: a -> PackedRepresentation a Source #
The packing function, allowing to transform to a primitive.
unpackPixel :: PackedRepresentation a -> a Source #
Inverse transformation, to speed up reading
Instances
fillImageWith :: (Pixel px, PackeablePixel px, PrimMonad m, Storable (PackedRepresentation px)) => MutableImage (PrimState m) px -> px -> m () Source #
This function will fill an image with a simple packeable pixel. It will be faster than any unsafeWritePixel.
:: (Pixel px, PackeablePixel px, Storable (PackedRepresentation px), PrimMonad m) | |
=> MutableImage (PrimState m) px | Image to read from |
-> Int | Index in (PixelBaseComponent px) count |
-> m px |
Read a packeable pixel from an image. Equivalent to unsafeReadPixel
:: (Pixel px, PackeablePixel px, Storable (PackedRepresentation px), PrimMonad m) | |
=> MutableImage (PrimState m) px | Image to write into |
-> Int | Index in (PixelBaseComponent px) count |
-> px | Pixel to write |
-> m () |
Write a packeable pixel into an image. equivalent to unsafeWritePixel.
unsafeWritePixelBetweenAt Source #
:: (PrimMonad m, Pixel px, PackeablePixel px, 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 () |
Fill a packeable pixel between two bounds.