Copyright | (c) Alexey Kuleshevich 2016 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <lehins@yandex.ru> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
- class (Eq cs, Enum cs, Show cs, Typeable cs) => ColorSpace cs where
- data Pixel cs e
- class (ColorSpace (Opaque cs), ColorSpace cs) => Alpha cs where
- type Opaque cs
- class Elevator e where
- toWord8 :: ColorSpace cs => Pixel cs e -> Pixel cs Word8
- toWord16 :: ColorSpace cs => Pixel cs e -> Pixel cs Word16
- toWord32 :: ColorSpace cs => Pixel cs e -> Pixel cs Word32
- toWord64 :: ColorSpace cs => Pixel cs e -> Pixel cs Word64
- toFloat :: ColorSpace cs => Pixel cs e -> Pixel cs Float
- toDouble :: ColorSpace cs => Pixel cs e -> Pixel cs Double
- fromDouble :: ColorSpace cs => Pixel cs Double -> Pixel cs e
- data Y = Y
- data YA
- class ColorSpace cs => ToY cs where
- class (ToY (Opaque cs), Alpha cs) => ToYA cs where
- data RGB
- data RGBA
- class ColorSpace cs => ToRGB cs where
- class (ToRGB (Opaque cs), Alpha cs) => ToRGBA cs where
- data HSI
- data HSIA
- class ColorSpace cs => ToHSI cs where
- class (ToHSI (Opaque cs), Alpha cs) => ToHSIA cs where
- data CMYK
- data CMYKA
- class ColorSpace cs => ToCMYK cs where
- class (ToCMYK (Opaque cs), Alpha cs) => ToCMYKA cs where
- data YCbCr
- data YCbCrA
- class ColorSpace cs => ToYCbCr cs where
- class (ToYCbCr (Opaque cs), Alpha cs) => ToYCbCrA cs where
- data Gray = Gray
- toGrayImages :: (Array arr cs e, Array arr Gray e) => Image arr cs e -> [Image arr Gray e]
- fromGrayImages :: forall arr cs e. (Array arr Gray e, Array arr cs e) => [Image arr Gray e] -> [cs] -> Image arr cs e
- data Binary
- data Bit
- on :: Pixel Binary Bit
- off :: Pixel Binary Bit
- isOn :: Pixel Binary Bit -> Bool
- isOff :: Pixel Binary Bit -> Bool
- fromBool :: Bool -> Pixel Binary Bit
- complement :: Pixel Binary Bit -> Pixel Binary Bit
- toPixelBinary :: (ColorSpace cs, Eq (Pixel cs e), Num e) => Pixel cs e -> Pixel Binary Bit
- fromPixelBinary :: Pixel Binary Bit -> Pixel Y Word8
- toImageBinary :: (Array arr cs e, Array arr Binary Bit, Eq (Pixel cs e)) => Image arr cs e -> Image arr Binary Bit
- fromImageBinary :: (Array arr Binary Bit, Array arr Y Word8) => Image arr Binary Bit -> Image arr Y Word8
- data Complex a :: * -> * = !a :+ !a
- (+:) :: ColorSpace cs => Pixel cs e -> Pixel cs e -> Pixel cs (Complex e)
- realPart :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
- imagPart :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
- mkPolar :: (ColorSpace cs, RealFloat e) => Pixel cs e -> Pixel cs e -> Pixel cs (Complex e)
- cis :: (ColorSpace cs, RealFloat e) => Pixel cs e -> Pixel cs (Complex e)
- polar :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> (Pixel cs e, Pixel cs e)
- magnitude :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
- phase :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
- conjugate :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs (Complex e)
- data Word8 :: *
- data Word16 :: *
- data Word32 :: *
- data Word64 :: *
ColorSpace
class (Eq cs, Enum cs, Show cs, Typeable cs) => ColorSpace cs Source
This class has all included color spaces installed into it and is also
intended for implementing any other possible custom color spaces. Every
instance of this class automatically installs an associated Pixel
into
Num
, Fractional
, Floating
, Functor
, Applicative
and Foldable
,
which in turn make it possible to be used by the rest of the library.
class (ColorSpace (Opaque cs), ColorSpace cs) => Alpha cs Source
A color space that supports transparency.
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)>
toWord8 :: ColorSpace cs => Pixel cs e -> Pixel cs Word8 Source
toWord16 :: ColorSpace cs => Pixel cs e -> Pixel cs Word16 Source
toWord32 :: ColorSpace cs => Pixel cs e -> Pixel cs Word32 Source
toWord64 :: ColorSpace cs => Pixel cs e -> Pixel cs Word64 Source
toFloat :: ColorSpace cs => Pixel cs e -> Pixel cs Float Source
toDouble :: ColorSpace cs => Pixel cs e -> Pixel cs Double Source
fromDouble :: ColorSpace cs => Pixel cs Double -> Pixel cs e Source
Luma
Luma or brightness, that is usually denoted as Y'
.
Luma with Alpha channel.
class ColorSpace cs => ToY cs where Source
Conversion to Luma color space.
class (ToY (Opaque cs), Alpha cs) => ToYA cs where Source
Conversion to Luma from another color space with Alpha channel.
Nothing
RGB
Red, Green and Blue color space.
Red, Green and Blue color space with Alpha channel.
class ColorSpace cs => ToRGB cs where Source
Conversion to RGB
color space.
class (ToRGB (Opaque cs), Alpha cs) => ToRGBA cs where Source
Conversion to RGBA
from another color space with Alpha channel.
Nothing
HSI
Hue, Saturation and Intensity color space.
Hue, Saturation and Intensity color space with Alpha channel.
class ColorSpace cs => ToHSI cs where Source
Conversion to HSI
color space.
class (ToHSI (Opaque cs), Alpha cs) => ToHSIA cs where Source
Conversion to HSIA
from another color space with Alpha channel.
Nothing
CMYK
Cyan, Magenta, Yellow and Black color space.
Enum CMYK Source | |
Eq CMYK Source | |
Show CMYK Source | |
ColorSpace CMYK Source | |
Eq e => Eq (Pixel CMYK e) Source | |
Show e => Show (Pixel CMYK e) Source | |
ManifestArray arr CMYK Double => Writable (Image arr CMYK Double) TIF Source | |
ManifestArray arr CMYK Word16 => Writable (Image arr CMYK Word16) TIF Source | |
ManifestArray arr CMYK Word8 => Writable (Image arr CMYK Word8) TIF Source | |
ManifestArray arr CMYK Double => Writable (Image arr CMYK Double) JPG Source | |
ManifestArray arr CMYK Word8 => Writable (Image arr CMYK Word8) JPG Source | |
Array arr CMYK Word16 => Readable (Image arr CMYK Word16) TIF Source | |
Array arr CMYK Word8 => Readable (Image arr CMYK Word8) TIF Source | |
Array arr CMYK Word8 => Readable (Image arr CMYK Word8) JPG Source | |
data Pixel CMYK = PixelCMYK !e !e !e !e Source | |
type PixelElt CMYK e = (e, e, e, e) Source |
Cyan, Magenta, Yellow and Black color space with Alpha channel.
CyanCMYKA | Cyan |
MagCMYKA | Magenta |
YelCMYKA | Yellow |
KeyCMYKA | Key (Black) |
AlphaCMYKA | Alpha |
class ColorSpace cs => ToCMYK cs where Source
Conversion to CMYK
color space.
class (ToCMYK (Opaque cs), Alpha cs) => ToCMYKA cs where Source
Conversion to CMYKA
from another color space with Alpha channel.
Nothing
YCbCr
Color space is used to encode RGB information and is used in JPEG compression.
LumaYCbCr | Luma component (commonly denoted as Y') |
CBlueYCbCr | Blue difference chroma component |
CRedYCbCr | Red difference chroma component |
Enum YCbCr Source | |
Eq YCbCr Source | |
Show YCbCr Source | |
ColorSpace YCbCr Source | |
Eq e => Eq (Pixel YCbCr e) Source | |
Show e => Show (Pixel YCbCr e) Source | |
ManifestArray arr YCbCr Double => Writable (Image arr YCbCr Double) TIF Source | |
ManifestArray arr YCbCr Word8 => Writable (Image arr YCbCr Word8) TIF Source | |
ManifestArray arr YCbCr Double => Writable (Image arr YCbCr Double) JPG Source | |
ManifestArray arr YCbCr Word8 => Writable (Image arr YCbCr Word8) JPG Source | |
Array arr YCbCr Word8 => Readable (Image arr YCbCr Word8) JPG Source | |
data Pixel YCbCr = PixelYCbCr !e !e !e Source | |
type PixelElt YCbCr e = (e, e, e) Source |
YCbCr color space with Alpha channel.
LumaYCbCrA | Luma component (commonly denoted as Y') |
CBlueYCbCrA | Blue difference chroma component |
CRedYCbCrA | Red difference chroma component |
AlphaYCbCrA | Alpha component. |
Enum YCbCrA Source | |
Eq YCbCrA Source | |
Show YCbCrA Source | |
Alpha YCbCrA Source | |
ColorSpace YCbCrA Source | |
Eq e => Eq (Pixel YCbCrA e) Source | |
Show e => Show (Pixel YCbCrA e) Source | |
type Opaque YCbCrA = YCbCr Source | |
data Pixel YCbCrA = PixelYCbCrA !e !e !e !e Source | |
type PixelElt YCbCrA e = (e, e, e, e) Source |
class ColorSpace cs => ToYCbCr cs where Source
Conversion to YCbCr
color space.
class (ToYCbCr (Opaque cs), Alpha cs) => ToYCbCrA cs where Source
Conversion to YCbCrA
from another color space with Alpha channel.
Nothing
Gray
This is a signgle channel colorspace, that is designed to hold any channel
from any other colorspace, hence it is not convertible to and from, but
rather is here to allow separation of channels from other multichannel
colorspaces. If you are looking for a true grayscale colorspace
Y
should be used instead.
toGrayImages :: (Array arr cs e, Array arr Gray e) => Image arr cs e -> [Image arr Gray e] Source
Separate an image into a list of images with Gray
pixels containing every
channel from the source image.
>>>
frog <- readImageRGB "images/frog.jpg"
>>>
let [frog_red, frog_green, frog_blue] = toGrayImages frog
>>>
writeImage "images/frog_red.png" $ toImageY frog_red
>>>
writeImage "images/frog_green.jpg" $ toImageY frog_green
>>>
writeImage "images/frog_blue.jpg" $ toImageY frog_blue
fromGrayImages :: forall arr cs e. (Array arr Gray e, Array arr cs e) => [Image arr Gray e] -> [cs] -> Image arr cs e Source
Combine a list of images with Gray
pixels into an image of any color
space, by supplying an order of color space channels.
For example here is a frog with swapped BlueRGB
and GreenRGB
channels.
>>>
writeImage "images/frog_rbg.jpg" $ fromGrayImages [frog_red, frog_green, frog_blue] [RedRGB, BlueRGB, GreenRGB]
It is worth noting though, that separating image channels can be sometimes pretty useful, the same effect as above can be achieved in a much simpler and more efficient way:
map ((PixelRGB r g b) -> PixelRGB r b g) frog
Binary
This is a Binary colorspace, pixel's of which can be created using these constructors:
on
- Represents value
1
orTrue
. It's a foreground pixel and is displayed in black. off
- Represents value
0
orFalse
. It's a background pixel and is displayed in white.
Note, that values are inverted before writing to or reading from file, since
grayscale images represent black as a 0
value and white as 1
on a
[0,1]
scale.
Binary pixels also behave as binary numbers with a size of 1-bit, for instance:
>>>
on + on -- equivalent to: 1 .|. 1
<Binary:(1)>>>>
(on + on) * off -- equivalent to: (1 .|. 1) .&. 0
<Binary:(0)>>>>
(on + on) - on
<Binary:(0)>
Under the hood, Binary pixels are represented as Word8
that can only take
values of 0
or 1
.
Eq Bit Source | |
Num Bit Source | |
Ord Bit Source | |
Array arr Binary Bit => Readable [Image arr Binary Bit] [PBM] Source | |
Show (Pixel Binary Bit) Source | |
ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) TIF Source | |
ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) TGA Source | |
ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) PNG Source | |
ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) BMP Source | |
(Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) TIF Source | |
(Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) TGA Source | |
(Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) PNG Source | |
(Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) BMP Source | |
Array arr Binary Bit => Readable (Image arr Binary Bit) PBM Source | |
data Vector Bit = V_Bit (Vector Word8) | |
data MVector s Bit = MV_Bit (MVector s Word8) |
Represents value True
or 1
in binary. Often also called a foreground
pixel of an object.
off :: Pixel Binary Bit Source
Represents value False
or 0
in binary. Often also called a background
pixel.
fromBool :: Bool -> Pixel Binary Bit Source
Convert a Bool
to a PixelBin
pixel.
>>>
isOn (fromBool True)
True
complement :: Pixel Binary Bit -> Pixel Binary Bit Source
Invert value of a pixel. Equivalent of not
for Bool's.
toPixelBinary :: (ColorSpace cs, Eq (Pixel cs e), Num e) => Pixel cs e -> Pixel Binary Bit Source
Convert any pixel to binary pixel.
toImageBinary :: (Array arr cs e, Array arr Binary Bit, Eq (Pixel cs e)) => Image arr cs e -> Image arr Binary Bit Source
Convert any image to binary image.
fromImageBinary :: (Array arr Binary Bit, Array arr Y Word8) => Image arr Binary Bit -> Image arr Y Word8 Source
Convert a Binary image to Luma image
Complex
Rectangular form
data Complex a :: * -> *
Complex numbers are an algebraic type.
For a complex number z
,
is a number with the magnitude of abs
zz
,
but oriented in the positive real direction, whereas
has the phase of signum
zz
, but unit magnitude.
!a :+ !a infix 6 | forms a complex number from its real and imaginary rectangular components. |
Representable Complex | |
(RealFloat a, Unbox a) => Vector Vector (Complex a) | |
(RealFloat a, Unbox a) => MVector MVector (Complex a) | |
Eq a => Eq (Complex a) | |
RealFloat a => Floating (Complex a) | |
RealFloat a => Fractional (Complex a) | |
Data a => Data (Complex a) | |
RealFloat a => Num (Complex a) | |
Read a => Read (Complex a) | |
Show a => Show (Complex a) | |
Storable a => Storable (Complex a) | |
NFData a => NFData (Complex a) | |
(RealFloat a, Unbox a) => Unbox (Complex a) | |
type Rep Complex = Bool | |
data MVector s (Complex a) = MV_Complex (MVector s (a, a)) | |
type Index (Complex a) = Int | |
data Vector (Complex a) = V_Complex (Vector (a, a)) |
realPart :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e Source
Extracts the real part of a complex pixel.
imagPart :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e Source
Extracts the imaginary part of a complex pixel.
Polar form
mkPolar :: (ColorSpace cs, RealFloat e) => Pixel cs e -> Pixel cs e -> Pixel cs (Complex e) Source
Form a complex pixel from polar components of magnitude and phase.
magnitude :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e Source
The nonnegative magnitude of a complex pixel.
Conjugate
conjugate :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs (Complex e) Source
The conjugate of a complex pixel.
Re-exports
data Word8 :: *
8-bit unsigned integer type
data Word16 :: *
16-bit unsigned integer type
data Word32 :: *
32-bit unsigned integer type
Bounded Word32 | |
Enum Word32 | |
Eq Word32 | |
Integral Word32 | |
Num Word32 | |
Ord Word32 | |
Read Word32 | |
Real Word32 | |
Show Word32 | |
Ix Word32 | |
Unpackable Word32 | |
Pixel Pixel32 | |
LumaPlaneExtractable Pixel32 | |
PackeablePixel Pixel32 | |
Storable Word32 | |
Bits Word32 | |
FiniteBits Word32 | |
NFData Word32 | |
Hashable Word32 | |
Prim Word32 | |
Unbox Word32 | |
Elt Word32 | |
Lift Word32 | |
IArray UArray Word32 | |
Vector Vector Word32 | |
MVector MVector Word32 | |
MArray (STUArray s) Word32 (ST s) | |
type StorageType Word32 = Word32 | |
type PixelBaseComponent Pixel32 = Word32 | |
type PackedRepresentation Pixel32 = Pixel32 | |
data Vector Word32 = V_Word32 (Vector Word32) | |
data MVector s Word32 = MV_Word32 (MVector s Word32) |
data Word64 :: *
64-bit unsigned integer type
Bounded Word64 | |
Enum Word64 | |
Eq Word64 | |
Integral Word64 | |
Num Word64 | |
Ord Word64 | |
Read Word64 | |
Real Word64 | |
Show Word64 | |
Ix Word64 | |
Storable Word64 | |
Bits Word64 | |
FiniteBits Word64 | |
NFData Word64 | |
Hashable Word64 | |
Prim Word64 | |
Unbox Word64 | |
Elt Word64 | |
Lift Word64 | |
IArray UArray Word64 | |
Vector Vector Word64 | |
MVector MVector Word64 | |
MArray (STUArray s) Word64 (ST s) | |
data Vector Word64 = V_Word64 (Vector Word64) | |
data MVector s Word64 = MV_Word64 (MVector s Word64) |