{-# LINE 1 "src/Codec/FFmpeg/Common.hsc" #-}
{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}
{-# LINE 2 "src/Codec/FFmpeg/Common.hsc" #-}
module Codec.FFmpeg.Common where
import Codec.FFmpeg.Enums
import Codec.FFmpeg.Types
import Control.Monad (when)
import Control.Monad.Error.Class
import Control.Monad.IO.Class
import Foreign.C.Types
import Foreign.Ptr
import Control.Monad.Trans.Maybe
foreign import ccall "avcodec_open2"
open_codec :: AVCodecContext -> AVCodec -> Ptr AVDictionary -> IO CInt
foreign import ccall "av_frame_alloc"
av_frame_alloc :: IO AVFrame
foreign import ccall "av_frame_get_buffer"
av_frame_get_buffer :: AVFrame -> CInt -> IO CInt
foreign import ccall "av_frame_free"
av_frame_free :: Ptr AVFrame -> IO ()
foreign import ccall "avcodec_close"
codec_close :: AVCodecContext -> IO CInt
foreign import ccall "av_init_packet"
init_packet :: AVPacket -> IO ()
foreign import ccall "av_free_packet"
free_packet :: AVPacket -> IO ()
foreign import ccall "av_malloc"
av_malloc :: CSize -> IO (Ptr ())
foreign import ccall "av_free"
av_free :: Ptr () -> IO ()
foreign import ccall "sws_getCachedContext"
sws_getCachedContext :: SwsContext
-> CInt -> CInt -> AVPixelFormat
-> CInt -> CInt -> AVPixelFormat
-> SwsAlgorithm -> Ptr () -> Ptr () -> Ptr CDouble
-> IO SwsContext
foreign import ccall "sws_scale"
sws_scale :: SwsContext
-> Ptr (Ptr CUChar) -> Ptr CInt -> CInt -> CInt
-> Ptr (Ptr CUChar) -> Ptr CInt -> IO CInt
foreign import ccall "av_image_get_buffer_size"
av_image_get_buffer_size
:: AVPixelFormat
-> CInt
-> CInt
-> CInt
-> IO CInt
foreign import ccall "av_image_copy_to_buffer"
av_image_copy_to_buffer
:: Ptr CUChar
-> CInt
-> Ptr (Ptr CUChar)
-> Ptr CInt
-> AVPixelFormat
-> CInt
-> CInt
-> CInt
-> IO CInt
wrapIOError :: (MonadIO m, MonadError String m) => IO a -> m a
wrapIOError io = liftIO (catchError (fmap Right io) (return . Left . show))
>>= either throwError return
frame_alloc_check :: IO AVFrame
frame_alloc_check = do r <- av_frame_alloc
when (getPtr r == nullPtr)
(error "Couldn't allocate frame")
return r
frame_get_buffer_check :: AVFrame -> CInt -> IO ()
frame_get_buffer_check f x = do r <- av_frame_get_buffer f x
when (r /= 0)
(error "Failed to allocate buffers")
avPixelStride :: AVPixelFormat -> Maybe Int
avPixelStride fmt
| fmt == avPixFmtGray8 = Just 1
| fmt == avPixFmtRgb24 = Just 3
| fmt == avPixFmtRgba = Just 4
| fmt == avPixFmtRgb8 = Just 1
| fmt == avPixFmtPal8 = Just 1
| otherwise = Nothing
lineSizeAlign :: CInt -> CInt
lineSizeAlign lineSize
| lineSize `mod` 64 == 0 = 64
| lineSize `mod` 32 == 0 = 32
| lineSize `mod` 16 == 0 = 16
| lineSize `mod` 8 == 0 = 8
| lineSize `mod` 4 == 0 = 4
| lineSize `mod` 2 == 0 = 2
| otherwise = 1
frameLineSize :: AVFrame -> IO (Maybe CInt)
frameLineSize frame = do
w <- getWidth frame
fmt <- getPixelFormat frame
return $
(*w) . fromIntegral <$> avPixelStride fmt
frameLineSizeT :: AVFrame -> MaybeT IO CInt
frameLineSizeT = MaybeT . frameLineSize
frameAlign :: AVFrame -> IO (Maybe CInt)
frameAlign = fmap (fmap lineSizeAlign) . frameLineSize
frameAlignT :: AVFrame -> MaybeT IO CInt
frameAlignT = MaybeT . frameAlign
frameBufferSize :: AVFrame -> IO (Maybe CInt)
frameBufferSize frame =
runMaybeT $ do
a <- frameAlignT frame
MaybeT $ do
fmt <- getPixelFormat frame
w <- getWidth frame
h <- getHeight frame
Just <$> av_image_get_buffer_size fmt w h a
frameBufferSizeT :: AVFrame -> MaybeT IO CInt
frameBufferSizeT = MaybeT . frameBufferSize
frameCopyToBuffer :: AVFrame -> Ptr CUChar -> IO (Maybe CInt)
frameCopyToBuffer frame buffer =
runMaybeT $ do
a <- frameAlignT frame
s <- frameBufferSizeT frame
MaybeT $ do
let imageData = hasData frame
lineSize = hasLineSize frame
fmt <- getPixelFormat frame
w <- getWidth frame
h <- getHeight frame
Just <$>
av_image_copy_to_buffer
buffer
s
(castPtr imageData)
lineSize
fmt
w
h
a
frameCopyToBufferT :: AVFrame -> Ptr CUChar -> MaybeT IO CInt
frameCopyToBufferT frame = MaybeT . frameCopyToBuffer frame