module Codec.Picture.Repa
(
Img, imgData
, convertImage
, readImage, decodeImage
, readImageRGBA, readImageRGB, readImageR, readImageG, readImageB
, decodeImageRGBA, decodeImageRGB, decodeImageR, decodeImageG, decodeImageB
, RGBA, RGB, R, G, B
, toVector
, toForeignPtr
, reverseColorChannel
, flipHorizontally, flipVertically
, ToRGBAChannels(..)
) where
import qualified Data.Array.Repa as R
import qualified Data.Array.Repa.Repr.Unboxed as RU
import Data.Array.Repa ((:.), Array, (:.)(..), Z(..), DIM3, backpermute, extent)
import qualified Codec.Picture as P
import Codec.Picture hiding (readImage, decodeImage)
import Codec.Picture.Types hiding (convertImage)
import qualified Data.Vector.Storable as S
import Foreign.ForeignPtr
import Data.Word
import Control.Monad
import Data.ByteString as B
import qualified Data.Vector.Unboxed as VU
data R
data G
data B
data RGBA
data RGB
data Img a = Img { imgData :: Array RU.U DIM3 Word8 }
reverseColorChannel :: Img a -> Img a
reverseColorChannel (Img r) = Img (R.computeUnboxedS $ R.backpermute e order r)
where
e@(Z :. row :. col :. z) = R.extent r
order (Z :. r :. c :. z') = Z :. r :. c :. z z' 1
readImageRGBA :: FilePath -> IO (Either String (Img RGBA))
readImageRGBA f = do
x <- P.readImage f
return (fmap convertImage x)
readImageRGB :: FilePath -> IO (Either String (Img RGB))
readImageRGB f = do
x <- P.readImage f
return (fmap convertImage x)
readImageB :: FilePath -> IO (Either String (Img B))
readImageB f = do
x <- P.readImage f
return (fmap convertImage x)
readImageG :: FilePath -> IO (Either String (Img G))
readImageG f = do
x <- P.readImage f
return (fmap convertImage x)
readImageR :: FilePath -> IO (Either String (Img R))
readImageR f = do
x <- P.readImage f
return (fmap convertImage x)
decodeImageRGBA :: ByteString -> Either String (Img RGBA)
decodeImageRGBA = fmap convertImage . P.decodeImage
decodeImageRGB :: ByteString -> Either String (Img RGB)
decodeImageRGB = fmap convertImage . P.decodeImage
decodeImageR :: ByteString -> Either String (Img R)
decodeImageR = fmap convertImage . P.decodeImage
decodeImageG :: ByteString -> Either String (Img G)
decodeImageG = fmap convertImage . P.decodeImage
decodeImageB :: ByteString -> Either String (Img B)
decodeImageB = fmap convertImage . P.decodeImage
class DecodeImage a where
decodeImage :: ByteString -> Either String (Img a)
instance DecodeImage RGBA where
decodeImage = decodeImageRGBA
instance DecodeImage RGB where
decodeImage = decodeImageRGB
instance DecodeImage R where
decodeImage = decodeImageR
instance DecodeImage G where
decodeImage = decodeImageG
instance DecodeImage B where
decodeImage = decodeImageB
readImage :: DecodeImage a => FilePath -> IO (Either String (Img a))
readImage f = liftM decodeImage (B.readFile f)
toForeignPtr :: Img RGBA -> (ForeignPtr Word8, Int, Int)
toForeignPtr = S.unsafeToForeignPtr . S.convert . RU.toUnboxed . imgData
toVector :: Img a -> S.Vector Word8
toVector (Img a) = S.convert . RU.toUnboxed $ a
getChannel :: Int -> PixelRGBA8 -> Word8
getChannel 0 (PixelRGBA8 r g b a) = r
getChannel 1 (PixelRGBA8 r g b a) = g
getChannel 2 (PixelRGBA8 r g b a) = b
getChannel _ (PixelRGBA8 r g b a) = a
getChan :: (ToRGBAChannels p) => Int -> p -> Word8
getChan c = getChannel c . toRGBAChannels
getPixel :: (ToRGBAChannels p, Pixel p) => Int -> Int -> Int -> Image p -> Word8
getPixel x y z p = getChan z (pixelAt p x y)
class ToRGBAChannels a where
toRGBAChannels :: a -> PixelRGBA8
instance ToRGBAChannels PixelRGBA8 where
toRGBAChannels = id
instance ToRGBAChannels PixelYCbCr8 where
toRGBAChannels = promotePixel . (id :: PixelRGB8 -> PixelRGB8) . convertPixel
instance ToRGBAChannels PixelRGB8 where
toRGBAChannels = promotePixel
instance ToRGBAChannels PixelYA8 where
toRGBAChannels = promotePixel
instance ToRGBAChannels Pixel8 where
toRGBAChannels = promotePixel
class ConvertImage a b where
convertImage :: a -> Img b
instance ConvertImage DynamicImage RGBA where
convertImage (ImageY8 i) = convertImage i
convertImage (ImageYA8 i) = convertImage i
convertImage (ImageRGB8 i) = convertImage i
convertImage (ImageRGBA8 i) = convertImage i
convertImage (ImageYCbCr8 i) = convertImage i
instance ConvertImage DynamicImage RGB where
convertImage (ImageY8 i) = convertImage i
convertImage (ImageYA8 i) = convertImage i
convertImage (ImageRGB8 i) = convertImage i
convertImage (ImageRGBA8 i) = convertImage i
convertImage (ImageYCbCr8 i) = convertImage i
instance ConvertImage DynamicImage R where
convertImage (ImageY8 i) = convertImage i
convertImage (ImageYA8 i) = convertImage i
convertImage (ImageRGB8 i) = convertImage i
convertImage (ImageRGBA8 i) = convertImage i
convertImage (ImageYCbCr8 i) = convertImage i
instance ConvertImage DynamicImage G where
convertImage (ImageY8 i) = convertImage i
convertImage (ImageYA8 i) = convertImage i
convertImage (ImageRGB8 i) = convertImage i
convertImage (ImageRGBA8 i) = convertImage i
convertImage (ImageYCbCr8 i) = convertImage i
instance ConvertImage DynamicImage B where
convertImage (ImageY8 i) = convertImage i
convertImage (ImageYA8 i) = convertImage i
convertImage (ImageRGB8 i) = convertImage i
convertImage (ImageRGBA8 i) = convertImage i
convertImage (ImageYCbCr8 i) = convertImage i
instance (ToRGBAChannels a, Pixel a) => ConvertImage (Image a) RGBA where
convertImage p@(Image w h dat) =
let z = 4
in Img $ R.computeUnboxedS $ R.fromFunction (Z :. h :. w :. z)
(\(Z :. y :. x :. z') -> getPixel x y (z z' 1) p)
instance (ToRGBAChannels a, Pixel a) => ConvertImage (Image a) RGB where
convertImage p@(Image w h dat) =
let z = 3
in Img $ R.computeUnboxedS $ R.fromFunction (Z :. h :. w :. z)
(\(Z :. y :. x :. z') -> getPixel x y (z' z 1) p)
instance (ToRGBAChannels a, Pixel a) => ConvertImage (Image a) R where
convertImage p@(Image w h dat) =
let z = 1
in Img $ R.computeUnboxedS $ R.fromFunction (Z :. h :. w :. z)
(\(Z :. y :. x :. z) -> getPixel x y 0 p)
instance (ToRGBAChannels a, Pixel a) => ConvertImage (Image a) G where
convertImage p@(Image w h dat) =
let z = 1
in Img $ R.computeUnboxedS $ R.fromFunction (Z :. h :. w :. z)
(\(Z :. y :. x :. z) -> getPixel x y 1 p)
instance (ToRGBAChannels a, Pixel a) => ConvertImage (Image a) B where
convertImage p@(Image w h dat) =
let z = 1
in Img $ R.computeUnboxedS $ R.fromFunction (Z :. h :. w :. z)
(\(Z :. y :. x :. z) -> getPixel x y 2 p)
flipVertically :: Img a -> Img a
flipVertically (Img rp) = Img (R.computeUnboxedS $ backpermute e order rp)
where
e@(Z :. row :. col :. z) = extent rp
order (Z :. oldRow :. oldCol :. oldChan) = Z :. row oldRow 1 :. oldCol :. oldChan
flipHorizontally :: Img a -> Img b
flipHorizontally (Img rp) = Img (R.computeUnboxedS $ backpermute e order rp)
where
e@(Z :. row :. col :. z) = extent rp
order (Z :. oldRow :. oldCol :. oldChan) = Z :. oldRow :. col oldCol 1 :. oldChan