content: {-# 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 = truncate . (255 *) . min 1.0 . max 0.0
  
  toStandardDef :: Image PixelRGBF -> Image PixelRGB8
  toStandardDef = pixelMap pixelConverter
    where pixelConverter (PixelRGBF rf gf bf) = PixelRGB8 r g b
            where r = componentToLDR rf
                  g = componentToLDR gf
                  b = componentToLDR bf
  
  greyScaleToStandardDef :: Image PixelF -> Image Pixel8
  greyScaleToStandardDef = pixelMap componentToLDR
  
  from16to8 :: ( PixelBaseComponent source ~ Word16
               , PixelBaseComponent dest ~ Word8 )
            => Image source -> Image dest
  from16to8 Image { imageWidth = w, imageHeight = h
                  , imageData = arr } = Image w h transformed
     where transformed = V.map toWord8 arr
           toWord8 v = fromIntegral (v `unsafeShiftR` 8)
  
  from32to8 :: ( PixelBaseComponent source ~ Word32
               , PixelBaseComponent dest ~ Word8 )
            => Image source -> Image dest
  from32to8 Image { imageWidth = w, imageHeight = h
                  , imageData = arr } = Image w h transformed
     where transformed = V.map toWord8 arr
           toWord8 v = fromIntegral (v `unsafeShiftR` 24)
  
  from32to16 :: ( PixelBaseComponent source ~ Word32
               , PixelBaseComponent dest ~ Word16 )
            => Image source -> Image dest
  from32to16 Image { imageWidth = w, imageHeight = h
                  , imageData = arr } = Image w h transformed
     where transformed = V.map toWord16 arr
           toWord16 v = fromIntegral (v `unsafeShiftR` 16)
  
  from16toFloat :: ( PixelBaseComponent source ~ Word16
                   , PixelBaseComponent dest ~ Float )
            => Image source -> Image dest
  from16toFloat Image { imageWidth = w, imageHeight = h
                      , imageData = arr } = Image w h transformed
     where transformed = V.map toWord8 arr
           toWord8 v = fromIntegral v / 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 (ImageCMYK8 img) =
      imageToRadiance . ImageRGB8 $ convertImage img
  imageToRadiance (ImageCMYK16 img) =
      imageToRadiance . ImageRGB16 $ convertImage img
  imageToRadiance (ImageYCbCr8 img) =
      imageToRadiance . ImageRGB8 $ convertImage img
  imageToRadiance (ImageRGB8   img) =
      imageToRadiance . ImageRGBF $ promoteImage img
  imageToRadiance (ImageRGBF   img) = encodeHDR img
  imageToRadiance (ImageRGBA8  img) =
      imageToRadiance . ImageRGBF . promoteImage $ dropAlphaLayer img
  imageToRadiance (ImageY8     img) =
      imageToRadiance . ImageRGB8 $ promoteImage img
  imageToRadiance (ImageYF     img) =
      imageToRadiance . ImageRGBF $ promoteImage img
  imageToRadiance (ImageYA8    img) =
      imageToRadiance . ImageRGB8 . promoteImage $ dropAlphaLayer img
  imageToRadiance (ImageY16    img) =
    imageToRadiance . ImageRGBF $ pixelMap toRgbf img
      where toRgbf v = PixelRGBF val val val
              where val = fromIntegral v / 65536.0
  imageToRadiance (ImageY32    img) =
    imageToRadiance . ImageRGBF $ pixelMap toRgbf img
      where toRgbf v = PixelRGBF val val val
              where val = fromIntegral v / 4294967296.0
  imageToRadiance (ImageYA16   img) =
    imageToRadiance . ImageRGBF $ pixelMap toRgbf img
      where toRgbf (PixelYA16 v _) = PixelRGBF val val val
              where val = fromIntegral v / 65536.0
  imageToRadiance (ImageRGB16  img) =
      imageToRadiance . ImageRGBF $ from16toFloat img
  imageToRadiance (ImageRGBA16 img) =
      imageToRadiance . ImageRGBF $ pixelMap toRgbf img
      where toRgbf (PixelRGBA16 r g b _) = PixelRGBF (f r) (f g) (f b)
              where f v = fromIntegral v / 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 quality dynImage =
      let encodeAtQuality = encodeJpegAtQuality (fromIntegral quality)
          encodeWithMeta = encodeDirectJpegAtQualityWithMetadata (fromIntegral quality) mempty
      in case dynImage of
          ImageYCbCr8 img -> encodeAtQuality img
          ImageCMYK8  img -> imageToJpg quality . ImageRGB8 $ convertImage img
          ImageCMYK16 img -> imageToJpg quality . ImageRGB16 $ convertImage img
          ImageRGB8   img -> encodeAtQuality (convertImage img)
          ImageRGBF   img -> imageToJpg quality . ImageRGB8 $ toStandardDef img
          ImageRGBA8  img -> encodeAtQuality (convertImage $ dropAlphaLayer img)
          ImageYF     img -> imageToJpg quality . ImageY8 $ greyScaleToStandardDef img
          ImageY8     img -> encodeWithMeta img
          ImageYA8    img -> encodeWithMeta $ dropAlphaLayer img
          ImageY16    img -> imageToJpg quality . ImageY8 $ from16to8 img
          ImageYA16   img -> imageToJpg quality . ImageYA8 $ from16to8 img
          ImageY32    img -> imageToJpg quality . ImageY8 $ from32to8 img
          ImageRGB16  img -> imageToJpg quality . ImageRGB8 $ from16to8 img
          ImageRGBA16 img -> imageToJpg quality . ImageRGBA8 $ from16to8 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 (ImageYCbCr8 img) = encodePng (convertImage img :: Image PixelRGB8)
  imageToPng (ImageCMYK8 img)  = encodePng (convertImage img :: Image PixelRGB8)
  imageToPng (ImageCMYK16 img) = encodePng (convertImage img :: Image PixelRGB16)
  imageToPng (ImageRGB8   img) = encodePng img
  imageToPng (ImageRGBF   img) = encodePng $ toStandardDef img
  imageToPng (ImageRGBA8  img) = encodePng img
  imageToPng (ImageY8     img) = encodePng img
  imageToPng (ImageYF     img) = encodePng $ greyScaleToStandardDef img
  imageToPng (ImageYA8    img) = encodePng img
  imageToPng (ImageY16    img) = encodePng img
  imageToPng (ImageY32    img) = imageToPng . ImageY16 $ from32to16 img
  imageToPng (ImageYA16   img) = encodePng img
  imageToPng (ImageRGB16  img) = encodePng img
  imageToPng (ImageRGBA16 img) = encodePng 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 (ImageYCbCr8 img) = encodeTiff img
  imageToTiff (ImageCMYK8 img)  = encodeTiff img
  imageToTiff (ImageCMYK16 img) = encodeTiff img
  imageToTiff (ImageRGB8   img) = encodeTiff img
  imageToTiff (ImageRGBF   img) = encodeTiff $ toStandardDef img
  imageToTiff (ImageRGBA8  img) = encodeTiff img
  imageToTiff (ImageY8     img) = encodeTiff img
  imageToTiff (ImageYF     img) = encodeTiff $ greyScaleToStandardDef img
  imageToTiff (ImageYA8    img) = encodeTiff $ dropAlphaLayer img
  imageToTiff (ImageY16    img) = encodeTiff img
  imageToTiff (ImageY32    img) = encodeTiff img
  imageToTiff (ImageYA16   img) = encodeTiff $ dropAlphaLayer img
  imageToTiff (ImageRGB16  img) = encodeTiff img
  imageToTiff (ImageRGBA16 img) = encodeTiff 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 (ImageYCbCr8 img) = encodeBitmap (convertImage img :: Image PixelRGB8)
  imageToBitmap (ImageCMYK8  img) = encodeBitmap (convertImage img :: Image PixelRGB8)
  imageToBitmap (ImageCMYK16 img) = imageToBitmap . ImageRGB16 $ convertImage img
  imageToBitmap (ImageRGBF   img) = encodeBitmap $ toStandardDef img
  imageToBitmap (ImageRGB8   img) = encodeBitmap img
  imageToBitmap (ImageRGBA8  img) = encodeBitmap img
  imageToBitmap (ImageY8     img) = encodeBitmap img
  imageToBitmap (ImageYF     img) = encodeBitmap $ greyScaleToStandardDef img
  imageToBitmap (ImageYA8    img) = encodeBitmap (promoteImage img :: Image PixelRGBA8)
  imageToBitmap (ImageY16    img) = imageToBitmap . ImageY8 $ from16to8 img
  imageToBitmap (ImageY32    img) = imageToBitmap . ImageY8 $ from32to8 img
  imageToBitmap (ImageYA16   img) = imageToBitmap . ImageYA8 $ from16to8 img
  imageToBitmap (ImageRGB16  img) = imageToBitmap . ImageRGB8 $ from16to8 img
  imageToBitmap (ImageRGBA16 img) = imageToBitmap . ImageRGBA8 $ from16to8 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 (ImageYCbCr8 img) = imageToGif . ImageRGB8 $ convertImage img
  imageToGif (ImageCMYK8  img) = imageToGif . ImageRGB8 $ convertImage img
  imageToGif (ImageCMYK16 img) = imageToGif . ImageRGB16 $ convertImage img
  imageToGif (ImageRGBF   img) = imageToGif . ImageRGB8 $ toStandardDef img
  imageToGif (ImageRGB8   img) = encodeGifImageWithPalette indexed pal
    where (indexed, pal) = palettize defaultPaletteOptions img
  imageToGif (ImageRGBA8  img) = imageToGif . ImageRGB8 $ dropAlphaLayer img
  imageToGif (ImageY8     img) = Right $ encodeGifImage img
  imageToGif (ImageYF     img) = imageToGif . ImageY8 $ greyScaleToStandardDef img
  imageToGif (ImageYA8    img) = imageToGif . ImageY8 $ dropAlphaLayer img
  imageToGif (ImageY16    img) = imageToGif . ImageY8 $ from16to8 img
  imageToGif (ImageY32    img) = imageToGif . ImageY8 $ from32to8 img
  imageToGif (ImageYA16   img) = imageToGif . ImageYA8 $ from16to8 img
  imageToGif (ImageRGB16  img) = imageToGif . ImageRGB8 $ from16to8 img
  imageToGif (ImageRGBA16 img) = imageToGif . ImageRGBA8 $ from16to8 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 (ImageYCbCr8 img) = encodeTga (convertImage img :: Image PixelRGB8)
  imageToTga (ImageCMYK8  img) = encodeTga (convertImage img :: Image PixelRGB8)
  imageToTga (ImageCMYK16 img) = encodeTga (from16to8 img :: Image PixelRGB8)
  imageToTga (ImageRGBF   img) = encodeTga $ toStandardDef img
  imageToTga (ImageRGB8   img) = encodeTga img
  imageToTga (ImageRGBA8  img) = encodeTga img
  imageToTga (ImageY8     img) = encodeTga img
  imageToTga (ImageYF     img) = encodeTga $ greyScaleToStandardDef img
  imageToTga (ImageYA8    img) = encodeTga (promoteImage img :: Image PixelRGBA8)
  imageToTga (ImageY16    img) = encodeTga (from16to8 img :: Image Pixel8)
  imageToTga (ImageY32    img) = encodeTga (from32to8 img :: Image Pixel8)
  imageToTga (ImageYA16   img) = encodeTga (from16to8 img :: Image PixelRGBA8)
  imageToTga (ImageRGB16  img) = encodeTga (from16to8 img :: Image PixelRGB8)
  imageToTga (ImageRGBA16 img) = encodeTga (from16to8 img :: Image PixelRGBA8)
  