{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances #-}
module Codec.FFmpeg.Juicy where
import Codec.Picture
import Codec.FFmpeg.Common
import Codec.FFmpeg.Decode
import Codec.FFmpeg.Encode
import Codec.FFmpeg.Enums
import Codec.FFmpeg.Internal.Linear (V2(..))
import Codec.FFmpeg.Types
import Control.Arrow (first)
import Control.Monad ((>=>))
import Control.Monad.Except
import Control.Monad.Trans.Maybe
import Data.Foldable (traverse_)
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable.Mutable as VM
import Foreign.C.Types
import Foreign.Storable (sizeOf)
import Data.Maybe (maybe)
frameToVector :: AVFrame -> IO (Maybe (V.Vector CUChar))
frameToVector = runMaybeT . frameToVectorT
frameToVectorT :: AVFrame -> MaybeT IO (V.Vector CUChar)
frameToVectorT frame = do
bufSize <- fromIntegral <$> frameBufferSizeT frame
v <- MaybeT $ do
v <- VM.new bufSize
VM.unsafeWith v (frameCopyToBuffer frame)
>>= return . maybe Nothing (const (Just v))
lift $ V.unsafeFreeze v
toJuicyT :: AVFrame -> MaybeT IO DynamicImage
toJuicyT = MaybeT . toJuicy
toJuicy :: AVFrame -> IO (Maybe DynamicImage)
toJuicy frame = runMaybeT $ do
v <- frameToVectorT frame
MaybeT $ do
w <- fromIntegral <$> getWidth frame
h <- fromIntegral <$> getHeight frame
let mkImage :: V.Storable (PixelBaseComponent a)
=> (Image a -> DynamicImage) -> Maybe DynamicImage
mkImage c = Just $ c (Image w h (V.unsafeCast v))
fmt <- getPixelFormat frame
return $ case () of
_ | fmt == avPixFmtRgb24 -> mkImage ImageRGB8
| fmt == avPixFmtGray8 -> mkImage ImageY8
| fmt == avPixFmtGray16 -> mkImage ImageY16
| otherwise -> Nothing
toJuicyImage :: forall p. JuicyPixelFormat p => AVFrame -> IO (Maybe (Image p))
toJuicyImage frame = runMaybeT $ do
fmt <- lift $ getPixelFormat frame
guard (fmt == juicyPixelFormat ([] :: [p]))
MaybeT $ do
w <- fromIntegral <$> getWidth frame
h <- fromIntegral <$> getHeight frame
fmap (Image w h . V.unsafeCast) <$> frameToVector frame
saveJuicy :: FilePath -> AVFrame -> IO ()
saveJuicy name = toJuicy >=> traverse_ (savePngImage name)
class Pixel a => JuicyPixelFormat a where
juicyPixelFormat :: proxy a -> AVPixelFormat
instance JuicyPixelFormat Pixel8 where
juicyPixelFormat _ = avPixFmtGray8
instance JuicyPixelFormat PixelRGB8 where
juicyPixelFormat _ = avPixFmtRgb24
instance JuicyPixelFormat PixelRGBA8 where
juicyPixelFormat _ = avPixFmtRgba
juicyPixelStride :: forall a proxy. Pixel a => proxy a -> Int
juicyPixelStride _ =
sizeOf (undefined :: PixelBaseComponent a) * componentCount (undefined :: a)
imageReaderT :: forall m p.
(Functor m, MonadIO m, MonadError String m,
JuicyPixelFormat p)
=> InputSource -> m (IO (Maybe (Image p)), IO ())
imageReaderT = fmap (first (runMaybeT . aux toJuicyImage))
. frameReader (juicyPixelFormat ([] :: [p]))
where aux g x = MaybeT x >>= MaybeT . g
imageReader :: JuicyPixelFormat p
=> InputSource -> IO (IO (Maybe (Image p)), IO ())
imageReader = (>>= either error return) . runExceptT . imageReaderT
imageReaderTimeT :: forall m p.
(Functor m, MonadIO m, MonadError String m,
JuicyPixelFormat p)
=> InputSource -> m (IO (Maybe (Image p, Double)), IO ())
imageReaderTimeT = fmap (first (runMaybeT . aux toJuicyImage))
. frameReaderTime (juicyPixelFormat ([] :: [p]))
where aux g x = do (f,t) <- MaybeT x
f' <- MaybeT $ g f
return (f', t)
imageReaderTime :: JuicyPixelFormat p
=> InputSource -> IO (IO (Maybe (Image p, Double)), IO ())
imageReaderTime = (>>= either error return) . runExceptT . imageReaderTimeT
imageWriter :: forall p. JuicyPixelFormat p
=> EncodingParams -> FilePath -> IO (Maybe (Image p) -> IO ())
imageWriter ep f = (. fmap aux) <$> frameWriter ep f
where aux img = let w = fromIntegral $ imageWidth img
h = fromIntegral $ imageHeight img
p = V.unsafeCast $ imageData img
in (juicyPixelFormat ([]::[p]), V2 w h, p)