1{-# LANGUAGE TypeFamilies #-} 2{-# LANGUAGE CPP #-} 3-- | Helper functions to save dynamic images to other file format 4-- with automatic color space/sample format conversion done automatically. 5module Codec.Picture.Saving( imageToJpg 6 , imageToPng 7 , imageToGif 8 , imageToBitmap 9 , imageToTiff 10 , imageToRadiance 11 , imageToTga 12 ) where 13 14#if !MIN_VERSION_base(4,8,0) 15import Data.Monoid( mempty ) 16#endif 17 18import Data.Bits( unsafeShiftR ) 19import Data.Word( Word8, Word16, Word32 ) 20import qualified Data.ByteString.Lazy as L 21import Codec.Picture.Bitmap 22import Codec.Picture.Jpg 23import Codec.Picture.Png 24import Codec.Picture.Gif 25import Codec.Picture.ColorQuant 26import Codec.Picture.HDR 27import Codec.Picture.Types 28import Codec.Picture.Tiff 29import Codec.Picture.Tga 30 31import qualified Data.Vector.Storable as V 32 33componentToLDR :: Float -> Word8 34componentToLDR = truncate . (255 *) . min 1.0 . max 0.0 35 36toStandardDef :: Image PixelRGBF -> Image PixelRGB8 37toStandardDef = pixelMap pixelConverter 38 where pixelConverter (PixelRGBF rf gf bf) = PixelRGB8 r g b 39 where r = componentToLDR rf 40 g = componentToLDR gf 41 b = componentToLDR bf 42 43greyScaleToStandardDef :: Image PixelF -> Image Pixel8 44greyScaleToStandardDef = pixelMap componentToLDR 45 46from16to8 :: ( PixelBaseComponent source ~ Word16 47 , PixelBaseComponent dest ~ Word8 ) 48 => Image source -> Image dest 49from16to8 Image { imageWidth = w, imageHeight = h 50 , imageData = arr } = Image w h transformed 51 where transformed = V.map toWord8 arr 52 toWord8 v = fromIntegral (v `unsafeShiftR` 8) 53 54from32to8 :: ( PixelBaseComponent source ~ Word32 55 , PixelBaseComponent dest ~ Word8 ) 56 => Image source -> Image dest 57from32to8 Image { imageWidth = w, imageHeight = h 58 , imageData = arr } = Image w h transformed 59 where transformed = V.map toWord8 arr 60 toWord8 v = fromIntegral (v `unsafeShiftR` 24) 61 62from32to16 :: ( PixelBaseComponent source ~ Word32 63 , PixelBaseComponent dest ~ Word16 ) 64 => Image source -> Image dest 65from32to16 Image { imageWidth = w, imageHeight = h 66 , imageData = arr } = Image w h transformed 67 where transformed = V.map toWord16 arr 68 toWord16 v = fromIntegral (v `unsafeShiftR` 16) 69 70from16toFloat :: ( PixelBaseComponent source ~ Word16 71 , PixelBaseComponent dest ~ Float ) 72 => Image source -> Image dest 73from16toFloat Image { imageWidth = w, imageHeight = h 74 , imageData = arr } = Image w h transformed 75 where transformed = V.map toWord8 arr 76 toWord8 v = fromIntegral v / 65536.0 77 78-- | This function will try to do anything to encode an image 79-- as RADIANCE, make all color conversion and such. Equivalent 80-- of 'decodeImage' for radiance encoding 81imageToRadiance :: DynamicImage -> L.ByteString 82imageToRadiance (ImageCMYK8 img) = 83 imageToRadiance . ImageRGB8 $ convertImage img 84imageToRadiance (ImageCMYK16 img) = 85 imageToRadiance . ImageRGB16 $ convertImage img 86imageToRadiance (ImageYCbCr8 img) = 87 imageToRadiance . ImageRGB8 $ convertImage img 88imageToRadiance (ImageRGB8 img) = 89 imageToRadiance . ImageRGBF $ promoteImage img 90imageToRadiance (ImageRGBF img) = encodeHDR img 91imageToRadiance (ImageRGBA8 img) = 92 imageToRadiance . ImageRGBF . promoteImage $ dropAlphaLayer img 93imageToRadiance (ImageY8 img) = 94 imageToRadiance . ImageRGB8 $ promoteImage img 95imageToRadiance (ImageYF img) = 96 imageToRadiance . ImageRGBF $ promoteImage img 97imageToRadiance (ImageYA8 img) = 98 imageToRadiance . ImageRGB8 . promoteImage $ dropAlphaLayer img 99imageToRadiance (ImageY16 img) = 100 imageToRadiance . ImageRGBF $ pixelMap toRgbf img 101 where toRgbf v = PixelRGBF val val val 102 where val = fromIntegral v / 65536.0 103imageToRadiance (ImageY32 img) = 104 imageToRadiance . ImageRGBF $ pixelMap toRgbf img 105 where toRgbf v = PixelRGBF val val val 106 where val = fromIntegral v / 4294967296.0 107imageToRadiance (ImageYA16 img) = 108 imageToRadiance . ImageRGBF $ pixelMap toRgbf img 109 where toRgbf (PixelYA16 v _) = PixelRGBF val val val 110 where val = fromIntegral v / 65536.0 111imageToRadiance (ImageRGB16 img) = 112 imageToRadiance . ImageRGBF $ from16toFloat img 113imageToRadiance (ImageRGBA16 img) = 114 imageToRadiance . ImageRGBF $ pixelMap toRgbf img 115 where toRgbf (PixelRGBA16 r g b _) = PixelRGBF (f r) (f g) (f b) 116 where f v = fromIntegral v / 65536.0 117 118-- | This function will try to do anything to encode an image 119-- as JPEG, make all color conversion and such. Equivalent 120-- of 'decodeImage' for jpeg encoding 121-- Save Y or YCbCr Jpeg only, all other colorspaces are converted. 122-- To save a RGB or CMYK JPEG file, use the 123-- 'Codec.Picture.Jpg.Internal.encodeDirectJpegAtQualityWithMetadata' function 124imageToJpg :: Int -> DynamicImage -> L.ByteString 125imageToJpg quality dynImage = 126 let encodeAtQuality = encodeJpegAtQuality (fromIntegral quality) 127 encodeWithMeta = encodeDirectJpegAtQualityWithMetadata (fromIntegral quality) mempty 128 in case dynImage of 129 ImageYCbCr8 img -> encodeAtQuality img 130 ImageCMYK8 img -> imageToJpg quality . ImageRGB8 $ convertImage img 131 ImageCMYK16 img -> imageToJpg quality . ImageRGB16 $ convertImage img 132 ImageRGB8 img -> encodeAtQuality (convertImage img) 133 ImageRGBF img -> imageToJpg quality . ImageRGB8 $ toStandardDef img 134 ImageRGBA8 img -> encodeAtQuality (convertImage $ dropAlphaLayer img) 135 ImageYF img -> imageToJpg quality . ImageY8 $ greyScaleToStandardDef img 136 ImageY8 img -> encodeWithMeta img 137 ImageYA8 img -> encodeWithMeta $ dropAlphaLayer img 138 ImageY16 img -> imageToJpg quality . ImageY8 $ from16to8 img 139 ImageYA16 img -> imageToJpg quality . ImageYA8 $ from16to8 img 140 ImageY32 img -> imageToJpg quality . ImageY8 $ from32to8 img 141 ImageRGB16 img -> imageToJpg quality . ImageRGB8 $ from16to8 img 142 ImageRGBA16 img -> imageToJpg quality . ImageRGBA8 $ from16to8 img 143 144-- | This function will try to do anything to encode an image 145-- as PNG, make all color conversion and such. Equivalent 146-- of 'decodeImage' for PNG encoding 147imageToPng :: DynamicImage -> L.ByteString 148imageToPng (ImageYCbCr8 img) = encodePng (convertImage img :: Image PixelRGB8) 149imageToPng (ImageCMYK8 img) = encodePng (convertImage img :: Image PixelRGB8) 150imageToPng (ImageCMYK16 img) = encodePng (convertImage img :: Image PixelRGB16) 151imageToPng (ImageRGB8 img) = encodePng img 152imageToPng (ImageRGBF img) = encodePng $ toStandardDef img 153imageToPng (ImageRGBA8 img) = encodePng img 154imageToPng (ImageY8 img) = encodePng img 155imageToPng (ImageYF img) = encodePng $ greyScaleToStandardDef img 156imageToPng (ImageYA8 img) = encodePng img 157imageToPng (ImageY16 img) = encodePng img 158imageToPng (ImageY32 img) = imageToPng . ImageY16 $ from32to16 img 159imageToPng (ImageYA16 img) = encodePng img 160imageToPng (ImageRGB16 img) = encodePng img 161imageToPng (ImageRGBA16 img) = encodePng img 162 163-- | This function will try to do anything to encode an image 164-- as a Tiff, make all color conversion and such. Equivalent 165-- of 'decodeImage' for Tiff encoding 166imageToTiff :: DynamicImage -> L.ByteString 167imageToTiff (ImageYCbCr8 img) = encodeTiff img 168imageToTiff (ImageCMYK8 img) = encodeTiff img 169imageToTiff (ImageCMYK16 img) = encodeTiff img 170imageToTiff (ImageRGB8 img) = encodeTiff img 171imageToTiff (ImageRGBF img) = encodeTiff $ toStandardDef img 172imageToTiff (ImageRGBA8 img) = encodeTiff img 173imageToTiff (ImageY8 img) = encodeTiff img 174imageToTiff (ImageYF img) = encodeTiff $ greyScaleToStandardDef img 175imageToTiff (ImageYA8 img) = encodeTiff $ dropAlphaLayer img 176imageToTiff (ImageY16 img) = encodeTiff img 177imageToTiff (ImageY32 img) = encodeTiff img 178imageToTiff (ImageYA16 img) = encodeTiff $ dropAlphaLayer img 179imageToTiff (ImageRGB16 img) = encodeTiff img 180imageToTiff (ImageRGBA16 img) = encodeTiff img 181 182-- | This function will try to do anything to encode an image 183-- as bitmap, make all color conversion and such. Equivalent 184-- of 'decodeImage' for Bitmap encoding 185imageToBitmap :: DynamicImage -> L.ByteString 186imageToBitmap (ImageYCbCr8 img) = encodeBitmap (convertImage img :: Image PixelRGB8) 187imageToBitmap (ImageCMYK8 img) = encodeBitmap (convertImage img :: Image PixelRGB8) 188imageToBitmap (ImageCMYK16 img) = imageToBitmap . ImageRGB16 $ convertImage img 189imageToBitmap (ImageRGBF img) = encodeBitmap $ toStandardDef img 190imageToBitmap (ImageRGB8 img) = encodeBitmap img 191imageToBitmap (ImageRGBA8 img) = encodeBitmap img 192imageToBitmap (ImageY8 img) = encodeBitmap img 193imageToBitmap (ImageYF img) = encodeBitmap $ greyScaleToStandardDef img 194imageToBitmap (ImageYA8 img) = encodeBitmap (promoteImage img :: Image PixelRGBA8) 195imageToBitmap (ImageY16 img) = imageToBitmap . ImageY8 $ from16to8 img 196imageToBitmap (ImageY32 img) = imageToBitmap . ImageY8 $ from32to8 img 197imageToBitmap (ImageYA16 img) = imageToBitmap . ImageYA8 $ from16to8 img 198imageToBitmap (ImageRGB16 img) = imageToBitmap . ImageRGB8 $ from16to8 img 199imageToBitmap (ImageRGBA16 img) = imageToBitmap . ImageRGBA8 $ from16to8 img 200 201 202-- | This function will try to do anything to encode an image 203-- as a gif, make all color conversion and quantization. Equivalent 204-- of 'decodeImage' for gif encoding 205imageToGif :: DynamicImage -> Either String L.ByteString 206imageToGif (ImageYCbCr8 img) = imageToGif . ImageRGB8 $ convertImage img 207imageToGif (ImageCMYK8 img) = imageToGif . ImageRGB8 $ convertImage img 208imageToGif (ImageCMYK16 img) = imageToGif . ImageRGB16 $ convertImage img 209imageToGif (ImageRGBF img) = imageToGif . ImageRGB8 $ toStandardDef img 210imageToGif (ImageRGB8 img) = encodeGifImageWithPalette indexed pal 211 where (indexed, pal) = palettize defaultPaletteOptions img 212imageToGif (ImageRGBA8 img) = imageToGif . ImageRGB8 $ dropAlphaLayer img 213imageToGif (ImageY8 img) = Right $ encodeGifImage img 214imageToGif (ImageYF img) = imageToGif . ImageY8 $ greyScaleToStandardDef img 215imageToGif (ImageYA8 img) = imageToGif . ImageY8 $ dropAlphaLayer img 216imageToGif (ImageY16 img) = imageToGif . ImageY8 $ from16to8 img 217imageToGif (ImageY32 img) = imageToGif . ImageY8 $ from32to8 img 218imageToGif (ImageYA16 img) = imageToGif . ImageYA8 $ from16to8 img 219imageToGif (ImageRGB16 img) = imageToGif . ImageRGB8 $ from16to8 img 220imageToGif (ImageRGBA16 img) = imageToGif . ImageRGBA8 $ from16to8 img 221 222-- | This function will try to do anything to encode an image 223-- as a tga, make all color conversion and quantization. Equivalent 224-- of 'decodeImage' for tga encoding 225imageToTga :: DynamicImage -> L.ByteString 226imageToTga (ImageYCbCr8 img) = encodeTga (convertImage img :: Image PixelRGB8) 227imageToTga (ImageCMYK8 img) = encodeTga (convertImage img :: Image PixelRGB8) 228imageToTga (ImageCMYK16 img) = encodeTga (from16to8 img :: Image PixelRGB8) 229imageToTga (ImageRGBF img) = encodeTga $ toStandardDef img 230imageToTga (ImageRGB8 img) = encodeTga img 231imageToTga (ImageRGBA8 img) = encodeTga img 232imageToTga (ImageY8 img) = encodeTga img 233imageToTga (ImageYF img) = encodeTga $ greyScaleToStandardDef img 234imageToTga (ImageYA8 img) = encodeTga (promoteImage img :: Image PixelRGBA8) 235imageToTga (ImageY16 img) = encodeTga (from16to8 img :: Image Pixel8) 236imageToTga (ImageY32 img) = encodeTga (from32to8 img :: Image Pixel8) 237imageToTga (ImageYA16 img) = encodeTga (from16to8 img :: Image PixelRGBA8) 238imageToTga (ImageRGB16 img) = encodeTga (from16to8 img :: Image PixelRGB8) 239imageToTga (ImageRGBA16 img) = encodeTga (from16to8 img :: Image PixelRGBA8) 240