{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Codec.Picture.WebP ( decodeRgb8
, decodeRgba8
, encodeRgb8Lossless
, encodeRgba8Lossless
, encodeRgb8
, encodeRgba8
) where
import Codec.Picture (Image (Image), PixelBaseComponent,
PixelRGB8, PixelRGBA8)
import Control.Applicative (pure, (<*>))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Functor ((<$>))
import Data.Vector.Storable (Vector, unsafeFromForeignPtr0,
unsafeWith)
import Data.Word (Word8)
import Foreign.C.Types (CChar, CFloat, CInt, CSize)
import Foreign.ForeignPtr (newForeignPtr)
import Foreign.Ptr (Ptr, castPtr)
import System.IO.Unsafe (unsafePerformIO)
import WebP.Decode
import WebP.Encode
import WebP.Types
decodeRgb8 :: BS.ByteString -> Image PixelRGB8
decodeRgb8 :: ByteString -> Image PixelRGB8
decodeRgb8 = forall p.
(PixelBaseComponent p ~ Word8) =>
(ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decodeRgb8BS
decodeRgba8 :: BS.ByteString -> Image PixelRGBA8
decodeRgba8 :: ByteString -> Image PixelRGBA8
decodeRgba8 = forall p.
(PixelBaseComponent p ~ Word8) =>
(ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decodeRgba8BS
encodeRgba8 :: CFloat
-> Image PixelRGBA8 -> BS.ByteString
encodeRgba8 :: CFloat -> Image PixelRGBA8 -> ByteString
encodeRgba8 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> CFloat -> ByteString
encodeJuicyPixels Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
webPEncodeRGBA Int
4)
encodeRgb8 :: CFloat
-> Image PixelRGB8 -> BS.ByteString
encodeRgb8 :: CFloat -> Image PixelRGB8 -> ByteString
encodeRgb8 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> CFloat -> ByteString
encodeJuicyPixels Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
webPEncodeRGB Int
3)
encodeRgb8Lossless :: Image PixelRGB8 -> BS.ByteString
encodeRgb8Lossless :: Image PixelRGB8 -> ByteString
encodeRgb8Lossless = forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> ByteString
encodeJuicyPixelsLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
webPEncodeLosslessRGB Int
3
encodeRgba8Lossless :: Image PixelRGBA8 -> BS.ByteString
encodeRgba8Lossless :: Image PixelRGBA8 -> ByteString
encodeRgba8Lossless = forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> ByteString
encodeJuicyPixelsLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
webPEncodeLosslessRGBA Int
4
encodeJuicyPixels :: (PixelBaseComponent p ~ Word8)
=> (Ptr UInt8 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int
-> Image p
-> CFloat
-> BS.ByteString
encodeJuicyPixels :: forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> CFloat -> ByteString
encodeJuicyPixels Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder Int
pxFactor Image p
img = (Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> CFloat -> ByteString
encodeAbsBS Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder Int
w Int
h Vector (PixelBaseComponent p)
bytes Int
pxFactor
where (Image Int
w Int
h Vector (PixelBaseComponent p)
bytes) = Image p
img
encodeJuicyPixelsLossless :: (PixelBaseComponent p ~ Word8)
=> (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int
-> Image p
-> BS.ByteString
encodeJuicyPixelsLossless :: forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> ByteString
encodeJuicyPixelsLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder Int
pxFactor Image p
img = (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> ByteString
encodeAbsBSLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder Int
w Int
h Vector (PixelBaseComponent p)
bytes Int
pxFactor
where (Image Int
w Int
h Vector (PixelBaseComponent p)
bytes) = Image p
img
decodeJuicyPixels :: (PixelBaseComponent p ~ Word8)
=> (BS.ByteString -> (CInt, CInt, BS.ByteString))
-> BS.ByteString
-> Image p
decodeJuicyPixels :: forall p.
(PixelBaseComponent p ~ Word8) =>
(ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decoder = (\(CInt
w, CInt
h, ByteString
img) -> forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h) (ByteString -> Vector Word8
bytesToVec ByteString
img)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CInt, CInt, ByteString)
decoder
where bytesToVec :: ByteString -> Vector Word8
bytesToVec = \(BS.PS ForeignPtr Word8
fp Int
_ Int
l) -> forall a. ForeignPtr a -> Int -> Vector a
unsafeFromForeignPtr0 ForeignPtr Word8
fp Int
l
decodeRgb8BS :: BS.ByteString -> (CInt, CInt, BS.ByteString)
decodeRgb8BS :: ByteString -> (CInt, CInt, ByteString)
decodeRgb8BS = (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt -> ByteString -> (CInt, CInt, ByteString)
decodeAbsBS forall a. Ptr a -> CSize -> IO (Ptr UInt8, CInt, CInt)
webPDecodeRGB CInt
3
decodeRgba8BS :: BS.ByteString -> (CInt, CInt, BS.ByteString)
decodeRgba8BS :: ByteString -> (CInt, CInt, ByteString)
decodeRgba8BS = (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt -> ByteString -> (CInt, CInt, ByteString)
decodeAbsBS forall a. Ptr a -> CSize -> IO (Ptr UInt8, CInt, CInt)
webPDecodeRGBA CInt
4
{-# NOINLINE decodeAbsBS #-}
decodeAbsBS :: (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt
-> BS.ByteString
-> (CInt, CInt, BS.ByteString)
decodeAbsBS :: (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt -> ByteString -> (CInt, CInt, ByteString)
decodeAbsBS Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt)
decoder CInt
pxFactor ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
l) -> do
(Ptr UInt8
res, CInt
h, CInt
w) <- Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt)
decoder Ptr CChar
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
let sz :: CInt
sz = CInt
pxFactor forall a. Num a => a -> a -> a
* CInt
w forall a. Num a => a -> a -> a
* CInt
h
ByteString
img <- ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
webPFree (forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sz)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt
w, CInt
h, ByteString
img)
{-# NOINLINE encodeAbsBSLossless #-}
encodeAbsBSLossless :: (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int
-> Int
-> Vector Word8
-> Int
-> BS.ByteString
encodeAbsBSLossless :: (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> ByteString
encodeAbsBSLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder Int
w Int
h Vector Word8
datums Int
pxFactor =
forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith Vector Word8
datums forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
(CSize
resSz, Ptr UInt8
res) <- Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
pxFactor forall a. Num a => a -> a -> a
* Int
w)
ForeignPtr Word8
fP <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
webPFree (forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fP Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
resSz))
{-# NOINLINE encodeAbsBS #-}
encodeAbsBS :: (Ptr UInt8 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int
-> Int
-> Vector Word8
-> Int
-> CFloat
-> BS.ByteString
encodeAbsBS :: (Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> CFloat -> ByteString
encodeAbsBS Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder Int
w Int
h Vector Word8
datums Int
pxFactor CFloat
quality =
forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith Vector Word8
datums forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
(CSize
resSz, Ptr UInt8
res) <- Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
pxFactor forall a. Num a => a -> a -> a
* Int
w) CFloat
quality
ForeignPtr Word8
fP <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
webPFree (forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fP Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
resSz))