{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
-- | Helper functions to save dynamic images to other file format

-- with automatic color space/sample format conversion done automatically.

module Codec.Picture.Saving( imageToJpg
                           , imageToPng
                           , imageToGif
                           , imageToBitmap
                           , imageToTiff
                           , imageToRadiance
                           , imageToTga
                           ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( mempty )
#endif

import Data.Bits( unsafeShiftR )
import Data.Word( Word8, Word16, Word32 )
import qualified Data.ByteString.Lazy as L
import Codec.Picture.Bitmap
import Codec.Picture.Jpg
import Codec.Picture.Png
import Codec.Picture.Gif
import Codec.Picture.ColorQuant
import Codec.Picture.HDR
import Codec.Picture.Types
import Codec.Picture.Tiff
import Codec.Picture.Tga

import qualified Data.Vector.Storable as V

componentToLDR :: Float -> Word8
componentToLDR :: Float -> Word8
componentToLDR = Float -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Word8) -> (Float -> Float) -> Float -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
255 Float -> Float -> Float
forall a. Num a => a -> a -> a
*) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0.0

toStandardDef :: Image PixelRGBF -> Image PixelRGB8
toStandardDef :: Image PixelRGBF -> Image PixelRGB8
toStandardDef = (PixelRGBF -> PixelRGB8) -> Image PixelRGBF -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBF -> PixelRGB8
pixelConverter
  where pixelConverter :: PixelRGBF -> PixelRGB8
pixelConverter (PixelRGBF Float
rf Float
gf Float
bf) = Word8 -> Word8 -> Word8 -> PixelRGB8
PixelRGB8 Word8
r Word8
g Word8
b
          where r :: Word8
r = Float -> Word8
componentToLDR Float
rf
                g :: Word8
g = Float -> Word8
componentToLDR Float
gf
                b :: Word8
b = Float -> Word8
componentToLDR Float
bf

greyScaleToStandardDef :: Image PixelF -> Image Pixel8
greyScaleToStandardDef :: Image Float -> Image Word8
greyScaleToStandardDef = (Float -> Word8) -> Image Float -> Image Word8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap Float -> Word8
componentToLDR

from16to8 :: ( PixelBaseComponent source ~ Word16
             , PixelBaseComponent dest ~ Word8 )
          => Image source -> Image dest
from16to8 :: Image source -> Image dest
from16to8 Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h
                , imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent source)
arr } = Int -> Int -> Vector (PixelBaseComponent dest) -> Image dest
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector Word8
Vector (PixelBaseComponent dest)
transformed
   where transformed :: Vector Word8
transformed = (Word16 -> Word8) -> Vector Word16 -> Vector Word8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map Word16 -> Word8
forall a b. (Integral a, Bits a, Num b) => a -> b
toWord8 Vector Word16
Vector (PixelBaseComponent source)
arr
         toWord8 :: a -> b
toWord8 a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8)

from32to8 :: ( PixelBaseComponent source ~ Word32
             , PixelBaseComponent dest ~ Word8 )
          => Image source -> Image dest
from32to8 :: Image source -> Image dest
from32to8 Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h
                , imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent source)
arr } = Int -> Int -> Vector (PixelBaseComponent dest) -> Image dest
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector Word8
Vector (PixelBaseComponent dest)
transformed
   where transformed :: Vector Word8
transformed = (Word32 -> Word8) -> Vector Word32 -> Vector Word8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map Word32 -> Word8
forall a b. (Integral a, Bits a, Num b) => a -> b
toWord8 Vector Word32
Vector (PixelBaseComponent source)
arr
         toWord8 :: a -> b
toWord8 a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
24)

from32to16 :: ( PixelBaseComponent source ~ Word32
             , PixelBaseComponent dest ~ Word16 )
          => Image source -> Image dest
from32to16 :: Image source -> Image dest
from32to16 Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h
                , imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent source)
arr } = Int -> Int -> Vector (PixelBaseComponent dest) -> Image dest
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector Word16
Vector (PixelBaseComponent dest)
transformed
   where transformed :: Vector Word16
transformed = (Word32 -> Word16) -> Vector Word32 -> Vector Word16
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map Word32 -> Word16
forall a b. (Integral a, Bits a, Num b) => a -> b
toWord16 Vector Word32
Vector (PixelBaseComponent source)
arr
         toWord16 :: a -> b
toWord16 a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16)

from16toFloat :: ( PixelBaseComponent source ~ Word16
                 , PixelBaseComponent dest ~ Float )
          => Image source -> Image dest
from16toFloat :: Image source -> Image dest
from16toFloat Image { imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h
                    , imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent source)
arr } = Int -> Int -> Vector (PixelBaseComponent dest) -> Image dest
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h Vector Float
Vector (PixelBaseComponent dest)
transformed
   where transformed :: Vector Float
transformed = (Word16 -> Float) -> Vector Word16 -> Vector Float
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map Word16 -> Float
forall a a. (Fractional a, Integral a) => a -> a
toWord8 Vector Word16
Vector (PixelBaseComponent source)
arr
         toWord8 :: a -> a
toWord8 a
v = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
65536.0

-- | This function will try to do anything to encode an image

-- as RADIANCE, make all color conversion and such. Equivalent

-- of 'decodeImage' for radiance encoding

imageToRadiance :: DynamicImage -> L.ByteString
imageToRadiance :: DynamicImage -> ByteString
imageToRadiance (ImageCMYK8 Image PixelCMYK8
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img
imageToRadiance (ImageCMYK16 Image PixelCMYK16
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGB16 -> DynamicImage)
-> Image PixelRGB16
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> ByteString) -> Image PixelRGB16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img
imageToRadiance (ImageYCbCr8 Image PixelYCbCr8
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img
imageToRadiance (ImageRGB8   Image PixelRGB8
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> Image PixelRGBF
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
img
imageToRadiance (ImageRGBF   Image PixelRGBF
img) = Image PixelRGBF -> ByteString
encodeHDR Image PixelRGBF
img
imageToRadiance (ImageRGBA8  Image PixelRGBA8
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> DynamicImage)
-> (Image PixelRGB8 -> Image PixelRGBF)
-> Image PixelRGB8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> Image PixelRGBF
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA8
img
imageToRadiance (ImageY8     Image Word8
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Word8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Word8
img
imageToRadiance (ImageYF     Image Float
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image PixelRGBF
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Float
img
imageToRadiance (ImageYA8    Image PixelYA8
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> DynamicImage)
-> (Image Word8 -> Image PixelRGB8) -> Image Word8 -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> Image Word8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelYA8
img
imageToRadiance (ImageY16    Image Word16
img) =
  DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word16 -> PixelRGBF) -> Image Word16 -> Image PixelRGBF
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap Word16 -> PixelRGBF
forall a. Integral a => a -> PixelRGBF
toRgbf Image Word16
img
    where toRgbf :: a -> PixelRGBF
toRgbf a
v = Float -> Float -> Float -> PixelRGBF
PixelRGBF Float
val Float
val Float
val
            where val :: Float
val = a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
65536.0
imageToRadiance (ImageY32    Image Word32
img) =
  DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word32 -> PixelRGBF) -> Image Word32 -> Image PixelRGBF
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap Word32 -> PixelRGBF
forall a. Integral a => a -> PixelRGBF
toRgbf Image Word32
img
    where toRgbf :: a -> PixelRGBF
toRgbf a
v = Float -> Float -> Float -> PixelRGBF
PixelRGBF Float
val Float
val Float
val
            where val :: Float
val = a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4294967296.0
imageToRadiance (ImageYA16   Image PixelYA16
img) =
  DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ (PixelYA16 -> PixelRGBF) -> Image PixelYA16 -> Image PixelRGBF
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelYA16 -> PixelRGBF
toRgbf Image PixelYA16
img
    where toRgbf :: PixelYA16 -> PixelRGBF
toRgbf (PixelYA16 Word16
v Word16
_) = Float -> Float -> Float -> PixelRGBF
PixelRGBF Float
val Float
val Float
val
            where val :: Float
val = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
65536.0
imageToRadiance (ImageRGB16  Image PixelRGB16
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Image PixelRGBF
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Float) =>
Image source -> Image dest
from16toFloat Image PixelRGB16
img
imageToRadiance (ImageRGBA16 Image PixelRGBA16
img) =
    DynamicImage -> ByteString
imageToRadiance (DynamicImage -> ByteString)
-> (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> DynamicImage
ImageRGBF (Image PixelRGBF -> ByteString) -> Image PixelRGBF -> ByteString
forall a b. (a -> b) -> a -> b
$ (PixelRGBA16 -> PixelRGBF) -> Image PixelRGBA16 -> Image PixelRGBF
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBA16 -> PixelRGBF
toRgbf Image PixelRGBA16
img
    where toRgbf :: PixelRGBA16 -> PixelRGBF
toRgbf (PixelRGBA16 Word16
r Word16
g Word16
b Word16
_) = Float -> Float -> Float -> PixelRGBF
PixelRGBF (Word16 -> Float
forall a a. (Fractional a, Integral a) => a -> a
f Word16
r) (Word16 -> Float
forall a a. (Fractional a, Integral a) => a -> a
f Word16
g) (Word16 -> Float
forall a a. (Fractional a, Integral a) => a -> a
f Word16
b)
            where f :: a -> a
f a
v = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
65536.0

-- | This function will try to do anything to encode an image

-- as JPEG, make all color conversion and such. Equivalent

-- of 'decodeImage' for jpeg encoding

-- Save Y or YCbCr Jpeg only, all other colorspaces are converted.

-- To save a RGB or CMYK JPEG file, use the

-- 'Codec.Picture.Jpg.Internal.encodeDirectJpegAtQualityWithMetadata' function

imageToJpg :: Int -> DynamicImage -> L.ByteString
imageToJpg :: Int -> DynamicImage -> ByteString
imageToJpg Int
quality DynamicImage
dynImage =
    let encodeAtQuality :: Image PixelYCbCr8 -> ByteString
encodeAtQuality = Word8 -> Image PixelYCbCr8 -> ByteString
encodeJpegAtQuality (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
quality)
        encodeWithMeta :: Image Word8 -> ByteString
encodeWithMeta = Word8 -> Metadatas -> Image Word8 -> ByteString
forall px.
JpgEncodable px =>
Word8 -> Metadatas -> Image px -> ByteString
encodeDirectJpegAtQualityWithMetadata (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
quality) Metadatas
forall a. Monoid a => a
mempty
    in case DynamicImage
dynImage of
        ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelYCbCr8 -> ByteString
encodeAtQuality Image PixelYCbCr8
img
        ImageCMYK8  Image PixelCMYK8
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img
        ImageCMYK16 Image PixelCMYK16
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image PixelRGB16 -> DynamicImage)
-> Image PixelRGB16
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> ByteString) -> Image PixelRGB16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img
        ImageRGB8   Image PixelRGB8
img -> Image PixelYCbCr8 -> ByteString
encodeAtQuality (Image PixelRGB8 -> Image PixelYCbCr8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelRGB8
img)
        ImageRGBF   Image PixelRGBF
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Image PixelRGB8
toStandardDef Image PixelRGBF
img
        ImageRGBA8  Image PixelRGBA8
img -> Image PixelYCbCr8 -> ByteString
encodeAtQuality (Image PixelRGB8 -> Image PixelYCbCr8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage (Image PixelRGB8 -> Image PixelYCbCr8)
-> Image PixelRGB8 -> Image PixelYCbCr8
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA8
img)
        ImageYF     Image Float
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image Word8
greyScaleToStandardDef Image Float
img
        ImageY8     Image Word8
img -> Image Word8 -> ByteString
encodeWithMeta Image Word8
img
        ImageYA8    Image PixelYA8
img -> Image Word8 -> ByteString
encodeWithMeta (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> Image Word8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelYA8
img
        ImageY16    Image Word16
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Word16 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image Word16
img
        ImageYA16   Image PixelYA16
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image PixelYA8 -> DynamicImage) -> Image PixelYA8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> ByteString) -> Image PixelYA8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA16 -> Image PixelYA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelYA16
img
        ImageY32    Image Word32
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Word32 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word32,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from32to8 Image Word32
img
        ImageRGB16  Image PixelRGB16
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Image PixelRGB8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGB16
img
        ImageRGBA16 Image PixelRGBA16
img -> Int -> DynamicImage -> ByteString
imageToJpg Int
quality (DynamicImage -> ByteString)
-> (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> ByteString) -> Image PixelRGBA8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA16 -> Image PixelRGBA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGBA16
img

-- | This function will try to do anything to encode an image

-- as PNG, make all color conversion and such. Equivalent

-- of 'decodeImage' for PNG encoding

imageToPng :: DynamicImage -> L.ByteString
imageToPng :: DynamicImage -> ByteString
imageToPng (ImageYCbCr8 Image PixelYCbCr8
img) = Image PixelRGB8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
imageToPng (ImageCMYK8 Image PixelCMYK8
img)  = Image PixelRGB8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
imageToPng (ImageCMYK16 Image PixelCMYK16
img) = Image PixelRGB16 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img :: Image PixelRGB16)
imageToPng (ImageRGB8   Image PixelRGB8
img) = Image PixelRGB8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image PixelRGB8
img
imageToPng (ImageRGBF   Image PixelRGBF
img) = Image PixelRGB8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Image PixelRGB8
toStandardDef Image PixelRGBF
img
imageToPng (ImageRGBA8  Image PixelRGBA8
img) = Image PixelRGBA8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image PixelRGBA8
img
imageToPng (ImageY8     Image Word8
img) = Image Word8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image Word8
img
imageToPng (ImageYF     Image Float
img) = Image Word8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image Word8
greyScaleToStandardDef Image Float
img
imageToPng (ImageYA8    Image PixelYA8
img) = Image PixelYA8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image PixelYA8
img
imageToPng (ImageY16    Image Word16
img) = Image Word16 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image Word16
img
imageToPng (ImageY32    Image Word32
img) = DynamicImage -> ByteString
imageToPng (DynamicImage -> ByteString)
-> (Image Word16 -> DynamicImage) -> Image Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word16 -> DynamicImage
ImageY16 (Image Word16 -> ByteString) -> Image Word16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Word32 -> Image Word16
forall source dest.
(PixelBaseComponent source ~ Word32,
 PixelBaseComponent dest ~ Word16) =>
Image source -> Image dest
from32to16 Image Word32
img
imageToPng (ImageYA16   Image PixelYA16
img) = Image PixelYA16 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image PixelYA16
img
imageToPng (ImageRGB16  Image PixelRGB16
img) = Image PixelRGB16 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image PixelRGB16
img
imageToPng (ImageRGBA16 Image PixelRGBA16
img) = Image PixelRGBA16 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image PixelRGBA16
img

-- | This function will try to do anything to encode an image

-- as a Tiff, make all color conversion and such. Equivalent

-- of 'decodeImage' for Tiff encoding

imageToTiff :: DynamicImage -> L.ByteString
imageToTiff :: DynamicImage -> ByteString
imageToTiff (ImageYCbCr8 Image PixelYCbCr8
img) = Image PixelYCbCr8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelYCbCr8
img
imageToTiff (ImageCMYK8 Image PixelCMYK8
img)  = Image PixelCMYK8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelCMYK8
img
imageToTiff (ImageCMYK16 Image PixelCMYK16
img) = Image PixelCMYK16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelCMYK16
img
imageToTiff (ImageRGB8   Image PixelRGB8
img) = Image PixelRGB8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelRGB8
img
imageToTiff (ImageRGBF   Image PixelRGBF
img) = Image PixelRGB8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Image PixelRGB8
toStandardDef Image PixelRGBF
img
imageToTiff (ImageRGBA8  Image PixelRGBA8
img) = Image PixelRGBA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelRGBA8
img
imageToTiff (ImageY8     Image Word8
img) = Image Word8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image Word8
img
imageToTiff (ImageYF     Image Float
img) = Image Word8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image Word8
greyScaleToStandardDef Image Float
img
imageToTiff (ImageYA8    Image PixelYA8
img) = Image Word8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> Image Word8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelYA8
img
imageToTiff (ImageY16    Image Word16
img) = Image Word16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image Word16
img
imageToTiff (ImageY32    Image Word32
img) = Image Word32 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image Word32
img
imageToTiff (ImageYA16   Image PixelYA16
img) = Image Word16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff (Image Word16 -> ByteString) -> Image Word16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA16 -> Image Word16
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelYA16
img
imageToTiff (ImageRGB16  Image PixelRGB16
img) = Image PixelRGB16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelRGB16
img
imageToTiff (ImageRGBA16 Image PixelRGBA16
img) = Image PixelRGBA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image PixelRGBA16
img

-- | This function will try to do anything to encode an image

-- as bitmap, make all color conversion and such. Equivalent

-- of 'decodeImage' for Bitmap encoding

imageToBitmap :: DynamicImage -> L.ByteString
imageToBitmap :: DynamicImage -> ByteString
imageToBitmap (ImageYCbCr8 Image PixelYCbCr8
img) = Image PixelRGB8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
imageToBitmap (ImageCMYK8  Image PixelCMYK8
img) = Image PixelRGB8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
imageToBitmap (ImageCMYK16 Image PixelCMYK16
img) = DynamicImage -> ByteString
imageToBitmap (DynamicImage -> ByteString)
-> (Image PixelRGB16 -> DynamicImage)
-> Image PixelRGB16
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> ByteString) -> Image PixelRGB16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img
imageToBitmap (ImageRGBF   Image PixelRGBF
img) = Image PixelRGB8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Image PixelRGB8
toStandardDef Image PixelRGBF
img
imageToBitmap (ImageRGB8   Image PixelRGB8
img) = Image PixelRGB8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap Image PixelRGB8
img
imageToBitmap (ImageRGBA8  Image PixelRGBA8
img) = Image PixelRGBA8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap Image PixelRGBA8
img
imageToBitmap (ImageY8     Image Word8
img) = Image Word8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap Image Word8
img
imageToBitmap (ImageYF     Image Float
img) = Image Word8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image Word8
greyScaleToStandardDef Image Float
img
imageToBitmap (ImageYA8    Image PixelYA8
img) = Image PixelRGBA8 -> ByteString
forall pixel. BmpEncodable pixel => Image pixel -> ByteString
encodeBitmap (Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img :: Image PixelRGBA8)
imageToBitmap (ImageY16    Image Word16
img) = DynamicImage -> ByteString
imageToBitmap (DynamicImage -> ByteString)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Word16 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image Word16
img
imageToBitmap (ImageY32    Image Word32
img) = DynamicImage -> ByteString
imageToBitmap (DynamicImage -> ByteString)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Word32 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word32,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from32to8 Image Word32
img
imageToBitmap (ImageYA16   Image PixelYA16
img) = DynamicImage -> ByteString
imageToBitmap (DynamicImage -> ByteString)
-> (Image PixelYA8 -> DynamicImage) -> Image PixelYA8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> ByteString) -> Image PixelYA8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA16 -> Image PixelYA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelYA16
img
imageToBitmap (ImageRGB16  Image PixelRGB16
img) = DynamicImage -> ByteString
imageToBitmap (DynamicImage -> ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Image PixelRGB8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGB16
img
imageToBitmap (ImageRGBA16 Image PixelRGBA16
img) = DynamicImage -> ByteString
imageToBitmap (DynamicImage -> ByteString)
-> (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> ByteString) -> Image PixelRGBA8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA16 -> Image PixelRGBA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGBA16
img


-- | This function will try to do anything to encode an image

-- as a gif, make all color conversion and quantization. Equivalent

-- of 'decodeImage' for gif encoding

imageToGif :: DynamicImage -> Either String L.ByteString
imageToGif :: DynamicImage -> Either String ByteString
imageToGif (ImageYCbCr8 Image PixelYCbCr8
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String ByteString)
-> Image PixelRGB8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img
imageToGif (ImageCMYK8  Image PixelCMYK8
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String ByteString)
-> Image PixelRGB8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img
imageToGif (ImageCMYK16 Image PixelCMYK16
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGB16 -> DynamicImage)
-> Image PixelRGB16
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> Either String ByteString)
-> Image PixelRGB16 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img
imageToGif (ImageRGBF   Image PixelRGBF
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String ByteString)
-> Image PixelRGB8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Image PixelRGB8
toStandardDef Image PixelRGBF
img
imageToGif (ImageRGB8   Image PixelRGB8
img) = Image Word8 -> Image PixelRGB8 -> Either String ByteString
encodeGifImageWithPalette Image Word8
indexed Image PixelRGB8
pal
  where (Image Word8
indexed, Image PixelRGB8
pal) = PaletteOptions -> Image PixelRGB8 -> (Image Word8, Image PixelRGB8)
palettize PaletteOptions
defaultPaletteOptions Image PixelRGB8
img
imageToGif (ImageRGBA8  Image PixelRGBA8
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String ByteString)
-> Image PixelRGB8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA8
img
imageToGif (ImageY8     Image Word8
img) = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image Word8 -> ByteString
encodeGifImage Image Word8
img
imageToGif (ImageYF     Image Float
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image Word8 -> DynamicImage)
-> Image Word8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> Either String ByteString)
-> Image Word8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image Word8
greyScaleToStandardDef Image Float
img
imageToGif (ImageYA8    Image PixelYA8
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image Word8 -> DynamicImage)
-> Image Word8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> Either String ByteString)
-> Image Word8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> Image Word8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelYA8
img
imageToGif (ImageY16    Image Word16
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image Word8 -> DynamicImage)
-> Image Word8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> Either String ByteString)
-> Image Word8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image Word16 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image Word16
img
imageToGif (ImageY32    Image Word32
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image Word8 -> DynamicImage)
-> Image Word8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> Either String ByteString)
-> Image Word8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image Word32 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word32,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from32to8 Image Word32
img
imageToGif (ImageYA16   Image PixelYA16
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelYA8 -> DynamicImage)
-> Image PixelYA8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> Either String ByteString)
-> Image PixelYA8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA16 -> Image PixelYA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelYA16
img
imageToGif (ImageRGB16  Image PixelRGB16
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String ByteString)
-> Image PixelRGB8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Image PixelRGB8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGB16
img
imageToGif (ImageRGBA16 Image PixelRGBA16
img) = DynamicImage -> Either String ByteString
imageToGif (DynamicImage -> Either String ByteString)
-> (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> Either String ByteString)
-> Image PixelRGBA8 -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA16 -> Image PixelRGBA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGBA16
img

-- | This function will try to do anything to encode an image

-- as a tga, make all color conversion and quantization. Equivalent

-- of 'decodeImage' for tga encoding

imageToTga :: DynamicImage -> L.ByteString
imageToTga :: DynamicImage -> ByteString
imageToTga (ImageYCbCr8 Image PixelYCbCr8
img) = Image PixelRGB8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
imageToTga (ImageCMYK8  Image PixelCMYK8
img) = Image PixelRGB8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
imageToTga (ImageCMYK16 Image PixelCMYK16
img) = Image PixelRGB8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelCMYK16 -> Image PixelRGB8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelCMYK16
img :: Image PixelRGB8)
imageToTga (ImageRGBF   Image PixelRGBF
img) = Image PixelRGB8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF -> Image PixelRGB8
toStandardDef Image PixelRGBF
img
imageToTga (ImageRGB8   Image PixelRGB8
img) = Image PixelRGB8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga Image PixelRGB8
img
imageToTga (ImageRGBA8  Image PixelRGBA8
img) = Image PixelRGBA8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga Image PixelRGBA8
img
imageToTga (ImageY8     Image Word8
img) = Image Word8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga Image Word8
img
imageToTga (ImageYF     Image Float
img) = Image Word8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> Image Word8
greyScaleToStandardDef Image Float
img
imageToTga (ImageYA8    Image PixelYA8
img) = Image PixelRGBA8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img :: Image PixelRGBA8)
imageToTga (ImageY16    Image Word16
img) = Image Word8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image Word16 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image Word16
img :: Image Pixel8)
imageToTga (ImageY32    Image Word32
img) = Image Word8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image Word32 -> Image Word8
forall source dest.
(PixelBaseComponent source ~ Word32,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from32to8 Image Word32
img :: Image Pixel8)
imageToTga (ImageYA16   Image PixelYA16
img) = Image PixelRGBA8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelYA16 -> Image PixelRGBA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelYA16
img :: Image PixelRGBA8)
imageToTga (ImageRGB16  Image PixelRGB16
img) = Image PixelRGB8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelRGB16 -> Image PixelRGB8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGB16
img :: Image PixelRGB8)
imageToTga (ImageRGBA16 Image PixelRGBA16
img) = Image PixelRGBA8 -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga (Image PixelRGBA16 -> Image PixelRGBA8
forall source dest.
(PixelBaseComponent source ~ Word16,
 PixelBaseComponent dest ~ Word8) =>
Image source -> Image dest
from16to8 Image PixelRGBA16
img :: Image PixelRGBA8)