{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Graphics.Image.IO.Formats.JuicyPixels.Writable -- Copyright : (c) Alexey Kuleshevich 2017 -- License : BSD3 -- Maintainer : Alexey Kuleshevich -- Stability : experimental -- Portability : non-portable -- module Graphics.Image.IO.Formats.JuicyPixels.Writable () where import Prelude as P import qualified Data.Monoid as M (mempty) import Graphics.Image.ColorSpace import Graphics.Image.Interface as I import Graphics.Image.Interface.Vector import Graphics.Image.IO.Base import Graphics.Image.IO.Formats.JuicyPixels.Common import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Codec.Picture as JP import qualified Codec.Picture.Jpg as JP import qualified Codec.Picture.ColorQuant as JP import qualified Data.Vector.Storable as V -------------------------------------------------------------------------------- -- Encoding images using JuicyPixels ------------------------------------------- -------------------------------------------------------------------------------- instance Writable (Image VS Y Word8) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) id instance Writable (Image VS RGB Word8) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) id instance Writable (Image VS RGBA Word8) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) id instance Writable (Image VS Binary Bit) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary instance Writable (Image VS Y Double) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8) instance Writable (Image VS YA Double) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) instance Writable (Image VS RGB Double) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8) instance Writable (Image VS RGBA Double) BMP where encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8) -- Writable GIF encodeGIF :: (Array VS cs' e, Array VS cs Word8) => [SaveOption GIF] -> (Pixel cs' e -> Pixel cs Word8) -> Image VS cs' e -> BL.ByteString encodeGIF [] !conv = either error id . uncurry JP.encodeGifImageWithPalette . JP.palettize JP.defaultPaletteOptions . imageToJPImage (undefined :: JP.PixelRGB8) conv encodeGIF (GIFPalette palOpts:_) !conv = either error id . uncurry JP.encodeGifImageWithPalette . JP.palettize palOpts . imageToJPImage (undefined :: JP.PixelRGB8) conv instance Writable (Image VS RGB Word8) GIF where encode _ opts = encodeGIF opts id instance Writable (Image VS Y Double) GIF where encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB) instance Writable (Image VS YA Double) GIF where encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB . dropAlpha) instance Writable (Image VS RGB Double) GIF where encode _ opts = encodeGIF opts (fmap toWord8) instance Writable (Image VS RGBA Double) GIF where encode _ opts = encodeGIF opts ((fmap toWord8) . dropAlpha) encodeGIFA :: (Array VS cs' e, Array VS cs Word8) => [SaveOption GIFA] -> (Pixel cs' e -> Pixel cs Word8) -> [(JP.GifDelay, Image VS cs' e)] -> BL.ByteString encodeGIFA !opts !conv = either error id . JP.encodeGifImages (getGIFALoop opts) . P.map palletizeGif where getGIFALoop [] = JP.LoopingNever getGIFALoop (GIFALooping loop:_) = loop getGIFALoop (_:xs) = getGIFALoop xs getGIFAPal [] = JP.defaultPaletteOptions getGIFAPal (GIFAPalette palOpts:_) = palOpts getGIFAPal (_:xs) = getGIFAPal xs palletizeGif !(d, img) = (p, d, jimg) where !(jimg, p) = JP.palettize (getGIFAPal opts) $ imageToJPImage (undefined :: JP.PixelRGB8) conv img instance Writable [(JP.GifDelay, Image VS RGB Word8)] GIFA where encode _ opts = encodeGIFA opts id instance Writable [(JP.GifDelay, Image VS RGB Double)] GIFA where encode _ opts = encodeGIFA opts (fmap toWord8) -- Writable HDR instance Writable (Image VS RGB Float) HDR where encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) id instance Writable (Image VS Y Double) HDR where encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat . toPixelRGB) instance Writable (Image VS YA Double) HDR where encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat . toPixelRGB . dropAlpha) instance Writable (Image VS RGB Double) HDR where encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat) instance Writable (Image VS RGBA Double) HDR where encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat . dropAlpha) -- Writable JPG encodeJPG :: (JP.JpgEncodable px, Array VS cs' e, Array VS cs (JP.PixelBaseComponent px)) => [SaveOption JPG] -> px -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent px)) -> Image VS cs' e -> BL.ByteString encodeJPG [] t conv = JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage t conv encodeJPG (JPGQuality q:_) t conv = JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage t conv instance Writable (Image VS Y Word8) JPG where encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) id instance Writable (Image VS RGB Word8) JPG where encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) id instance Writable (Image VS CMYK Word8) JPG where encode _ opts = encodeJPG opts (undefined :: JP.PixelCMYK8) id instance Writable (Image VS YCbCr Word8) JPG where encode _ opts = encodeJPG opts (undefined :: JP.PixelYCbCr8) id instance Writable (Image VS Y Double) JPG where encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) (fmap toWord8) instance Writable (Image VS YA Double) JPG where encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) instance Writable (Image VS RGB Double) JPG where encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) (fmap toWord8) instance Writable (Image VS RGBA Double) JPG where encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) ((fmap toWord8) . dropAlpha) -- Writable PNG instance Writable (Image VS Binary Bit) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary instance Writable (Image VS Y Word8) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) id instance Writable (Image VS Y Word16) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) id instance Writable (Image VS YA Word8) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA8) id instance Writable (Image VS YA Word16) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) id instance Writable (Image VS RGB Word8) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB8) id instance Writable (Image VS RGB Word16) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) id instance Writable (Image VS RGBA Word8) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA8) id instance Writable (Image VS RGBA Word16) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) id instance Writable (Image VS Y Double) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16) instance Writable (Image VS YA Double) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16) instance Writable (Image VS RGB Double) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16) instance Writable (Image VS RGBA Double) PNG where encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16) -- Writable TGA instance Writable (Image VS Binary Bit) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary instance Writable (Image VS Y Word8) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) id instance Writable (Image VS RGB Word8) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) id instance Writable (Image VS RGBA Word8) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) id instance Writable (Image VS Y Double) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8) instance Writable (Image VS YA Double) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) instance Writable (Image VS RGB Double) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8) instance Writable (Image VS RGBA Double) TGA where encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8) -- Writable TIF instance Writable (Image VS Y Word8) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) id instance Writable (Image VS Y Word16) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) id instance Writable (Image VS YA Word8) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA8) id instance Writable (Image VS YA Word16) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) id instance Writable (Image VS RGB Word8) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB8) id instance Writable (Image VS RGB Word16) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) id instance Writable (Image VS RGBA Word8) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA8) id instance Writable (Image VS RGBA Word16) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) id instance Writable (Image VS YCbCr Word8) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) id instance Writable (Image VS CMYK Word8) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK8) id instance Writable (Image VS CMYK Word16) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) id instance Writable (Image VS Binary Bit) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary instance Writable (Image VS Y Double) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16) instance Writable (Image VS YA Double) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16) instance Writable (Image VS RGB Double) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16) instance Writable (Image VS RGBA Double) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16) instance Writable (Image VS YCbCr Double) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) (fmap toWord8) instance Writable (Image VS CMYK Double) TIF where encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) (fmap toWord16) imageToJPImage :: (JP.Pixel a, Array VS cs' e, Array VS cs (JP.PixelBaseComponent a)) => a -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent a)) -> Image VS cs' e -> JP.Image a imageToJPImage _ f !img = JP.Image n m $ V.unsafeCast $ toVector $ I.map f img where !(m, n) = dims img