{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances #-}
-- | Convert between FFmpeg frames and JuicyPixels images.
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)


-- | Convert 'AVFrame' to a 'Vector'.
frameToVector :: AVFrame -> IO (Maybe (V.Vector CUChar))
frameToVector :: AVFrame -> IO (Maybe (Vector CUChar))
frameToVector = MaybeT IO (Vector CUChar) -> IO (Maybe (Vector CUChar))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Vector CUChar) -> IO (Maybe (Vector CUChar)))
-> (AVFrame -> MaybeT IO (Vector CUChar))
-> AVFrame
-> IO (Maybe (Vector CUChar))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVFrame -> MaybeT IO (Vector CUChar)
frameToVectorT


-- | Convert 'AVFrame' to a 'Vector' with the result in the 'MaybeT' transformer.
frameToVectorT :: AVFrame -> MaybeT IO (V.Vector CUChar)
frameToVectorT :: AVFrame -> MaybeT IO (Vector CUChar)
frameToVectorT frame :: AVFrame
frame = do

  Int
bufSize <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> MaybeT IO CInt -> MaybeT IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AVFrame -> MaybeT IO CInt
frameBufferSizeT AVFrame
frame

  IOVector CUChar
v <- IO (Maybe (IOVector CUChar)) -> MaybeT IO (IOVector CUChar)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (IOVector CUChar)) -> MaybeT IO (IOVector CUChar))
-> IO (Maybe (IOVector CUChar)) -> MaybeT IO (IOVector CUChar)
forall a b. (a -> b) -> a -> b
$ do

         IOVector CUChar
v <- Int -> IO (MVector (PrimState IO) CUChar)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VM.new Int
bufSize

         IOVector CUChar
-> (Ptr CUChar -> IO (Maybe CInt)) -> IO (Maybe CInt)
forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VM.unsafeWith IOVector CUChar
v (AVFrame -> Ptr CUChar -> IO (Maybe CInt)
frameCopyToBuffer AVFrame
frame)
           IO (Maybe CInt)
-> (Maybe CInt -> IO (Maybe (IOVector CUChar)))
-> IO (Maybe (IOVector CUChar))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (IOVector CUChar) -> IO (Maybe (IOVector CUChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IOVector CUChar) -> IO (Maybe (IOVector CUChar)))
-> (Maybe CInt -> Maybe (IOVector CUChar))
-> Maybe CInt
-> IO (Maybe (IOVector CUChar))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (IOVector CUChar)
-> (CInt -> Maybe (IOVector CUChar))
-> Maybe CInt
-> Maybe (IOVector CUChar)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (IOVector CUChar)
forall a. Maybe a
Nothing (Maybe (IOVector CUChar) -> CInt -> Maybe (IOVector CUChar)
forall a b. a -> b -> a
const (IOVector CUChar -> Maybe (IOVector CUChar)
forall a. a -> Maybe a
Just IOVector CUChar
v))

  IO (Vector CUChar) -> MaybeT IO (Vector CUChar)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Vector CUChar) -> MaybeT IO (Vector CUChar))
-> IO (Vector CUChar) -> MaybeT IO (Vector CUChar)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState IO) CUChar -> IO (Vector CUChar)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze IOVector CUChar
MVector (PrimState IO) CUChar
v


-- | Convert an 'AVFrame' to a 'DynamicImage' with the result in the
-- 'MaybeT' transformer.
--
-- > toJuicyT = MaybeT . toJuicy
toJuicyT :: AVFrame -> MaybeT IO DynamicImage
toJuicyT :: AVFrame -> MaybeT IO DynamicImage
toJuicyT = IO (Maybe DynamicImage) -> MaybeT IO DynamicImage
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe DynamicImage) -> MaybeT IO DynamicImage)
-> (AVFrame -> IO (Maybe DynamicImage))
-> AVFrame
-> MaybeT IO DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVFrame -> IO (Maybe DynamicImage)
toJuicy


-- | Convert an 'AVFrame' to a 'DynamicImage'.
toJuicy :: AVFrame -> IO (Maybe DynamicImage)
toJuicy :: AVFrame -> IO (Maybe DynamicImage)
toJuicy frame :: AVFrame
frame = MaybeT IO DynamicImage -> IO (Maybe DynamicImage)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO DynamicImage -> IO (Maybe DynamicImage))
-> MaybeT IO DynamicImage -> IO (Maybe DynamicImage)
forall a b. (a -> b) -> a -> b
$ do

  Vector CUChar
v <- AVFrame -> MaybeT IO (Vector CUChar)
frameToVectorT AVFrame
frame

  IO (Maybe DynamicImage) -> MaybeT IO DynamicImage
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe DynamicImage) -> MaybeT IO DynamicImage)
-> IO (Maybe DynamicImage) -> MaybeT IO DynamicImage
forall a b. (a -> b) -> a -> b
$ do

    Int
w <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AVFrame -> IO CInt
forall t. HasWidth t => t -> IO CInt
getWidth AVFrame
frame
    Int
h <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AVFrame -> IO CInt
forall t. HasHeight t => t -> IO CInt
getHeight AVFrame
frame

    let mkImage :: V.Storable (PixelBaseComponent a)
                => (Image a -> DynamicImage) -> Maybe DynamicImage
        mkImage :: (Image a -> DynamicImage) -> Maybe DynamicImage
mkImage c :: Image a -> DynamicImage
c = DynamicImage -> Maybe DynamicImage
forall a. a -> Maybe a
Just (DynamicImage -> Maybe DynamicImage)
-> DynamicImage -> Maybe DynamicImage
forall a b. (a -> b) -> a -> b
$ Image a -> DynamicImage
c (Int -> Int -> Vector (PixelBaseComponent a) -> Image a
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h (Vector CUChar -> Vector (PixelBaseComponent a)
forall a b. (Storable a, Storable b) => Vector a -> Vector b
V.unsafeCast Vector CUChar
v))

    AVPixelFormat
fmt <- AVFrame -> IO AVPixelFormat
forall t. HasPixelFormat t => t -> IO AVPixelFormat
getPixelFormat AVFrame
frame

    Maybe DynamicImage -> IO (Maybe DynamicImage)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DynamicImage -> IO (Maybe DynamicImage))
-> Maybe DynamicImage -> IO (Maybe DynamicImage)
forall a b. (a -> b) -> a -> b
$ case () of
               _ | AVPixelFormat
fmt AVPixelFormat -> AVPixelFormat -> Bool
forall a. Eq a => a -> a -> Bool
== AVPixelFormat
avPixFmtRgb24 -> (Image PixelRGB8 -> DynamicImage) -> Maybe DynamicImage
forall a.
Storable (PixelBaseComponent a) =>
(Image a -> DynamicImage) -> Maybe DynamicImage
mkImage Image PixelRGB8 -> DynamicImage
ImageRGB8
                 | AVPixelFormat
fmt AVPixelFormat -> AVPixelFormat -> Bool
forall a. Eq a => a -> a -> Bool
== AVPixelFormat
avPixFmtGray8 -> (Image Pixel8 -> DynamicImage) -> Maybe DynamicImage
forall a.
Storable (PixelBaseComponent a) =>
(Image a -> DynamicImage) -> Maybe DynamicImage
mkImage Image Pixel8 -> DynamicImage
ImageY8
                 | AVPixelFormat
fmt AVPixelFormat -> AVPixelFormat -> Bool
forall a. Eq a => a -> a -> Bool
== AVPixelFormat
avPixFmtGray16 -> (Image Pixel16 -> DynamicImage) -> Maybe DynamicImage
forall a.
Storable (PixelBaseComponent a) =>
(Image a -> DynamicImage) -> Maybe DynamicImage
mkImage Image Pixel16 -> DynamicImage
ImageY16
                 | Bool
otherwise -> Maybe DynamicImage
forall a. Maybe a
Nothing


-- | Convert an 'AVFrame' to an 'Image'.
toJuicyImage :: forall p. JuicyPixelFormat p => AVFrame -> IO (Maybe (Image p))
toJuicyImage :: AVFrame -> IO (Maybe (Image p))
toJuicyImage frame :: AVFrame
frame = MaybeT IO (Image p) -> IO (Maybe (Image p))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Image p) -> IO (Maybe (Image p)))
-> MaybeT IO (Image p) -> IO (Maybe (Image p))
forall a b. (a -> b) -> a -> b
$ do

  AVPixelFormat
fmt <- IO AVPixelFormat -> MaybeT IO AVPixelFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AVPixelFormat -> MaybeT IO AVPixelFormat)
-> IO AVPixelFormat -> MaybeT IO AVPixelFormat
forall a b. (a -> b) -> a -> b
$ AVFrame -> IO AVPixelFormat
forall t. HasPixelFormat t => t -> IO AVPixelFormat
getPixelFormat AVFrame
frame
  Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AVPixelFormat
fmt AVPixelFormat -> AVPixelFormat -> Bool
forall a. Eq a => a -> a -> Bool
== [p] -> AVPixelFormat
forall a (proxy :: * -> *).
JuicyPixelFormat a =>
proxy a -> AVPixelFormat
juicyPixelFormat ([] :: [p]))

  IO (Maybe (Image p)) -> MaybeT IO (Image p)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (Image p)) -> MaybeT IO (Image p))
-> IO (Maybe (Image p)) -> MaybeT IO (Image p)
forall a b. (a -> b) -> a -> b
$ do

    Int
w <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AVFrame -> IO CInt
forall t. HasWidth t => t -> IO CInt
getWidth AVFrame
frame
    Int
h <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AVFrame -> IO CInt
forall t. HasHeight t => t -> IO CInt
getHeight AVFrame
frame

    (Vector CUChar -> Image p)
-> Maybe (Vector CUChar) -> Maybe (Image p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Vector (PixelBaseComponent p) -> Image p
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h (Vector (PixelBaseComponent p) -> Image p)
-> (Vector CUChar -> Vector (PixelBaseComponent p))
-> Vector CUChar
-> Image p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector CUChar -> Vector (PixelBaseComponent p)
forall a b. (Storable a, Storable b) => Vector a -> Vector b
V.unsafeCast) (Maybe (Vector CUChar) -> Maybe (Image p))
-> IO (Maybe (Vector CUChar)) -> IO (Maybe (Image p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AVFrame -> IO (Maybe (Vector CUChar))
frameToVector AVFrame
frame


-- | Save an 'AVFrame' to a PNG file on disk assuming the frame could
-- be converted to a 'DynamicImage' using 'toJuicy'.
saveJuicy :: FilePath -> AVFrame -> IO ()
saveJuicy :: FilePath -> AVFrame -> IO ()
saveJuicy name :: FilePath
name = AVFrame -> IO (Maybe DynamicImage)
toJuicy (AVFrame -> IO (Maybe DynamicImage))
-> (Maybe DynamicImage -> IO ()) -> AVFrame -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (DynamicImage -> IO ()) -> Maybe DynamicImage -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> DynamicImage -> IO ()
savePngImage FilePath
name)


-- | Mapping of @JuicyPixels@ pixel types to FFmpeg pixel formats.
class Pixel a => JuicyPixelFormat a where
  juicyPixelFormat :: proxy a -> AVPixelFormat

instance JuicyPixelFormat Pixel8 where
  juicyPixelFormat :: proxy Pixel8 -> AVPixelFormat
juicyPixelFormat _ = AVPixelFormat
avPixFmtGray8

instance JuicyPixelFormat PixelRGB8 where
  juicyPixelFormat :: proxy PixelRGB8 -> AVPixelFormat
juicyPixelFormat _ = AVPixelFormat
avPixFmtRgb24

instance JuicyPixelFormat PixelRGBA8 where
  juicyPixelFormat :: proxy PixelRGBA8 -> AVPixelFormat
juicyPixelFormat _ = AVPixelFormat
avPixFmtRgba

-- | Bytes-per-pixel for a JuicyPixels 'Pixel' type.
juicyPixelStride :: forall a proxy. Pixel a => proxy a -> Int
juicyPixelStride :: proxy a -> Int
juicyPixelStride _ =
  PixelBaseComponent a -> Int
forall a. Storable a => a -> Int
sizeOf (PixelBaseComponent a
forall a. HasCallStack => a
undefined :: PixelBaseComponent a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Pixel a => a -> Int
componentCount (a
forall a. HasCallStack => a
undefined :: a)

-- | Read frames from a video stream.
imageReaderT :: forall m p.
                (Functor m, MonadIO m, MonadError String m,
                 JuicyPixelFormat p)
             => InputSource -> m (IO (Maybe (Image p)), IO ())
imageReaderT :: InputSource -> m (IO (Maybe (Image p)), IO ())
imageReaderT = ((IO (Maybe AVFrame), IO ()) -> (IO (Maybe (Image p)), IO ()))
-> m (IO (Maybe AVFrame), IO ()) -> m (IO (Maybe (Image p)), IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IO (Maybe AVFrame) -> IO (Maybe (Image p)))
-> (IO (Maybe AVFrame), IO ()) -> (IO (Maybe (Image p)), IO ())
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (MaybeT IO (Image p) -> IO (Maybe (Image p))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Image p) -> IO (Maybe (Image p)))
-> (IO (Maybe AVFrame) -> MaybeT IO (Image p))
-> IO (Maybe AVFrame)
-> IO (Maybe (Image p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AVFrame -> IO (Maybe (Image p)))
-> IO (Maybe AVFrame) -> MaybeT IO (Image p)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> m (Maybe a) -> MaybeT m b
aux AVFrame -> IO (Maybe (Image p))
forall p. JuicyPixelFormat p => AVFrame -> IO (Maybe (Image p))
toJuicyImage))
            (m (IO (Maybe AVFrame), IO ()) -> m (IO (Maybe (Image p)), IO ()))
-> (InputSource -> m (IO (Maybe AVFrame), IO ()))
-> InputSource
-> m (IO (Maybe (Image p)), IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVPixelFormat -> InputSource -> m (IO (Maybe AVFrame), IO ())
forall (m :: * -> *).
(MonadIO m, MonadError FilePath m) =>
AVPixelFormat -> InputSource -> m (IO (Maybe AVFrame), IO ())
frameReader ([p] -> AVPixelFormat
forall a (proxy :: * -> *).
JuicyPixelFormat a =>
proxy a -> AVPixelFormat
juicyPixelFormat ([] :: [p]))
  where aux :: (a -> m (Maybe b)) -> m (Maybe a) -> MaybeT m b
aux g :: a -> m (Maybe b)
g x :: m (Maybe a)
x = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe a)
x MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b)
-> (a -> m (Maybe b)) -> a -> MaybeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe b)
g

-- | Read frames from a video stream. Errors are thrown as
-- 'IOException's.
imageReader :: JuicyPixelFormat p
            => InputSource -> IO (IO (Maybe (Image p)), IO ())
imageReader :: InputSource -> IO (IO (Maybe (Image p)), IO ())
imageReader = (IO (Either FilePath (IO (Maybe (Image p)), IO ()))
-> (Either FilePath (IO (Maybe (Image p)), IO ())
    -> IO (IO (Maybe (Image p)), IO ()))
-> IO (IO (Maybe (Image p)), IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO (IO (Maybe (Image p)), IO ()))
-> ((IO (Maybe (Image p)), IO ())
    -> IO (IO (Maybe (Image p)), IO ()))
-> Either FilePath (IO (Maybe (Image p)), IO ())
-> IO (IO (Maybe (Image p)), IO ())
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO (IO (Maybe (Image p)), IO ())
forall a. HasCallStack => FilePath -> a
error (IO (Maybe (Image p)), IO ()) -> IO (IO (Maybe (Image p)), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return) (IO (Either FilePath (IO (Maybe (Image p)), IO ()))
 -> IO (IO (Maybe (Image p)), IO ()))
-> (InputSource
    -> IO (Either FilePath (IO (Maybe (Image p)), IO ())))
-> InputSource
-> IO (IO (Maybe (Image p)), IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT FilePath IO (IO (Maybe (Image p)), IO ())
-> IO (Either FilePath (IO (Maybe (Image p)), IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO (IO (Maybe (Image p)), IO ())
 -> IO (Either FilePath (IO (Maybe (Image p)), IO ())))
-> (InputSource
    -> ExceptT FilePath IO (IO (Maybe (Image p)), IO ()))
-> InputSource
-> IO (Either FilePath (IO (Maybe (Image p)), IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputSource -> ExceptT FilePath IO (IO (Maybe (Image p)), IO ())
forall (m :: * -> *) p.
(Functor m, MonadIO m, MonadError FilePath m,
 JuicyPixelFormat p) =>
InputSource -> m (IO (Maybe (Image p)), IO ())
imageReaderT

-- | Read time stamped frames from a video stream. Time is given in
-- seconds from the start of the stream.
imageReaderTimeT :: forall m p.
                    (Functor m, MonadIO m, MonadError String m,
                     JuicyPixelFormat p)
                 => InputSource -> m (IO (Maybe (Image p, Double)), IO ())
imageReaderTimeT :: InputSource -> m (IO (Maybe (Image p, Double)), IO ())
imageReaderTimeT = ((IO (Maybe (AVFrame, Double)), IO ())
 -> (IO (Maybe (Image p, Double)), IO ()))
-> m (IO (Maybe (AVFrame, Double)), IO ())
-> m (IO (Maybe (Image p, Double)), IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IO (Maybe (AVFrame, Double)) -> IO (Maybe (Image p, Double)))
-> (IO (Maybe (AVFrame, Double)), IO ())
-> (IO (Maybe (Image p, Double)), IO ())
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (MaybeT IO (Image p, Double) -> IO (Maybe (Image p, Double))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Image p, Double) -> IO (Maybe (Image p, Double)))
-> (IO (Maybe (AVFrame, Double)) -> MaybeT IO (Image p, Double))
-> IO (Maybe (AVFrame, Double))
-> IO (Maybe (Image p, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AVFrame -> IO (Maybe (Image p)))
-> IO (Maybe (AVFrame, Double)) -> MaybeT IO (Image p, Double)
forall (m :: * -> *) t a b.
Monad m =>
(t -> m (Maybe a)) -> m (Maybe (t, b)) -> MaybeT m (a, b)
aux AVFrame -> IO (Maybe (Image p))
forall p. JuicyPixelFormat p => AVFrame -> IO (Maybe (Image p))
toJuicyImage))
                 (m (IO (Maybe (AVFrame, Double)), IO ())
 -> m (IO (Maybe (Image p, Double)), IO ()))
-> (InputSource -> m (IO (Maybe (AVFrame, Double)), IO ()))
-> InputSource
-> m (IO (Maybe (Image p, Double)), IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVPixelFormat
-> InputSource -> m (IO (Maybe (AVFrame, Double)), IO ())
forall (m :: * -> *).
(MonadIO m, MonadError FilePath m) =>
AVPixelFormat
-> InputSource -> m (IO (Maybe (AVFrame, Double)), IO ())
frameReaderTime ([p] -> AVPixelFormat
forall a (proxy :: * -> *).
JuicyPixelFormat a =>
proxy a -> AVPixelFormat
juicyPixelFormat ([] :: [p]))
  where aux :: (t -> m (Maybe a)) -> m (Maybe (t, b)) -> MaybeT m (a, b)
aux g :: t -> m (Maybe a)
g x :: m (Maybe (t, b))
x = do (f :: t
f,t :: b
t) <- m (Maybe (t, b)) -> MaybeT m (t, b)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe (t, b))
x
                     a
f' <- m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ t -> m (Maybe a)
g t
f
                     (a, b) -> MaybeT m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
f', b
t)

-- | Read time stamped frames from a video stream. Time is given in
-- seconds from the start of the stream. Errors are thrown as
-- 'IOException's.
imageReaderTime :: JuicyPixelFormat p
                => InputSource -> IO (IO (Maybe (Image p, Double)), IO ())
imageReaderTime :: InputSource -> IO (IO (Maybe (Image p, Double)), IO ())
imageReaderTime = (IO (Either FilePath (IO (Maybe (Image p, Double)), IO ()))
-> (Either FilePath (IO (Maybe (Image p, Double)), IO ())
    -> IO (IO (Maybe (Image p, Double)), IO ()))
-> IO (IO (Maybe (Image p, Double)), IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO (IO (Maybe (Image p, Double)), IO ()))
-> ((IO (Maybe (Image p, Double)), IO ())
    -> IO (IO (Maybe (Image p, Double)), IO ()))
-> Either FilePath (IO (Maybe (Image p, Double)), IO ())
-> IO (IO (Maybe (Image p, Double)), IO ())
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO (IO (Maybe (Image p, Double)), IO ())
forall a. HasCallStack => FilePath -> a
error (IO (Maybe (Image p, Double)), IO ())
-> IO (IO (Maybe (Image p, Double)), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return) (IO (Either FilePath (IO (Maybe (Image p, Double)), IO ()))
 -> IO (IO (Maybe (Image p, Double)), IO ()))
-> (InputSource
    -> IO (Either FilePath (IO (Maybe (Image p, Double)), IO ())))
-> InputSource
-> IO (IO (Maybe (Image p, Double)), IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT FilePath IO (IO (Maybe (Image p, Double)), IO ())
-> IO (Either FilePath (IO (Maybe (Image p, Double)), IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO (IO (Maybe (Image p, Double)), IO ())
 -> IO (Either FilePath (IO (Maybe (Image p, Double)), IO ())))
-> (InputSource
    -> ExceptT FilePath IO (IO (Maybe (Image p, Double)), IO ()))
-> InputSource
-> IO (Either FilePath (IO (Maybe (Image p, Double)), IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputSource
-> ExceptT FilePath IO (IO (Maybe (Image p, Double)), IO ())
forall (m :: * -> *) p.
(Functor m, MonadIO m, MonadError FilePath m,
 JuicyPixelFormat p) =>
InputSource -> m (IO (Maybe (Image p, Double)), IO ())
imageReaderTimeT

-- | Open a target file for writing a video stream. When the returned
-- function is applied to 'Nothing', the output stream is closed. Note
-- that 'Nothing' /must/ be provided when finishing in order to
-- properly terminate video encoding.
--
-- Support for source images that are of a different size to the
-- output resolution is limited to non-palettized destination formats
-- (i.e. those that are handled by @libswscaler@). Practically, this
-- means that animated gif output is only supported if the source
-- images are of the target resolution.
imageWriter :: forall p. JuicyPixelFormat p
            => EncodingParams -> FilePath -> IO (Maybe (Image p) -> IO ())
imageWriter :: EncodingParams -> FilePath -> IO (Maybe (Image p) -> IO ())
imageWriter ep :: EncodingParams
ep f :: FilePath
f = ((Maybe (AVPixelFormat, V2 CInt, Vector CUChar) -> IO ())
-> (Maybe (Image p)
    -> Maybe (AVPixelFormat, V2 CInt, Vector CUChar))
-> Maybe (Image p)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Image p -> (AVPixelFormat, V2 CInt, Vector CUChar))
-> Maybe (Image p) -> Maybe (AVPixelFormat, V2 CInt, Vector CUChar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Image p -> (AVPixelFormat, V2 CInt, Vector CUChar)
forall a b a.
(Storable (PixelBaseComponent a), Storable b, Num a) =>
Image a -> (AVPixelFormat, V2 a, Vector b)
aux) ((Maybe (AVPixelFormat, V2 CInt, Vector CUChar) -> IO ())
 -> Maybe (Image p) -> IO ())
-> IO (Maybe (AVPixelFormat, V2 CInt, Vector CUChar) -> IO ())
-> IO (Maybe (Image p) -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncodingParams
-> FilePath
-> IO (Maybe (AVPixelFormat, V2 CInt, Vector CUChar) -> IO ())
frameWriter EncodingParams
ep FilePath
f
  where aux :: Image a -> (AVPixelFormat, V2 a, Vector b)
aux img :: Image a
img = let w :: a
w = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Image a -> Int
forall a. Image a -> Int
imageWidth Image a
img
                      h :: a
h = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Image a -> Int
forall a. Image a -> Int
imageHeight Image a
img
                      p :: Vector b
p = Vector (PixelBaseComponent a) -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
V.unsafeCast (Vector (PixelBaseComponent a) -> Vector b)
-> Vector (PixelBaseComponent a) -> Vector b
forall a b. (a -> b) -> a -> b
$ Image a -> Vector (PixelBaseComponent a)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image a
img
                  in  ([p] -> AVPixelFormat
forall a (proxy :: * -> *).
JuicyPixelFormat a =>
proxy a -> AVPixelFormat
juicyPixelFormat ([]::[p]), a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
w a
h, Vector b
p)