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