{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
module Codec.Picture (
readImage
, readImageWithMetadata
, decodeImage
, decodeImageWithMetadata
, decodeImageWithPaletteAndMetadata
, pixelMap
, dynamicMap
, dynamicPixelMap
, generateImage
, generateFoldImage
, withImage
, palettedToTrueColor
, convertRGB8
, convertRGB16
, convertRGBA8
, Traversal
, imagePixels
, imageIPixels
, saveBmpImage
, saveJpgImage
, saveGifImage
, savePngImage
, saveTiffImage
, saveRadianceImage
, BmpEncodable
, writeBitmap
, encodeBitmap
, readBitmap
, decodeBitmap
, encodeDynamicBitmap
, writeDynamicBitmap
, readGif
, readGifImages
, decodeGif
, decodeGifImages
, encodeGifImage
, writeGifImage
, encodeGifImageWithPalette
, writeGifImageWithPalette
, encodeColorReducedGifImage
, writeColorReducedGifImage
, encodeGifImages
, writeGifImages
, GifDelay
, GifLooping( .. )
, encodeGifAnimation
, writeGifAnimation
, readJpeg
, decodeJpeg
, encodeJpeg
, encodeJpegAtQuality
, PngSavable( .. )
, readPng
, decodePng
, writePng
, encodePalettedPng
, encodeDynamicPng
, writeDynamicPng
, readTGA
, decodeTga
, TgaSaveable
, encodeTga
, writeTga
, readTiff
, TiffSaveable
, decodeTiff
, encodeTiff
, writeTiff
, readHDR
, decodeHDR
, encodeHDR
, writeHDR
, PaletteCreationMethod(..)
, PaletteOptions(..)
, palettize
, Image( .. )
, DynamicImage( .. )
, Palette
, Pixel( .. )
, Pixel8
, Pixel16
, Pixel32
, PixelF
, PixelYA8( .. )
, PixelYA16( .. )
, PixelRGB8( .. )
, PixelRGB16( .. )
, PixelRGBF( .. )
, PixelRGBA8( .. )
, PixelRGBA16( .. )
, PixelYCbCr8( .. )
, PixelCMYK8( .. )
, PixelCMYK16( .. )
, imageFromUnsafePtr
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( (<$>) )
#endif
import Control.Arrow( first )
import Data.Bits( unsafeShiftR )
import Control.DeepSeq( NFData, deepseq )
import qualified Control.Exception as Exc ( catch, IOException )
import Codec.Picture.Metadata( Metadatas )
import Codec.Picture.Bitmap( BmpEncodable
, decodeBitmap
, decodeBitmapWithPaletteAndMetadata
, writeBitmap, encodeBitmap
, encodeDynamicBitmap, writeDynamicBitmap )
import Codec.Picture.Jpg( decodeJpeg
, decodeJpegWithMetadata
, encodeJpeg
, encodeJpegAtQuality )
import Codec.Picture.Png( PngSavable( .. )
, decodePng
, decodePngWithPaletteAndMetadata
, writePng
, encodeDynamicPng
, encodePalettedPng
, writeDynamicPng
)
import Codec.Picture.Gif( GifDelay
, GifLooping( .. )
, decodeGif
, decodeGifWithPaletteAndMetadata
, decodeGifImages
, encodeGifImage
, encodeGifImageWithPalette
, encodeGifImages
, writeGifImage
, writeGifImageWithPalette
, writeGifImages
)
import Codec.Picture.HDR( decodeHDR
, decodeHDRWithMetadata
, encodeHDR
, writeHDR
)
import Codec.Picture.Tiff( decodeTiff
, decodeTiffWithPaletteAndMetadata
, TiffSaveable
, encodeTiff
, writeTiff )
import Codec.Picture.Tga( TgaSaveable
, decodeTga
, decodeTgaWithPaletteAndMetadata
, encodeTga
, writeTga
)
import Codec.Picture.Saving
import Codec.Picture.Types
import Codec.Picture.ColorQuant
import Codec.Picture.VectorByteConversion( imageFromUnsafePtr )
#ifdef WITH_MMAP_BYTESTRING
import System.IO.MMap ( mmapFileByteString )
#endif
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Vector.Storable as VS
eitherLoad :: c -> [(String, c -> Either String b)] -> Either String b
eitherLoad :: forall c b.
c -> [(String, c -> Either String b)] -> Either String b
eitherLoad c
v = String -> [(String, c -> Either String b)] -> Either String b
inner String
""
where inner :: String -> [(String, c -> Either String b)] -> Either String b
inner String
errAcc [] = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Cannot load file\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errAcc
inner String
errAcc ((String
hdr, c -> Either String b
f) : [(String, c -> Either String b)]
rest) = case c -> Either String b
f c
v of
Left String
err -> String -> [(String, c -> Either String b)] -> Either String b
inner (String
errAcc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hdr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") [(String, c -> Either String b)]
rest
Right b
rez -> b -> Either String b
forall a b. b -> Either a b
Right b
rez
encodeColorReducedGifImage :: Image PixelRGB8 -> Either String L.ByteString
encodeColorReducedGifImage :: Image PixelRGB8 -> Either String ByteString
encodeColorReducedGifImage Image PixelRGB8
img = Image Pixel8 -> Image PixelRGB8 -> Either String ByteString
encodeGifImageWithPalette Image Pixel8
indexed Image PixelRGB8
pal
where (Image Pixel8
indexed, Image PixelRGB8
pal) = PaletteOptions
-> Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8)
palettize PaletteOptions
defaultPaletteOptions Image PixelRGB8
img
writeColorReducedGifImage :: FilePath -> Image PixelRGB8 -> Either String (IO ())
writeColorReducedGifImage :: String -> Image PixelRGB8 -> Either String (IO ())
writeColorReducedGifImage String
path Image PixelRGB8
img =
String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> Either String ByteString -> Either String (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image PixelRGB8 -> Either String ByteString
encodeColorReducedGifImage Image PixelRGB8
img
encodeGifAnimation :: GifDelay -> GifLooping
-> [Image PixelRGB8] -> Either String L.ByteString
encodeGifAnimation :: GifDelay
-> GifLooping -> [Image PixelRGB8] -> Either String ByteString
encodeGifAnimation GifDelay
delay GifLooping
looping [Image PixelRGB8]
lst =
GifLooping
-> [(Image PixelRGB8, GifDelay, Image Pixel8)]
-> Either String ByteString
encodeGifImages GifLooping
looping
[(Image PixelRGB8
pal, GifDelay
delay, Image Pixel8
img)
| (Image Pixel8
img, Image PixelRGB8
pal) <- PaletteOptions
-> Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8)
palettize PaletteOptions
defaultPaletteOptions (Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8))
-> [Image PixelRGB8] -> [(Image Pixel8, Image PixelRGB8)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image PixelRGB8]
lst]
writeGifAnimation :: FilePath -> GifDelay -> GifLooping
-> [Image PixelRGB8] -> Either String (IO ())
writeGifAnimation :: String
-> GifDelay
-> GifLooping
-> [Image PixelRGB8]
-> Either String (IO ())
writeGifAnimation String
path GifDelay
delay GifLooping
looping [Image PixelRGB8]
img =
String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> Either String ByteString -> Either String (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GifDelay
-> GifLooping -> [Image PixelRGB8] -> Either String ByteString
encodeGifAnimation GifDelay
delay GifLooping
looping [Image PixelRGB8]
img
withImageDecoder :: (NFData a)
=> (B.ByteString -> Either String a) -> FilePath
-> IO (Either String a)
withImageDecoder :: forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String a
decoder String
path = IO (Either String a)
-> (IOException -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exc.catch IO (Either String a)
doit
(\IOException
e -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> (String -> Either String a) -> String -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left (String -> IO (Either String a)) -> String -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show (IOException
e :: Exc.IOException))
where doit :: IO (Either String a)
doit = Either String a -> Either String a
forall {b}. NFData b => b -> b
force (Either String a -> Either String a)
-> (ByteString -> Either String a) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
decoder (ByteString -> Either String a)
-> IO ByteString -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
get
#ifdef WITH_MMAP_BYTESTRING
get = mmapFileByteString path Nothing
#else
get :: IO ByteString
get = String -> IO ByteString
B.readFile String
path
#endif
force :: b -> b
force b
x = b
x b -> b -> b
forall a b. NFData a => a -> b -> b
`deepseq` b
x
readImage :: FilePath -> IO (Either String DynamicImage)
readImage :: String -> IO (Either String DynamicImage)
readImage = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeImage
readImageWithMetadata :: FilePath -> IO (Either String (DynamicImage, Metadatas))
readImageWithMetadata :: String -> IO (Either String (DynamicImage, Metadatas))
readImageWithMetadata = (ByteString -> Either String (DynamicImage, Metadatas))
-> String -> IO (Either String (DynamicImage, Metadatas))
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata
decodeImage :: B.ByteString -> Either String DynamicImage
decodeImage :: ByteString -> Either String DynamicImage
decodeImage = ((DynamicImage, Metadatas) -> DynamicImage)
-> Either String (DynamicImage, Metadatas)
-> Either String DynamicImage
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynamicImage, Metadatas) -> DynamicImage
forall a b. (a, b) -> a
fst (Either String (DynamicImage, Metadatas)
-> Either String DynamicImage)
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata
class Decimable px1 px2 where
decimateBitDepth :: Image px1 -> Image px2
decimateWord16 :: ( Pixel px1, Pixel px2
, PixelBaseComponent px1 ~ Pixel16
, PixelBaseComponent px2 ~ Pixel8
) => Image px1 -> Image px2
decimateWord16 :: forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (Pixel16 -> Pixel8) -> Vector Pixel16 -> Vector Pixel8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (\Pixel16
v -> Pixel16 -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel16 -> Pixel8) -> Pixel16 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel16
v Pixel16 -> GifDelay -> Pixel16
forall a. Bits a => a -> GifDelay -> a
`unsafeShiftR` GifDelay
8) Vector Pixel16
Vector (PixelBaseComponent px1)
da
decimateWord3216 :: ( Pixel px1, Pixel px2
, PixelBaseComponent px1 ~ Pixel32
, PixelBaseComponent px2 ~ Pixel16
) => Image px1 -> Image px2
decimateWord3216 :: forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel32,
PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateWord3216 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (Pixel32 -> Pixel16) -> Vector Pixel32 -> Vector Pixel16
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (\Pixel32
v -> Pixel32 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel32 -> Pixel16) -> Pixel32 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Pixel32
v Pixel32 -> GifDelay -> Pixel32
forall a. Bits a => a -> GifDelay -> a
`unsafeShiftR` GifDelay
16) Vector Pixel32
Vector (PixelBaseComponent px1)
da
decimateWord32 :: ( Pixel px1, Pixel px2
, PixelBaseComponent px1 ~ Pixel32
, PixelBaseComponent px2 ~ Pixel8
) => Image px1 -> Image px2
decimateWord32 :: forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel32,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord32 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (Pixel32 -> Pixel8) -> Vector Pixel32 -> Vector Pixel8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (\Pixel32
v -> Pixel32 -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
v Pixel32 -> GifDelay -> Pixel32
forall a. Bits a => a -> GifDelay -> a
`unsafeShiftR` GifDelay
24) Vector Pixel32
Vector (PixelBaseComponent px1)
da
decimateFloat :: ( Pixel px1, Pixel px2
, PixelBaseComponent px1 ~ PixelF
, PixelBaseComponent px2 ~ Pixel8
) => Image px1 -> Image px2
decimateFloat :: forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateFloat (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (PixelF -> Pixel8) -> Vector PixelF -> Vector Pixel8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (PixelF -> Pixel8
forall b. Integral b => PixelF -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Pixel8) -> (PixelF -> PixelF) -> PixelF -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelF
255PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
*) (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
0 (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
min PixelF
1) Vector PixelF
Vector (PixelBaseComponent px1)
da
decimateFloat16 :: ( Pixel px1, Pixel px2
, PixelBaseComponent px1 ~ PixelF
, PixelBaseComponent px2 ~ Pixel16
) => Image px1 -> Image px2
decimateFloat16 :: forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateFloat16 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (PixelF -> Pixel16) -> Vector PixelF -> Vector Pixel16
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (PixelF -> Pixel16
forall b. Integral b => PixelF -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Pixel16) -> (PixelF -> PixelF) -> PixelF -> Pixel16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelF
65535PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
*) (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
0 (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
min PixelF
1) Vector PixelF
Vector (PixelBaseComponent px1)
da
instance Decimable Pixel16 Pixel8 where
decimateBitDepth :: Image Pixel16 -> Image Pixel8
decimateBitDepth = Image Pixel16 -> Image Pixel8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16
instance Decimable Pixel32 Pixel16 where
decimateBitDepth :: Image Pixel32 -> Image Pixel16
decimateBitDepth = Image Pixel32 -> Image Pixel16
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel32,
PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateWord3216
instance Decimable Pixel32 Pixel8 where
decimateBitDepth :: Image Pixel32 -> Image Pixel8
decimateBitDepth = Image Pixel32 -> Image Pixel8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel32,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord32
instance Decimable PixelYA16 PixelYA8 where
decimateBitDepth :: Image PixelYA16 -> Image PixelYA8
decimateBitDepth = Image PixelYA16 -> Image PixelYA8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16
instance Decimable PixelRGB16 PixelRGB8 where
decimateBitDepth :: Image PixelRGB16 -> Image PixelRGB8
decimateBitDepth = Image PixelRGB16 -> Image PixelRGB8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16
instance Decimable PixelRGBA16 PixelRGBA8 where
decimateBitDepth :: Image PixelRGBA16 -> Image PixelRGBA8
decimateBitDepth = Image PixelRGBA16 -> Image PixelRGBA8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16
instance Decimable PixelCMYK16 PixelCMYK8 where
decimateBitDepth :: Image PixelCMYK16 -> Image PixelCMYK8
decimateBitDepth = Image PixelCMYK16 -> Image PixelCMYK8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16
instance Decimable PixelF Pixel8 where
decimateBitDepth :: Image PixelF -> Image Pixel8
decimateBitDepth = Image PixelF -> Image Pixel8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateFloat
instance Decimable PixelF Pixel16 where
decimateBitDepth :: Image PixelF -> Image Pixel16
decimateBitDepth = Image PixelF -> Image Pixel16
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateFloat16
instance Decimable PixelRGBF PixelRGB8 where
decimateBitDepth :: Image PixelRGBF -> Image PixelRGB8
decimateBitDepth = Image PixelRGBF -> Image PixelRGB8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateFloat
instance Decimable PixelRGBF PixelRGB16 where
decimateBitDepth :: Image PixelRGBF -> Image PixelRGB16
decimateBitDepth = Image PixelRGBF -> Image PixelRGB16
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateFloat16
convertRGBA8 :: DynamicImage -> Image PixelRGBA8
convertRGBA8 :: DynamicImage -> Image PixelRGBA8
convertRGBA8 DynamicImage
dynImage = case DynamicImage
dynImage of
ImageY8 Image Pixel8
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
img
ImageY16 Image Pixel16
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel16 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel16
img :: Image Pixel8)
ImageY32 Image Pixel32
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel32 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel32
img :: Image Pixel8)
ImageYF Image PixelF
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelF
img :: Image Pixel8)
ImageYA8 Image PixelYA8
img -> Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img
ImageYA16 Image PixelYA16
img -> Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYA16 -> Image PixelYA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelYA16
img :: Image PixelYA8)
ImageRGB8 Image PixelRGB8
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
img
ImageRGB16 Image PixelRGB16
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelRGB16 -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGB16
img :: Image PixelRGB8)
ImageRGBF Image PixelRGBF
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelRGBF -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBF
img :: Image PixelRGB8)
ImageRGBA8 Image PixelRGBA8
img -> Image PixelRGBA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGBA8
img
ImageRGBA16 Image PixelRGBA16
img -> Image PixelRGBA16 -> Image PixelRGBA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBA16
img
ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
ImageCMYK8 Image PixelCMYK8
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
ImageCMYK16 Image PixelCMYK16
img ->
Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage (Image PixelCMYK16 -> Image PixelCMYK8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelCMYK16
img :: Image PixelCMYK8) :: Image PixelRGB8)
convertRGB8 :: DynamicImage -> Image PixelRGB8
convertRGB8 :: DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
dynImage = case DynamicImage
dynImage of
ImageY8 Image Pixel8
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
img
ImageY16 Image Pixel16
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel16 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel16
img :: Image Pixel8)
ImageY32 Image Pixel32
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel32 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel32
img :: Image Pixel8)
ImageYF Image PixelF
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelF
img :: Image Pixel8)
ImageYA8 Image PixelYA8
img -> Image PixelYA8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img
ImageYA16 Image PixelYA16
img -> Image PixelYA8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYA16 -> Image PixelYA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelYA16
img :: Image PixelYA8)
ImageRGB8 Image PixelRGB8
img -> Image PixelRGB8
img
ImageRGB16 Image PixelRGB16
img -> Image PixelRGB16 -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGB16
img
ImageRGBF Image PixelRGBF
img -> Image PixelRGBF -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBF
img :: Image PixelRGB8
ImageRGBA8 Image PixelRGBA8
img -> Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA8
img
ImageRGBA16 Image PixelRGBA16
img -> Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer (Image PixelRGBA16 -> Image PixelRGBA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBA16
img :: Image PixelRGBA8)
ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img
ImageCMYK8 Image PixelCMYK8
img -> Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img
ImageCMYK16 Image PixelCMYK16
img -> Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage (Image PixelCMYK16 -> Image PixelCMYK8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelCMYK16
img :: Image PixelCMYK8)
convertRGB16 :: DynamicImage -> Image PixelRGB16
convertRGB16 :: DynamicImage -> Image PixelRGB16
convertRGB16 DynamicImage
dynImage = case DynamicImage
dynImage of
ImageY8 Image Pixel8
img -> Image Pixel8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
img
ImageY16 Image Pixel16
img -> Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel16
img
ImageY32 Image Pixel32
img -> Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel32 -> Image Pixel16
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel32
img :: Image Pixel16)
ImageYF Image PixelF
img -> Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> Image Pixel16
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelF
img :: Image Pixel16)
ImageYA8 Image PixelYA8
img -> Image PixelYA8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img
ImageYA16 Image PixelYA16
img -> Image PixelYA16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA16
img
ImageRGB8 Image PixelRGB8
img -> Image PixelRGB8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
img
ImageRGB16 Image PixelRGB16
img -> Image PixelRGB16
img
ImageRGBF Image PixelRGBF
img -> Image PixelRGBF -> Image PixelRGB16
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBF
img :: Image PixelRGB16
ImageRGBA8 Image PixelRGBA8
img -> Image PixelRGBA16 -> Image PixelRGB16
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer (Image PixelRGBA8 -> Image PixelRGBA16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGBA8
img :: Image PixelRGBA16)
ImageRGBA16 Image PixelRGBA16
img -> Image PixelRGBA16 -> Image PixelRGB16
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA16
img
ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelRGB8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
ImageCMYK8 Image PixelCMYK8
img -> Image PixelRGB8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
ImageCMYK16 Image PixelCMYK16
img -> Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img
decodeImageWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
decodeImageWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
decodeImageWithPaletteAndMetadata ByteString
str = ByteString
-> [(String,
ByteString -> Either String (PalettedImage, Metadatas))]
-> Either String (PalettedImage, Metadatas)
forall c b.
c -> [(String, c -> Either String b)] -> Either String b
eitherLoad ByteString
str
[ (String
"Jpeg", ((DynamicImage, Metadatas) -> (PalettedImage, Metadatas))
-> Either String (DynamicImage, Metadatas)
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DynamicImage -> PalettedImage)
-> (DynamicImage, Metadatas) -> (PalettedImage, Metadatas)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DynamicImage -> PalettedImage
TrueColorImage) (Either String (DynamicImage, Metadatas)
-> Either String (PalettedImage, Metadatas))
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String (PalettedImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeJpegWithMetadata)
, (String
"PNG", ByteString -> Either String (PalettedImage, Metadatas)
decodePngWithPaletteAndMetadata)
, (String
"Bitmap", ByteString -> Either String (PalettedImage, Metadatas)
decodeBitmapWithPaletteAndMetadata)
, (String
"GIF", ByteString -> Either String (PalettedImage, Metadatas)
decodeGifWithPaletteAndMetadata)
, (String
"HDR", ((DynamicImage, Metadatas) -> (PalettedImage, Metadatas))
-> Either String (DynamicImage, Metadatas)
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DynamicImage -> PalettedImage)
-> (DynamicImage, Metadatas) -> (PalettedImage, Metadatas)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DynamicImage -> PalettedImage
TrueColorImage) (Either String (DynamicImage, Metadatas)
-> Either String (PalettedImage, Metadatas))
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String (PalettedImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeHDRWithMetadata)
, (String
"Tiff", ByteString -> Either String (PalettedImage, Metadatas)
decodeTiffWithPaletteAndMetadata)
, (String
"TGA", ByteString -> Either String (PalettedImage, Metadatas)
decodeTgaWithPaletteAndMetadata)
]
decodeImageWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata =
((PalettedImage, Metadatas) -> (DynamicImage, Metadatas))
-> Either String (PalettedImage, Metadatas)
-> Either String (DynamicImage, Metadatas)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PalettedImage -> DynamicImage)
-> (PalettedImage, Metadatas) -> (DynamicImage, Metadatas)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first PalettedImage -> DynamicImage
palettedToTrueColor) (Either String (PalettedImage, Metadatas)
-> Either String (DynamicImage, Metadatas))
-> (ByteString -> Either String (PalettedImage, Metadatas))
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (PalettedImage, Metadatas)
decodeImageWithPaletteAndMetadata
readPng :: FilePath -> IO (Either String DynamicImage)
readPng :: String -> IO (Either String DynamicImage)
readPng = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodePng
readGif :: FilePath -> IO (Either String DynamicImage)
readGif :: String -> IO (Either String DynamicImage)
readGif = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeGif
readTiff :: FilePath -> IO (Either String DynamicImage)
readTiff :: String -> IO (Either String DynamicImage)
readTiff = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeTiff
readGifImages :: FilePath -> IO (Either String [DynamicImage])
readGifImages :: String -> IO (Either String [DynamicImage])
readGifImages = (ByteString -> Either String [DynamicImage])
-> String -> IO (Either String [DynamicImage])
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String [DynamicImage]
decodeGifImages
readJpeg :: FilePath -> IO (Either String DynamicImage)
readJpeg :: String -> IO (Either String DynamicImage)
readJpeg = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeJpeg
readBitmap :: FilePath -> IO (Either String DynamicImage)
readBitmap :: String -> IO (Either String DynamicImage)
readBitmap = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeBitmap
readHDR :: FilePath -> IO (Either String DynamicImage)
readHDR :: String -> IO (Either String DynamicImage)
readHDR = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeHDR
readTGA :: FilePath -> IO (Either String DynamicImage)
readTGA :: String -> IO (Either String DynamicImage)
readTGA = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeTga
saveJpgImage :: Int -> FilePath -> DynamicImage -> IO ()
saveJpgImage :: GifDelay -> String -> DynamicImage -> IO ()
saveJpgImage GifDelay
quality String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ GifDelay -> DynamicImage -> ByteString
imageToJpg GifDelay
quality DynamicImage
img
saveGifImage :: FilePath -> DynamicImage -> Either String (IO ())
saveGifImage :: String -> DynamicImage -> Either String (IO ())
saveGifImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> Either String ByteString -> Either String (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicImage -> Either String ByteString
imageToGif DynamicImage
img
saveTiffImage :: FilePath -> DynamicImage -> IO ()
saveTiffImage :: String -> DynamicImage -> IO ()
saveTiffImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> ByteString
imageToTiff DynamicImage
img
saveRadianceImage :: FilePath -> DynamicImage -> IO ()
saveRadianceImage :: String -> DynamicImage -> IO ()
saveRadianceImage String
path = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> (DynamicImage -> ByteString) -> DynamicImage -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> ByteString
imageToRadiance
savePngImage :: FilePath -> DynamicImage -> IO ()
savePngImage :: String -> DynamicImage -> IO ()
savePngImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> ByteString
imageToPng DynamicImage
img
saveBmpImage :: FilePath -> DynamicImage -> IO ()
saveBmpImage :: String -> DynamicImage -> IO ()
saveBmpImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> ByteString
imageToBitmap DynamicImage
img