Copyright | (c) Alexey Kuleshevich 2017 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <[email protected]> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Graphics.Image.Interface
Description
- data family Pixel cs e :: *
- class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs, Elevator e, Typeable e) => ColorSpace cs e where
- type Components cs e
- class (ColorSpace (Opaque cs) e, ColorSpace cs e) => AlphaSpace cs e where
- type Opaque cs
- class Elevator e where
- class (Show arr, ColorSpace cs e, Num (Pixel cs e), SuperClass arr cs e) => BaseArray arr cs e where
- type SuperClass arr cs e :: Constraint
- data Image arr cs e
- class (MArray (Manifest arr) cs e, BaseArray arr cs e) => Array arr cs e where
- class BaseArray arr cs e => MArray arr cs e where
- data MImage s arr cs e
- class Exchangable arr' arr where
- exchangeFrom :: (Exchangable arr' arr, Array arr' cs e, Array arr cs e) => arr' -> arr -> Image arr' cs e -> Image arr cs e
- exchangeThrough :: (Exchangable arr2 arr1, Exchangable arr1 arr, Array arr2 cs e, Array arr1 cs e, Array arr cs e) => arr1 -> arr -> Image arr2 cs e -> Image arr cs e
- defaultIndex :: MArray arr cs e => Pixel cs e -> Image arr cs e -> (Int, Int) -> Pixel cs e
- borderIndex :: MArray arr cs e => Border (Pixel cs e) -> Image arr cs e -> (Int, Int) -> Pixel cs e
- maybeIndex :: MArray arr cs e => Image arr cs e -> (Int, Int) -> Maybe (Pixel cs e)
- data Border px
- handleBorderIndex :: Border px -> (Int, Int) -> ((Int, Int) -> px) -> (Int, Int) -> px
- fromIx :: Int -> (Int, Int) -> Int
- toIx :: Int -> Int -> (Int, Int)
- checkDims :: String -> (Int, Int) -> (Int, Int)
Documentation
data family Pixel cs e :: * Source #
A Pixel family with a color space and a precision of elements.
Instances
class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs, Elevator e, Typeable e) => ColorSpace cs e where Source #
Minimal complete definition
toComponents, fromComponents, promote, getPxC, setPxC, mapPxC, liftPx, liftPx2, foldlPx2
Associated Types
type Components cs e Source #
Methods
toComponents :: Pixel cs e -> Components cs e Source #
Convert a Pixel to a representation suitable for storage as an unboxed element, usually a tuple of channels.
fromComponents :: Components cs e -> Pixel cs e Source #
Convert from an elemnt representation back to a Pixel.
promote :: e -> Pixel cs e Source #
Construt a Pixel by replicating the same value across all of the components.
getPxC :: Pixel cs e -> cs -> e Source #
Retrieve Pixel's component value
setPxC :: Pixel cs e -> cs -> e -> Pixel cs e Source #
Set Pixel's component value
mapPxC :: (cs -> e -> e) -> Pixel cs e -> Pixel cs e Source #
Map a channel aware function over all Pixel's components.
liftPx :: (e -> e) -> Pixel cs e -> Pixel cs e Source #
Map a function over all Pixel's componenets.
liftPx2 :: (e -> e -> e) -> Pixel cs e -> Pixel cs e -> Pixel cs e Source #
Zip two Pixels with a function.
foldlPx2 :: (b -> e -> e -> b) -> b -> Pixel cs e -> Pixel cs e -> b Source #
foldrPx :: (e -> b -> b) -> b -> Pixel cs e -> b Source #
Right fold over all Pixel's components.
foldlPx :: (b -> e -> b) -> b -> Pixel cs e -> b Source #
Left strict fold over all Pixel's components.
Instances
(Elevator e, Typeable * e) => ColorSpace YCbCrA e Source # | |
(Elevator e, Typeable * e) => ColorSpace YCbCr e Source # | |
(Elevator e, Typeable * e) => ColorSpace YA e Source # | |
(Elevator e, Typeable * e) => ColorSpace Y e Source # | |
(Elevator e, Typeable * e) => ColorSpace X e Source # | |
(Elevator e, Typeable * e) => ColorSpace RGBA e Source # | |
(Elevator e, Typeable * e) => ColorSpace RGB e Source # | |
(Elevator e, Typeable * e) => ColorSpace HSIA e Source # | |
(Elevator e, Typeable * e) => ColorSpace HSI e Source # | |
(Elevator e, Typeable * e) => ColorSpace CMYKA e Source # | |
(Elevator e, Typeable * e) => ColorSpace CMYK e Source # | |
ColorSpace Binary Bit Source # | |
class (ColorSpace (Opaque cs) e, ColorSpace cs e) => AlphaSpace cs e where Source #
A color space that supports transparency.
Methods
getAlpha :: Pixel cs e -> e Source #
Get an alpha channel of a transparant pixel.
addAlpha :: e -> Pixel (Opaque cs) e -> Pixel cs e Source #
Add an alpha channel of an opaque pixel.
addAlpha 0 (PixelHSI 1 2 3) == PixelHSIA 1 2 3 0
dropAlpha :: Pixel cs e -> Pixel (Opaque cs) e Source #
Convert a transparent pixel to an opaque one by dropping the alpha channel.
dropAlpha (PixelRGBA 1 2 3 4) == PixelRGB 1 2 3
class Elevator e where Source #
A class with a set of convenient functions that allow for changing precision of channels within pixels, while scaling the values to keep them in an appropriate range.
>>>
let rgb = PixelRGB 0.0 0.5 1.0 :: Pixel RGB Double
>>>
toWord8 rgb
<RGB:(0|128|255)>
Methods
toWord8 :: e -> Word8 Source #
Values are scaled to [0, 255]
range.
toWord16 :: e -> Word16 Source #
Values are scaled to [0, 65535]
range.
toWord32 :: e -> Word32 Source #
Values are scaled to [0, 4294967295]
range.
toWord64 :: e -> Word64 Source #
Values are scaled to [0, 18446744073709551615]
range.
toFloat :: e -> Float Source #
Values are scaled to [0.0, 1.0]
range.
toDouble :: e -> Double Source #
Values are scaled to [0.0, 1.0]
range.
fromDouble :: Double -> e Source #
Values are scaled from [0.0, 1.0]
range.
class (Show arr, ColorSpace cs e, Num (Pixel cs e), SuperClass arr cs e) => BaseArray arr cs e where Source #
Base array like representation for an image.
Minimal complete definition
Associated Types
type SuperClass arr cs e :: Constraint Source #
Required array specific constraints for an array element.
Underlying image representation.
Methods
dims :: Image arr cs e -> (Int, Int) Source #
Get dimensions of an image.
>>>
frog <- readImageRGB VU "images/frog.jpg"
>>>
frog
<Image VectorUnboxed RGB (Double): 200x320>>>>
dims frog
(200,320)
Instances
SuperClass VS cs e => BaseArray VS cs e Source # | |
SuperClass VU cs e => BaseArray VU cs e Source # | |
SuperClass RPS cs e => BaseArray RPS cs e Source # | |
SuperClass RSS cs e => BaseArray RSS cs e Source # | |
SuperClass RPU cs e => BaseArray RPU cs e Source # | |
SuperClass RSU cs e => BaseArray RSU cs e Source # | |
class (MArray (Manifest arr) cs e, BaseArray arr cs e) => Array arr cs e where Source #
Minimal complete definition
makeImage, makeImageWindowed, scalar, index00, map, imap, zipWith, izipWith, traverse, traverse2, transpose, backpermute, fromLists, (|*|), fold, foldIx, eq, compute, toManifest
Methods
makeImage :: (Int, Int) -> ((Int, Int) -> Pixel cs e) -> Image arr cs e Source #
Create an Image by supplying it's dimensions and a pixel generating function.
makeImageWindowed :: (Int, Int) -> ((Int, Int), (Int, Int)) -> ((Int, Int) -> Pixel cs e) -> ((Int, Int) -> Pixel cs e) -> Image arr cs e Source #
scalar :: Pixel cs e -> Image arr cs e Source #
Create a scalar image, required for various operations on images with a scalar.
index00 :: Image arr cs e -> Pixel cs e Source #
Retrieves a pixel at (0, 0)
index. Useful together with fold
, when
arbitrary initial pixel is needed.
map :: Array arr cs' e' => (Pixel cs' e' -> Pixel cs e) -> Image arr cs' e' -> Image arr cs e Source #
Map a function over a an image.
imap :: Array arr cs' e' => ((Int, Int) -> Pixel cs' e' -> Pixel cs e) -> Image arr cs' e' -> Image arr cs e Source #
Map an index aware function over each pixel in an image.
zipWith :: (Array arr cs1 e1, Array arr cs2 e2) => (Pixel cs1 e1 -> Pixel cs2 e2 -> Pixel cs e) -> Image arr cs1 e1 -> Image arr cs2 e2 -> Image arr cs e Source #
Zip two images with a function
izipWith :: (Array arr cs1 e1, Array arr cs2 e2) => ((Int, Int) -> Pixel cs1 e1 -> Pixel cs2 e2 -> Pixel cs e) -> Image arr cs1 e1 -> Image arr cs2 e2 -> Image arr cs e Source #
Zip two images with an index aware function
traverse :: Array arr cs' e' => Image arr cs' e' -> ((Int, Int) -> (Int, Int)) -> (((Int, Int) -> Pixel cs' e') -> (Int, Int) -> Pixel cs e) -> Image arr cs e Source #
Traverse an image
traverse2 :: (Array arr cs1 e1, Array arr cs2 e2) => Image arr cs1 e1 -> Image arr cs2 e2 -> ((Int, Int) -> (Int, Int) -> (Int, Int)) -> (((Int, Int) -> Pixel cs1 e1) -> ((Int, Int) -> Pixel cs2 e2) -> (Int, Int) -> Pixel cs e) -> Image arr cs e Source #
Traverse two images.
transpose :: Image arr cs e -> Image arr cs e Source #
Transpose an image
backpermute :: (Int, Int) -> ((Int, Int) -> (Int, Int)) -> Image arr cs e -> Image arr cs e Source #
Backwards permutation of an image.
fromLists :: [[Pixel cs e]] -> Image arr cs e Source #
Construct an image from a nested rectangular shaped list of pixels.
Length of an outer list will constitute m
rows, while the length of inner lists -
n
columns. All of the inner lists must be the same length and greater than 0
.
>>>
fromLists [[PixelY (fromIntegral (i*j) / 60000) | j <- [1..300]] | i <- [1..200]]
<Image VectorUnboxed Y (Double): 200x300>
(|*|) :: Image arr cs e -> Image arr cs e -> Image arr cs e Source #
Perform matrix multiplication on two images. Inner dimensions must agree.
fold :: (Pixel cs e -> Pixel cs e -> Pixel cs e) -> Pixel cs e -> Image arr cs e -> Pixel cs e Source #
Undirected reduction of an image.
foldIx :: (Pixel cs e -> (Int, Int) -> Pixel cs e -> Pixel cs e) -> Pixel cs e -> Image arr cs e -> Pixel cs e Source #
Undirected reduction of an image with an index aware function.
eq :: Eq (Pixel cs e) => Image arr cs e -> Image arr cs e -> Bool Source #
Pixelwise equality function of two images. Images are
considered distinct if either images' dimensions or at least one pair of
corresponding pixels are not the same. Used in defining an in instance for
the Eq
typeclass.
compute :: Image arr cs e -> Image arr cs e Source #
toManifest :: Image arr cs e -> Image (Manifest arr) cs e Source #
Instances
(MArray VS cs e, BaseArray VS cs e) => Array VS cs e Source # | |
(MArray VU cs e, BaseArray VU cs e) => Array VU cs e Source # | |
BaseArray RPS cs e => Array RPS cs e Source # | |
BaseArray RSS cs e => Array RSS cs e Source # | |
BaseArray RPU cs e => Array RPU cs e Source # | |
BaseArray RSU cs e => Array RSU cs e Source # | |
class BaseArray arr cs e => MArray arr cs e where Source #
Array representation that is actually has real data stored in memory, hence allowing for image indexing, forcing pixels into computed state etc.
Minimal complete definition
unsafeIndex, deepSeqImage, foldl, foldr, makeImageM, mapM, mapM_, foldM, foldM_, mdims, thaw, freeze, new, read, write, swap
Methods
unsafeIndex :: Image arr cs e -> (Int, Int) -> Pixel cs e Source #
index :: Image arr cs e -> (Int, Int) -> Pixel cs e Source #
Get a pixel at i
-th and j
-th location.
>>>
let grad_gray = makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)
>>>
index grad_gray (20, 30) == PixelY ((20*30) / (200*200))
True
deepSeqImage :: Image arr cs e -> a -> a Source #
Make sure that an image is fully evaluated.
foldl :: (a -> Pixel cs e -> a) -> a -> Image arr cs e -> a Source #
Fold an image from the left in a row major order.
foldr :: (Pixel cs e -> a -> a) -> a -> Image arr cs e -> a Source #
Fold an image from the right in a row major order.
makeImageM :: (Functor m, Monad m) => (Int, Int) -> ((Int, Int) -> m (Pixel cs e)) -> m (Image arr cs e) Source #
Create an Image by supplying it's dimensions and a monadic pixel generating action.
mapM :: (MArray arr cs' e', Functor m, Monad m) => (Pixel cs' e' -> m (Pixel cs e)) -> Image arr cs' e' -> m (Image arr cs e) Source #
Monading mapping over an image.
mapM_ :: (Functor m, Monad m) => (Pixel cs e -> m b) -> Image arr cs e -> m () Source #
Monading mapping over an image. Result is discarded.
foldM :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m a Source #
Monadic folding.
foldM_ :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m () Source #
Monadic folding. Result is discarded.
mdims :: MImage s arr cs e -> (Int, Int) Source #
Get dimensions of a mutable image.
thaw :: (Functor m, PrimMonad m) => Image arr cs e -> m (MImage (PrimState m) arr cs e) Source #
Yield a mutable copy of an image.
freeze :: (Functor m, PrimMonad m) => MImage (PrimState m) arr cs e -> m (Image arr cs e) Source #
Yield an immutable copy of an image.
new :: (Functor m, PrimMonad m) => (Int, Int) -> m (MImage (PrimState m) arr cs e) Source #
Create a mutable image with given dimensions. Pixels are likely uninitialized.
read :: (Functor m, PrimMonad m) => MImage (PrimState m) arr cs e -> (Int, Int) -> m (Pixel cs e) Source #
Yield the pixel at a given location.
write :: (Functor m, PrimMonad m) => MImage (PrimState m) arr cs e -> (Int, Int) -> Pixel cs e -> m () Source #
Set a pixel at a given location.
swap :: (Functor m, PrimMonad m) => MImage (PrimState m) arr cs e -> (Int, Int) -> (Int, Int) -> m () Source #
Swap pixels at given locations.
class Exchangable arr' arr where Source #
Allows for changing an underlying image representation.
Minimal complete definition
Methods
exchange :: (Array arr' cs e, Array arr cs e) => arr -> Image arr' cs e -> Image arr cs e Source #
Exchange the underlying array representation of an image.
Instances
Exchangable arr arr Source # | Changing to the same array representation as before is disabled and |
Exchangable VS RPS Source # | O(1) - Changes to Repa representation. |
Exchangable VS RSS Source # | O(1) - Changes to Repa representation. |
Exchangable VU RPU Source # | O(1) - Changes to Repa representation. |
Exchangable VU RSU Source # | O(1) - Changes to Repa representation. |
Exchangable RPS VS Source # | Changes to Vector representation. |
Exchangable RPS RSS Source # | Changes computation strategy. Will casue all fused operations to be computed. |
Exchangable RSS VS Source # | Changes to Vector representation. |
Exchangable RSS RPS Source # | Changes computation strategy. Will casue all fused operations to be computed. |
Exchangable RPU VU Source # | Changes to Vector representation. |
Exchangable RPU RSU Source # | Changes computation strategy. Will casue all fused operations to be computed. |
Exchangable RSU VU Source # | Changes to Vector representation. |
Exchangable RSU RPU Source # | Changes computation strategy. Will casue all fused operations to be computed. |
Arguments
:: (Exchangable arr' arr, Array arr' cs e, Array arr cs e) | |
=> arr' | |
-> arr | New representation of an image. |
-> Image arr' cs e | Source image. |
-> Image arr cs e |
exchange
function that allows restricting representation type of the
source image.
Arguments
:: (Exchangable arr2 arr1, Exchangable arr1 arr, Array arr2 cs e, Array arr1 cs e, Array arr cs e) | |
=> arr1 | |
-> arr | New representation of an image. |
-> Image arr2 cs e | Source image. |
-> Image arr cs e |
exchange
an image representation through an intermediate one.
defaultIndex :: MArray arr cs e => Pixel cs e -> Image arr cs e -> (Int, Int) -> Pixel cs e Source #
Image indexing function that returns a default pixel if index is out of bounds.
borderIndex :: MArray arr cs e => Border (Pixel cs e) -> Image arr cs e -> (Int, Int) -> Pixel cs e Source #
Image indexing function that uses a special border resolutions strategy for out of bounds pixels.
Approach to be used near the borders during various transformations. Whenever a function needs information not only about a pixel of interest, but also about it's neighbours, it will go out of bounds around the image edges, hence is this set of approaches that can be used in such situtation.
Constructors
Fill !px | Fill in a constant pixel. outside | Image | outside
( |
Wrap | Wrap around from the opposite border of the image. outside | Image | outside
|
Edge | Replicate the pixel at the edge. outside | Image | outside
|
Reflect | Mirror like reflection. outside | Image | outside
|
Continue | Also mirror like reflection, but without repeating the edge pixel. outside | Image | outside
|
Arguments
:: Border px | Border handling strategy. |
-> (Int, Int) | Image dimensions |
-> ((Int, Int) -> px) | Image's indexing function. |
-> (Int, Int) |
|
-> px |
Border handling function. If (i, j)
location is within bounds, then supplied
lookup function will be used, otherwise it will be handled according to a
supplied border strategy.
2D to a flat vector index conversion.
Note: There is an implicit assumption that j < n
Flat vector to 2D index conversion.