module Data.Massiv.Array.IO.Image.JuicyPixels
(
BMP(..)
, GIF(..)
, WriteOptionsGIF
, woGetPaletteOptionsGIF
, woSetPaletteOptionsGIF
, JP.PaletteOptions(..)
, JP.PaletteCreationMethod(..)
, WriteOptionsSequenceGIF
, woGetGifLoopingGIFs
, woGetPaletteOptionsGIFs
, woSetGifLoopingGIFs
, woSetPaletteOptionsGIFs
, JP.GifDelay
, JP.GifLooping(..)
, HDR(..)
, JPG(..)
, WriteOptionsJPG
, woGetQualityJPG
, woSetQualityJPG
, PNG(..)
, TGA(..)
, TIF(..)
, toAnyCS
, toJPImageY8
, toJPImageYA8
, toJPImageY16
, toJPImageYA16
, toJPImageYF
, toJPImageRGB8
, toJPImageRGBA8
, toJPImageRGB16
, toJPImageRGBA16
, toJPImageRGBF
, toJPImageYCbCr8
, toJPImageCMYK8
) where
import Prelude as P
import qualified Codec.Picture as JP
import qualified Codec.Picture.ColorQuant as JP
import qualified Codec.Picture.Gif as JP
import qualified Codec.Picture.Jpg as JP
import Control.Exception
import Control.Monad (guard, msum)
import Data.Bifunctor
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Lazy as BL (ByteString)
import Data.Default (Default (..))
import Data.Massiv.Array as M
import Data.Massiv.Array.IO.Base
import Data.Massiv.Array.Manifest.Vector
import Data.Typeable
import qualified Data.Vector.Storable as V
import Graphics.ColorSpace
data BMP = BMP deriving Show
instance FileFormat BMP where
ext _ = ".bmp"
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable BMP (Image r cs e) where
encode f _ img = fromMaybeEncode f (toProxy img) $ encodeBMP img
instance (ColorSpace cs e, ToRGBA cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto BMP) (Image r cs e) where
encode f _ = encodeAuto f encodeBMP id toPixelRGBA toPixelRGB toPixelRGBA
instance ColorSpace cs e => Readable BMP (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodeBitmap
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto BMP) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodeBitmap
encodeBMP :: forall r cs e . (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> Image r cs e -> Maybe BL.ByteString
encodeBMP img =
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeBitmap $ toJPImageY8 img
, return $ JP.encodeBitmap $ toJPImageY8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeBitmap $ toJPImageRGB8 img
, return $ JP.encodeBitmap $ toJPImageRGB8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: RGBA)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeBitmap $ toJPImageRGBA8 img
, return $ JP.encodeBitmap $ toJPImageRGBA8 $ M.map toWord8 img
]
]
data PNG = PNG deriving Show
instance FileFormat PNG where
ext _ = ".png"
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable PNG (Image r cs e) where
encode f _ img = fromMaybeEncode f (toProxy img) (encodePNG img)
instance (ColorSpace cs e, ToYA cs e, ToRGBA cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto PNG) (Image r cs e) where
encode f _ = encodeAuto f encodePNG id toPixelYA toPixelRGB toPixelRGBA
instance ColorSpace cs e => Readable PNG (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodePng
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto PNG) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodePng
encodePNG :: forall r cs e. (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> Image r cs e -> Maybe BL.ByteString
encodePNG img =
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodePng $ toJPImageY8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodePng $ toJPImageY16 img
, return $ JP.encodePng $ toJPImageY16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: YA)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodePng $ toJPImageYA8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodePng $ toJPImageYA16 img
, return $ JP.encodePng $ toJPImageYA16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodePng $ toJPImageRGB8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodePng $ toJPImageRGB16 img
, return $ JP.encodePng $ toJPImageRGB16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: RGBA)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodePng $ toJPImageRGBA8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodePng $ toJPImageRGBA16 img
, return $ JP.encodePng $ toJPImageRGBA16 $ M.map toWord16 img
]
]
data GIF = GIF deriving Show
newtype WriteOptionsGIF = WriteOptionsGIF
{ woGetPaletteOptionsGIF :: JP.PaletteOptions
}
woSetPaletteOptionsGIF :: JP.PaletteOptions -> WriteOptionsGIF -> WriteOptionsGIF
woSetPaletteOptionsGIF palOpts opts = opts { woGetPaletteOptionsGIF = palOpts }
instance Default WriteOptionsGIF where
def = WriteOptionsGIF JP.defaultPaletteOptions
instance FileFormat GIF where
type WriteOptions GIF = WriteOptionsGIF
ext _ = ".gif"
data WriteOptionsSequenceGIF = WriteOptionsSequenceGIF
{ woGetPaletteOptionsGIFs :: JP.PaletteOptions
, woGetGifLoopingGIFs :: JP.GifLooping
}
woSetPaletteOptionsGIFs :: JP.PaletteOptions -> WriteOptionsSequenceGIF -> WriteOptionsSequenceGIF
woSetPaletteOptionsGIFs palOpts opts = opts { woGetPaletteOptionsGIFs = palOpts }
woSetGifLoopingGIFs :: JP.GifLooping -> WriteOptionsSequenceGIF -> WriteOptionsSequenceGIF
woSetGifLoopingGIFs looping opts = opts { woGetGifLoopingGIFs = looping }
instance Default WriteOptionsSequenceGIF where
def = WriteOptionsSequenceGIF JP.defaultPaletteOptions JP.LoopingNever
instance FileFormat (Sequence GIF) where
type WriteOptions (Sequence GIF) = WriteOptionsSequenceGIF
ext _ = ext GIF
instance FileFormat (Sequence (Auto GIF)) where
type WriteOptions (Sequence (Auto GIF)) = WriteOptions (Sequence GIF)
ext _ = ext GIF
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable GIF (Image r cs e) where
encode f opt img = fromMaybeEncode f (toProxy img) $ encodeGIF opt img
instance (ColorSpace cs e, ToY cs e, ToRGB cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto GIF) (Image r cs e) where
encode f opt = encodeAuto f (encodeGIF opt) id toPixelY toPixelRGB toPixelRGB
instance ColorSpace cs e => Readable GIF (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodeGif
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto GIF) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodeGif
instance ColorSpace cs e =>
Readable (Sequence GIF) (Array B Ix1 (Image S cs e)) where
decode f _ bs = decodeGIFs f fromDynamicImage bs
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Sequence (Auto GIF)) (Array B Ix1 (Image r cs e)) where
decode f _ bs = decodeGIFs f fromAnyDynamicImage bs
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Sequence GIF) (Array B Ix1 (JP.GifDelay, Image r cs e)) where
encode _ opts =
fromMaybeEncode (Sequence GIF) (Proxy :: Proxy (Image r cs e)) . encodeGIFs opts
instance ColorSpace cs e =>
Readable (Sequence GIF) (Array B Ix1 (JP.GifDelay, Image S cs e)) where
decode f _ bs = decodeGIFsWithDelays f fromDynamicImage bs
decodeGIFs
:: (FileFormat f, Mutable r Ix2 (Pixel cs e), ColorSpace cs e)
=> f
-> (JP.DynamicImage -> Maybe (Image r cs e))
-> B.ByteString
-> Array B Ix1 (Image r cs e)
decodeGIFs f converter bs =
either throw (fromList Seq) $ do
jpImgs <- first (toException . DecodeError) $ JP.decodeGifImages bs
first toException $ P.mapM (convertEither f showJP converter) jpImgs
decodeGIFsWithDelays
:: ColorSpace cs e
=> Sequence GIF
-> (JP.DynamicImage -> Maybe (Image S cs e))
-> B.ByteString
-> Array B Ix1 (JP.GifDelay, Image S cs e)
decodeGIFsWithDelays f converter bs =
either throw (fromList Seq) $ do
jpImgsLs <- first (toException . DecodeError) $ JP.decodeGifImages bs
delays <- first (toException . DecodeError) $ JP.getDelaysGifImages bs
imgs <- first toException $ P.mapM (convertEither f showJP converter) jpImgsLs
return $ P.zip delays imgs
encodeGIF :: forall r cs e . (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> WriteOptionsGIF
-> Image r cs e
-> Maybe BL.ByteString
encodeGIF (WriteOptionsGIF pal) img =
(either (throw . EncodeError) id . uncurry JP.encodeGifImageWithPalette) <$>
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
jImg <-
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ toJPImageY8 img
, return $ toJPImageY8 $ M.map toWord8 img
]
return (jImg, JP.greyPalette)
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
palettizeRGB pal img
, palettizeRGB pal $ M.map toWord8 img
]
]
encodeGIFs :: forall r cs e . (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> WriteOptionsSequenceGIF
-> Array B Ix1 (JP.GifDelay, Image r cs e)
-> Maybe BL.ByteString
encodeGIFs (WriteOptionsSequenceGIF pal looping) arr = do
palImgsLs <-
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ P.map ((, JP.greyPalette) . toJPImageY8) imgsLs
, return $
P.map ((, JP.greyPalette) . toJPImageY8 . M.map toWord8) imgsLs
]
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
P.mapM (palettizeRGB pal) imgsLs
, P.mapM (palettizeRGB pal . M.map toWord8) imgsLs
]
]
let palDelImgsLs = P.zipWith (\(i, p) d -> (p, d, i)) palImgsLs delaysLs
return $
either (throw . EncodeError) id $ JP.encodeGifImages looping palDelImgsLs
where
delaysLs = toList delays
imgsLs = toList imgs
(delays, imgs) = M.unzip arr
palettizeRGB :: forall r e . (ColorSpace RGB e, Source r Ix2 (Pixel RGB e))
=> JP.PaletteOptions
-> Image r RGB e
-> Maybe (JP.Image JP.Pixel8, JP.Palette)
palettizeRGB pal img = do
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ palettize' img
, return $ palettize' $ M.map toWord8 img
]
where
palettize' :: forall r' . Source r' Ix2 (Pixel RGB Word8) =>
Image r' RGB Word8 -> (JP.Image JP.Pixel8, JP.Palette)
palettize' = JP.palettize pal . toJPImageRGB8
data HDR = HDR deriving Show
instance FileFormat HDR where
ext _ = ".hdr"
exts _ = [".hdr", ".pic"]
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable HDR (Image r cs e) where
encode f _ img = fromMaybeEncode f (toProxy img) $ encodeHDR img
instance (ColorSpace cs e, ToRGB cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto HDR) (Image r cs e) where
encode f _ =
encodeAuto f encodeHDR toPixelRGB toPixelRGB toPixelRGB toPixelRGB
instance ColorSpace cs e => Readable HDR (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodePng
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto HDR) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodePng
encodeHDR :: forall r cs e. (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> Image r cs e -> Maybe BL.ByteString
encodeHDR img = do
Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Float)
return $ JP.encodeHDR $ toJPImageRGBF img
, return $ JP.encodeHDR $ toJPImageRGBF $ M.map toFloat img
]
newtype WriteOptionsJPG = WriteOptionsJPG { woGetQualityJPG :: Word8 } deriving Show
woSetQualityJPG :: Word8 -> WriteOptionsJPG -> WriteOptionsJPG
woSetQualityJPG q opts = opts { woGetQualityJPG = min 100 (max 0 q) }
instance Default WriteOptionsJPG where
def = WriteOptionsJPG 100
data JPG = JPG deriving Show
instance FileFormat JPG where
type WriteOptions JPG = WriteOptionsJPG
ext _ = ".jpg"
exts _ = [".jpg", ".jpeg"]
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable JPG (Image r cs e) where
encode f opts img = fromMaybeEncode f (toProxy img) $ encodeJPG opts img
instance (ColorSpace cs e, ToYCbCr cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto JPG) (Image r cs e) where
encode f opt =
encodeAuto f (encodeJPG opt) toPixelYCbCr toPixelYCbCr toPixelYCbCr toPixelYCbCr
instance ColorSpace cs e => Readable JPG (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodeJpeg
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto JPG) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodeJpeg
encodeJPG :: forall r cs e. (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> WriteOptionsJPG -> Image r cs e -> Maybe BL.ByteString
encodeJPG (WriteOptionsJPG q) img =
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ encJPG $ toJPImageY8 img
, return $ encJPG $ toJPImageY8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ encJPG $ toJPImageRGB8 img
, return $ encJPG $ toJPImageRGB8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: CMYK)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ encJPG $ toJPImageCMYK8 img
, return $ encJPG $ toJPImageCMYK8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: YCbCr)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ encJPG $ toJPImageYCbCr8 img
, return $ encJPG $ toJPImageYCbCr8 $ M.map toWord8 img
]
]
where
encJPG :: forall px . JP.JpgEncodable px => JP.Image px -> BL.ByteString
encJPG = JP.encodeDirectJpegAtQualityWithMetadata q mempty
data TGA = TGA deriving Show
instance FileFormat TGA where
ext _ = ".tga"
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable TGA (Image r cs e) where
encode f _ img = fromMaybeEncode f (toProxy img) $ encodeTGA img
instance (ColorSpace cs e, ToRGBA cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto TGA) (Image r cs e) where
encode f _ = encodeAuto f encodeTGA id toPixelRGBA toPixelRGB toPixelRGBA
instance ColorSpace cs e => Readable TGA (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodeTga
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto TGA) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodeTga
encodeTGA :: forall r cs e . (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> Image r cs e -> Maybe BL.ByteString
encodeTGA img =
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTga $ toJPImageY8 img
, return $ JP.encodeTga $ toJPImageY8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTga $ toJPImageRGB8 img
, return $ JP.encodeTga $ toJPImageRGB8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: RGBA)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTga $ toJPImageRGBA8 img
, return $ JP.encodeTga $ toJPImageRGBA8 $ M.map toWord8 img
]
]
data TIF = TIF deriving Show
instance FileFormat TIF where
ext _ = ".tif"
exts _ = [".tif", ".tiff"]
instance (ColorSpace cs e, Source r Ix2 (Pixel cs e)) =>
Writable TIF (Image r cs e) where
encode f _ img = fromMaybeEncode f (toProxy img) $ encodeTIF img
instance (ColorSpace cs e, ToRGBA cs e, Source r Ix2 (Pixel cs e)) =>
Writable (Auto TIF) (Image r cs e) where
encode f _ = encodeAuto f encodeTIF id id id toPixelRGBA
instance ColorSpace cs e => Readable TIF (Image S cs e) where
decode f _ = fromEitherDecode f showJP fromDynamicImage . JP.decodeTiff
instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
Readable (Auto TIF) (Image r cs e) where
decode f _ = fromEitherDecode f showJP fromAnyDynamicImage . JP.decodeTiff
encodeTIF :: forall r cs e. (ColorSpace cs e, Source r Ix2 (Pixel cs e))
=> Image r cs e -> Maybe BL.ByteString
encodeTIF img =
msum
[ do Refl <- eqT :: Maybe (cs :~: Y)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTiff $ toJPImageY8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodeTiff $ toJPImageY16 img
, return $ JP.encodeTiff $ toJPImageY16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: YA)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTiff $ toJPImageYA8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodeTiff $ toJPImageYA16 img
, return $ JP.encodeTiff $ toJPImageYA16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: RGB)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTiff $ toJPImageRGB8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodeTiff $ toJPImageRGB16 img
, return $ JP.encodeTiff $ toJPImageRGB16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: RGBA)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTiff $ toJPImageRGBA8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ JP.encodeTiff $ toJPImageRGBA16 img
, return $ JP.encodeTiff $ toJPImageRGBA16 $ M.map toWord16 img
]
, do Refl <- eqT :: Maybe (cs :~: YCbCr)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTiff $ toJPImageYCbCr8 img
, return $ JP.encodeTiff $ toJPImageYCbCr8 $ M.map toWord8 img
]
, do Refl <- eqT :: Maybe (cs :~: CMYK)
msum
[ do Refl <- eqT :: Maybe (e :~: Word8)
return $ JP.encodeTiff $ toJPImageCMYK8 img
, return $ JP.encodeTiff $ toJPImageCMYK8 $ M.map toWord8 img
]
]
encodeAuto
:: forall f r cs e a csY eY csYA eYA csC eC csCA eCA.
( ColorSpace cs e
, ColorSpace csC eC
, ColorSpace csCA eCA
, ColorSpace csY eY
, ColorSpace csYA eYA
, Source r Ix2 (Pixel cs e)
, FileFormat f
)
=> f
-> (forall r' cs' e'. (Source r' Ix2 (Pixel cs' e'), ColorSpace cs' e') =>
Image r' cs' e' -> Maybe a)
-> (Pixel cs e -> Pixel csY eY)
-> (Pixel cs e -> Pixel csYA eYA)
-> (Pixel cs e -> Pixel csC eC)
-> (Pixel cs e -> Pixel csCA eCA)
-> Image r cs e
-> a
encodeAuto f enc toLuma toLumaA toColor toColorA img =
fromMaybeEncode f (toProxy img) $ msum
[ enc img
, do Refl <- eqT :: Maybe (cs :~: Y)
enc $ M.map toLuma img
, do Refl <- eqT :: Maybe (cs :~: YA)
enc $ M.map toLumaA img
, do Refl <- eqT :: Maybe (cs :~: RGB)
enc $ M.map toColor img
, do Refl <- eqT :: Maybe (cs :~: RGBA)
enc $ M.map toColorA img
, do Refl <- eqT :: Maybe (cs :~: HSI)
enc $ M.map toColor img
, do Refl <- eqT :: Maybe (cs :~: HSIA)
enc $ M.map toColorA img
, do Refl <- eqT :: Maybe (cs :~: YCbCr)
enc $ M.map toColor img
, do Refl <- eqT :: Maybe (cs :~: YCbCrA)
enc $ M.map toColorA img
, do Refl <- eqT :: Maybe (cs :~: CMYK)
enc $ M.map toColor img
, do Refl <- eqT :: Maybe (cs :~: CMYKA)
enc $ M.map toColorA img
, do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel X Bit)
enc $ M.map fromPixelBinary img
]
elevate
:: forall cs e' e.
( Functor (Pixel cs)
, ColorSpace cs e'
, ColorSpace cs e
, Source D Ix2 (Pixel cs e')
)
=> Image D cs e' -> Maybe (Image D cs e)
elevate img =
msum
[ fmap (\Refl -> img) (eqT :: Maybe (e :~: e'))
, do Refl <- eqT :: Maybe (e :~: Word8)
return $ M.map toWord8 img
, do Refl <- eqT :: Maybe (e :~: Word16)
return $ M.map toWord16 img
, do Refl <- eqT :: Maybe (e :~: Word32)
return $ M.map toWord32 img
, do Refl <- eqT :: Maybe (e :~: Word64)
return $ M.map toWord64 img
, do Refl <- eqT :: Maybe (e :~: Double)
return $ M.map toDouble img
]
fromDynamicImage :: forall cs e . (ColorSpace cs e, Source S Ix2 (Pixel cs e))
=> JP.DynamicImage -> Maybe (Image S cs e)
fromDynamicImage jpDynImg =
case jpDynImg of
JP.ImageY8 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Word8)
fromJPImageUnsafe jimg
JP.ImageY16 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Word16)
fromJPImageUnsafe jimg
JP.ImageYF jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Float)
fromJPImageUnsafe jimg
JP.ImageYA8 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel YA Word8)
fromJPImageUnsafe jimg
JP.ImageYA16 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel YA Word16)
fromJPImageUnsafe jimg
JP.ImageRGB8 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGB Word8)
fromJPImageUnsafe jimg
JP.ImageRGB16 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGB Word16)
fromJPImageUnsafe jimg
JP.ImageRGBF jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGB Float)
fromJPImageUnsafe jimg
JP.ImageRGBA8 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGBA Word8)
fromJPImageUnsafe jimg
JP.ImageRGBA16 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGBA Word16)
fromJPImageUnsafe jimg
JP.ImageYCbCr8 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel YCbCr Word8)
fromJPImageUnsafe jimg
JP.ImageCMYK8 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CMYK Word8)
fromJPImageUnsafe jimg
JP.ImageCMYK16 jimg -> do
Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CMYK Word16)
fromJPImageUnsafe jimg
fromAnyDynamicImage :: (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) =>
JP.DynamicImage -> Maybe (Image r cs e)
fromAnyDynamicImage jpDynImg = do
case jpDynImg of
JP.ImageY8 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Word8)) >>= toAnyCS
JP.ImageY16 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Word16)) >>= toAnyCS
JP.ImageYF jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Float)) >>= toAnyCS
JP.ImageYA8 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S YA Word8)) >>= toAnyCS
JP.ImageYA16 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S YA Word16)) >>= toAnyCS
JP.ImageRGB8 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S RGB Word8)) >>= toAnyCS
JP.ImageRGB16 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S RGB Word16)) >>= toAnyCS
JP.ImageRGBF jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S RGB Float)) >>= toAnyCS
JP.ImageRGBA8 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S RGBA Word8)) >>= toAnyCS
JP.ImageRGBA16 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S RGBA Word16)) >>= toAnyCS
JP.ImageYCbCr8 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S YCbCr Word8)) >>= toAnyCS
JP.ImageCMYK8 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S CMYK Word8)) >>= toAnyCS
JP.ImageCMYK16 jimg -> (fromJPImageUnsafe jimg :: Maybe (Image S CMYK Word16)) >>= toAnyCS
toAnyCS
:: forall r' cs' e' r cs e.
( Source r' Ix2 (Pixel cs' e')
, Mutable r Ix2 (Pixel cs e)
, Storable (Pixel cs e)
, ColorSpace cs e
, ToYA cs' e'
, ToRGBA cs' e'
, ToHSIA cs' e'
, ToCMYKA cs' e'
, ToYCbCrA cs' e'
)
=> Image r' cs' e' -> Maybe (Image r cs e)
toAnyCS img =
msum
[ (\Refl -> computeSource img) <$>
(eqT :: Maybe (Pixel cs' e' :~: Pixel cs e))
, do Refl <- eqT :: Maybe (cs :~: Y)
compute <$> elevate (M.map toPixelY img)
, do Refl <- eqT :: Maybe (cs :~: YA)
compute <$> elevate (M.map toPixelYA img)
, do Refl <- eqT :: Maybe (cs :~: RGB)
compute <$> elevate (M.map toPixelRGB img)
, do Refl <- eqT :: Maybe (cs :~: RGBA)
compute <$> elevate (M.map toPixelRGBA img)
, do Refl <- eqT :: Maybe (cs :~: HSI)
compute <$> elevate (M.map toPixelHSI img)
, do Refl <- eqT :: Maybe (cs :~: HSIA)
compute <$> elevate (M.map toPixelHSIA img)
, do Refl <- eqT :: Maybe (cs :~: CMYK)
compute <$> elevate (M.map toPixelCMYK img)
, do Refl <- eqT :: Maybe (cs :~: CMYKA)
compute <$> elevate (M.map toPixelCMYKA img)
, do Refl <- eqT :: Maybe (cs :~: YCbCr)
compute <$> elevate (M.map toPixelYCbCr img)
, do Refl <- eqT :: Maybe (cs :~: YCbCrA)
compute <$> elevate (M.map toPixelYCbCrA img)
, do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel X Bit)
return $ compute $ M.map toPixelBinary img
]
showJP :: JP.DynamicImage -> String
showJP (JP.ImageY8 _) = "Image S Y Word8"
showJP (JP.ImageY16 _) = "Image S Y Word16"
showJP (JP.ImageYF _) = "Image S Y Float"
showJP (JP.ImageYA8 _) = "Image S YA Word8"
showJP (JP.ImageYA16 _) = "Image S YA Word16"
showJP (JP.ImageRGB8 _) = "Image S RGB Word8"
showJP (JP.ImageRGB16 _) = "Image S RGB Word16"
showJP (JP.ImageRGBF _) = "Image S RGB Float"
showJP (JP.ImageRGBA8 _) = "Image S RGBA Word8"
showJP (JP.ImageRGBA16 _) = "Image S RGBA Word16"
showJP (JP.ImageYCbCr8 _) = "Image S YCbCr Word8"
showJP (JP.ImageCMYK8 _) = "Image S CMYK Word8"
showJP (JP.ImageCMYK16 _) = "Image S CMYK Word16"
toJPImageUnsafe
:: forall r cs a . (JP.Pixel a, Source r Ix2 (Pixel cs (JP.PixelBaseComponent a)),
ColorSpace cs (JP.PixelBaseComponent a),
Storable (Pixel cs (JP.PixelBaseComponent a)))
=> Image r cs (JP.PixelBaseComponent a)
-> JP.Image a
toJPImageUnsafe img = JP.Image n m $ V.unsafeCast $ toVector arrS where
!arrS = computeSource img :: Image S cs (JP.PixelBaseComponent a)
(m :. n) = size img
toJPImageY8 :: Source r Ix2 (Pixel Y Word8) => Image r Y Word8 -> JP.Image JP.Pixel8
toJPImageY8 = toJPImageUnsafe
toJPImageY16 :: Source r Ix2 (Pixel Y Word16) => Image r Y Word16 -> JP.Image JP.Pixel16
toJPImageY16 = toJPImageUnsafe
toJPImageYA8 :: Source r Ix2 (Pixel YA Word8) => Image r YA Word8 -> JP.Image JP.PixelYA8
toJPImageYA8 = toJPImageUnsafe
toJPImageYA16 :: Source r Ix2 (Pixel YA Word16) => Image r YA Word16 -> JP.Image JP.PixelYA16
toJPImageYA16 = toJPImageUnsafe
toJPImageYF :: Source r Ix2 (Pixel Y Float) => Image r Y Float -> JP.Image JP.PixelF
toJPImageYF = toJPImageUnsafe
toJPImageRGB8 :: Source r Ix2 (Pixel RGB Word8) => Image r RGB Word8 -> JP.Image JP.PixelRGB8
toJPImageRGB8 = toJPImageUnsafe
toJPImageRGBA8 :: Source r Ix2 (Pixel RGBA Word8) => Image r RGBA Word8 -> JP.Image JP.PixelRGBA8
toJPImageRGBA8 = toJPImageUnsafe
toJPImageRGB16 :: Source r Ix2 (Pixel RGB Word16) => Image r RGB Word16 -> JP.Image JP.PixelRGB16
toJPImageRGB16 = toJPImageUnsafe
toJPImageRGBA16 :: Source r Ix2 (Pixel RGBA Word16) => Image r RGBA Word16 -> JP.Image JP.PixelRGBA16
toJPImageRGBA16 = toJPImageUnsafe
toJPImageRGBF :: Source r Ix2 (Pixel RGB Float) => Image r RGB Float -> JP.Image JP.PixelRGBF
toJPImageRGBF = toJPImageUnsafe
toJPImageYCbCr8 :: Source r Ix2 (Pixel YCbCr Word8) => Image r YCbCr Word8 -> JP.Image JP.PixelYCbCr8
toJPImageYCbCr8 = toJPImageUnsafe
toJPImageCMYK8 :: Source r Ix2 (Pixel CMYK Word8) => Image r CMYK Word8 -> JP.Image JP.PixelCMYK8
toJPImageCMYK8 = toJPImageUnsafe
fromJPImageUnsafe :: (Storable (Pixel cs e), JP.Pixel jpx) =>
JP.Image jpx -> Maybe (Image S cs e)
fromJPImageUnsafe (JP.Image n m !v) = do
guard (n * m /= V.length v)
return $ fromVector Seq (m :. n) $ V.unsafeCast v