ffmpeg-light 0.7.1.1 → 0.8
raw patch · 9 files changed
+106/−66 lines, 9 filesdep −lineardep ~Rasterificdep ~mtldep ~transformers
Dependencies removed: linear
Dependency ranges changed: Rasterific, mtl, transformers
Files
- CHANGELOG.md +22/−0
- demo/Main.hs +1/−1
- demo/Raster.hs +2/−2
- ffmpeg-light.cabal +5/−5
- src/Codec/FFmpeg.hs +1/−0
- src/Codec/FFmpeg/Common.hsc +5/−8
- src/Codec/FFmpeg/Decode.hs +18/−18
- src/Codec/FFmpeg/Encode.hs +27/−21
- src/Codec/FFmpeg/Juicy.hs +25/−11
CHANGELOG.md view
@@ -1,3 +1,25 @@+0.8+---++* Update to transformers-0.4.1 and mtl-2.2.1+ * Changed decode-related types to accomodate deprecation of the+ `Error` class. This means that if you want to initialize decoders+ in your own transformer stack that has a `MonadError` instance,+ you will need to use the variants with names suffixed by a "T"+ (for transformer).++* Update to ffmpeg 2.3++ * Address deprecation warning++ `Using AVStream.codec.time_base as a timebase hint to the muxer is+ deprecated. Set AVStream.time_base instead.`++ * Address "non-strictly-monotonic PTS" warning++* Rasterific bump+ * Rasterific exports its own linear algebra types as of 0.3+ 0.7.1 ---
demo/Main.hs view
@@ -1,7 +1,7 @@ import Codec.FFmpeg import Codec.Picture import Control.Applicative-import Control.Monad.Error+import Control.Monad (replicateM_) import qualified Data.Vector.Storable as V import System.Environment
demo/Raster.hs view
@@ -3,9 +3,9 @@ import Codec.Picture import Control.Monad (forM_) import Graphics.Rasterific+import Graphics.Rasterific.Linear import Graphics.Rasterific.Texture import Graphics.Rasterific.Transformations-import Linear -- | The Rasterific logo sample shape. logo :: Int -> Bool -> Vector -> [Primitive]@@ -36,7 +36,7 @@ | otherwise = let q0 = a + v1 ^* t q1 = b + v2 ^* t vq = q1 - q0- in q0 + t *^ vq : (go $! t + 0.05)+ in q0 + vq ^* t : (go $! t + 0.05) -- | Our animation path. path :: [Point]
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.7.1.1+version: 0.8 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -15,7 +15,7 @@ > go = do (getFrame, cleanup) <- imageReader "myVideo.mov" > (fmap ImageRGB8 <$> getFrame) <* cleanup .- Tested on OS X 10.9.2 with <http://www.ffmpeg.org FFmpeg> 2.2.1+ Tested on OS X 10.9.4 with <http://www.ffmpeg.org FFmpeg> 2.3 installed via <http://brew.sh homebrew>. license: BSD3@@ -56,8 +56,8 @@ build-tools: hsc2hs build-depends: base >=4.6 && < 5, vector >= 0.10.9 && < 0.11,- transformers >= 0.3 && < 0.5,- mtl >= 2.1.3 && < 2.3,+ transformers >= 0.4.1 && < 0.5,+ mtl >= 2.2.1 && < 2.3, JuicyPixels >= 3.1 && < 3.2 pkgconfig-depends: libavutil, libavformat, libavcodec, libswscale hs-source-dirs: src@@ -81,7 +81,7 @@ buildable: False build-depends: base < 5, vector, mtl, transformers, JuicyPixels if flag(BuildRasterDemo)- build-depends: ffmpeg-light, Rasterific, linear+ build-depends: ffmpeg-light, Rasterific >= 0.3 hs-source-dirs: demo main-is: Raster.hs default-language: Haskell2010
src/Codec/FFmpeg.hs view
@@ -5,6 +5,7 @@ initFFmpeg, -- * Decoding imageReader, imageReaderTime,+ imageReaderT, imageReaderTimeT, -- * Encoding EncodingParams(..), defaultParams, imageWriter, -- * Types and Enums
src/Codec/FFmpeg/Common.hsc view
@@ -51,12 +51,9 @@ -- | Catch an IOException from an IO action and re-throw it in a -- wrapping monad transformer.-wrapIOError :: (MonadIO m, Error e, MonadError e m) => IO a -> m a-wrapIOError = liftIO . flip catchError (errMsg . show)---- | Throw an error with a 'String' message.-errMsg :: (Error e, MonadError e m) => String -> m a-errMsg = throwError . strMsg+wrapIOError :: (MonadIO m, MonadError String m) => IO a -> m a+wrapIOError io = liftIO (catchError (fmap Right io) (return . Left . show))+ >>= either throwError return -- * Wrappers that may throw 'IOException's. @@ -64,7 +61,7 @@ frame_alloc_check :: IO AVFrame frame_alloc_check = do r <- av_frame_alloc when (getPtr r == nullPtr)- (errMsg "Couldn't allocate frame")+ (error "Couldn't allocate frame") return r -- | Allocate new buffer(s) for audio or video data with the required@@ -75,7 +72,7 @@ frame_get_buffer_check :: AVFrame -> CInt -> IO () frame_get_buffer_check f x = do r <- av_frame_get_buffer f x when (r /= 0)- (errMsg "Failed to allocate buffers")+ (error "Failed to allocate buffers") -- | Bytes-per-pixel for an 'AVPixelFormat' avPixelStride :: AVPixelFormat -> Maybe Int
src/Codec/FFmpeg/Decode.hs view
@@ -61,12 +61,12 @@ -- * FFmpeg Decoding Interface -- | Open an input media file.-openInput :: (MonadIO m, Error e, MonadError e m) => String -> m AVFormatContext+openInput :: (MonadIO m, MonadError String m) => String -> m AVFormatContext openInput filename = wrapIOError . alloca $ \ctx -> withCString filename $ \cstr -> do r <- avformat_open_input ctx cstr nullPtr nullPtr- when (r /= 0) (errMsg "Error opening file")+ when (r /= 0) (error "Error opening file") peek ctx -- | @AVFrame@ is a superset of @AVPicture@, so we can upcast an@@ -75,30 +75,30 @@ frameAsPicture = AVPicture . getPtr -- | Find a codec given by name.-findDecoder :: (MonadIO m, Error e, MonadError e m) => String -> m AVCodec+findDecoder :: (MonadIO m, MonadError String m) => String -> m AVCodec findDecoder name = do r <- liftIO $ withCString name avcodec_find_decoder_by_name when (getPtr r == nullPtr)- (errMsg $ "Unsupported codec: " ++ show name)+ (throwError $ "Unsupported codec: " ++ show name) return r -- | Read packets of a media file to get stream information. This is -- useful for file formats with no headers such as MPEG.-checkStreams :: (MonadIO m, Error e, MonadError e m) => AVFormatContext -> m ()+checkStreams :: (MonadIO m, MonadError String m) => AVFormatContext -> m () checkStreams ctx = do r <- liftIO $ avformat_find_stream_info ctx nullPtr- when (r < 0) (errMsg "Couldn't find stream information")+ when (r < 0) (throwError "Couldn't find stream information") -- | Searches for a video stream in an 'AVFormatContext'. If one is -- found, returns the index of the stream in the container, and its -- associated 'AVCodecContext' and 'AVCodec'.-findVideoStream :: (MonadIO m, Error e, MonadError e m)+findVideoStream :: (MonadIO m, MonadError String m) => AVFormatContext -> m (CInt, AVCodecContext, AVCodec) findVideoStream fmt = do wrapIOError . alloca $ \codec -> do poke codec (AVCodec nullPtr) i <- av_find_best_stream fmt avmediaTypeVideo (-1) (-1) codec 0- when (i < 0) (errMsg "Couldn't find a video stream")+ when (i < 0) (error "Couldn't find a video stream") cod <- peek codec streams <- getStreams fmt vidStream <- peek (advancePtr streams (fromIntegral i))@@ -107,30 +107,30 @@ -- | Find a registered decoder with a codec ID matching that found in -- the given 'AVCodecContext'.-getDecoder :: (MonadIO m, Error e, MonadError e m)+getDecoder :: (MonadIO m, MonadError String m) => AVCodecContext -> m AVCodec getDecoder ctx = do p <- liftIO $ getCodecID ctx >>= avcodec_find_decoder- when (getPtr p == nullPtr) (errMsg "Unsupported codec")+ when (getPtr p == nullPtr) (throwError "Unsupported codec") return p -- | Initialize the given 'AVCodecContext' to use the given -- 'AVCodec'. **NOTE**: This function is not thread safe!-openCodec :: (MonadIO m, Error e, MonadError e m)+openCodec :: (MonadIO m, MonadError String m) => AVCodecContext -> AVCodec -> m AVDictionary openCodec ctx cod = wrapIOError . alloca $ \dict -> do poke dict (AVDictionary nullPtr) r <- open_codec ctx cod dict- when (r < 0) (errMsg "Couldn't open decoder")+ when (r < 0) (error "Couldn't open decoder") peek dict -- | Return the next frame of a stream. read_frame_check :: AVFormatContext -> AVPacket -> IO () read_frame_check ctx pkt = do r <- av_read_frame ctx pkt- when (r < 0) (errMsg "Frame read failed")+ when (r < 0) (error "Frame read failed") -- | Read frames of the given 'AVPixelFormat' from a video stream.-frameReader :: (MonadIO m, Error e, MonadError e m)+frameReader :: (MonadIO m, MonadError String m) => AVPixelFormat -> FilePath -> m (IO (Maybe AVFrame), IO ()) frameReader dstFmt fileName = do inputContext <- openInput fileName@@ -142,14 +142,14 @@ -- | Read RGB frames with the result in the 'MaybeT' transformer. -- -- > frameReaderT = fmap (first MaybeT) . frameReader-frameReaderT :: (Functor m, MonadIO m, Error e, MonadError e m)+frameReaderT :: (Functor m, MonadIO m, MonadError String m) => FilePath -> m (MaybeT IO AVFrame, IO ()) frameReaderT = fmap (first MaybeT) . frameReader avPixFmtRgb24 -- | Read time stamped frames of the given 'AVPixelFormat' from a -- video stream. Time is given in seconds from the start of the -- stream.-frameReaderTime :: (MonadIO m, Error e, MonadError e m)+frameReaderTime :: (MonadIO m, MonadError String m) => AVPixelFormat -> FilePath -> m (IO (Maybe (AVFrame, Double)), IO ()) frameReaderTime dstFmt fileName =@@ -174,13 +174,13 @@ -- transformer. -- -- > frameReaderT = fmap (first MaybeT) . frameReader-frameReaderTimeT :: (Functor m, MonadIO m, Error e, MonadError e m)+frameReaderTimeT :: (Functor m, MonadIO m, MonadError String m) => FilePath -> m (MaybeT IO (AVFrame, Double), IO ()) frameReaderTimeT = fmap (first MaybeT) . frameReaderTime avPixFmtRgb24 -- | Construct an action that gets the next available frame, and an -- action to release all resources associated with this video stream.-prepareReader :: (MonadIO m, Error e, MonadError e m)+prepareReader :: (MonadIO m, MonadError String m) => AVFormatContext -> CInt -> AVPixelFormat -> AVCodecContext -> m (IO (Maybe AVFrame), IO ()) prepareReader fmtCtx vidStream dstFmt codCtx =
src/Codec/FFmpeg/Encode.hs view
@@ -14,7 +14,6 @@ import Codec.Picture import Control.Applicative import Control.Monad (when, void)-import Control.Monad.Error.Class import Data.Bits import Data.IORef import Data.Maybe (fromMaybe)@@ -140,23 +139,23 @@ initStream :: EncodingParams -> AVFormatContext -> IO (AVStream, AVCodecContext) initStream ep _ | (epWidth ep `rem` 2, epHeight ep `rem` 2) /= (0,0) =- throwError $ strMsg "Video dimensions must be multiples of two"+ error "Video dimensions must be multiples of two" initStream ep oc = do -- Use the codec suggested by the output format, or override with -- the user's choice. codec <- maybe (getOutputFormat oc >>= getVideoCodecID) return (epCodec ep) cod <- avcodec_find_encoder codec when (getPtr cod == nullPtr)- (errMsg "Couldn't find encoder")+ (error "Couldn't find encoder") st <- avformat_new_stream oc cod getNumStreams oc >>= setId st . subtract 1-+ let framePeriod = AVRational 1 (fromIntegral $ epFps ep)+ setTimeBase st framePeriod ctx <- getCodecContext st setWidth ctx (epWidth ep) setHeight ctx (epHeight ep)- let framePeriod = AVRational 1 (fromIntegral $ epFps ep)- setTimeBase ctx framePeriod+ -- setTimeBase ctx framePeriod setPixelFormat ctx $ case epPixelFormat ep of Just fmt -> fmt Nothing@@ -180,7 +179,7 @@ getPrivData ctx >>= \pd -> av_opt_set pd kStr vStr 0 rOpen <- open_codec ctx cod nullPtr- when (rOpen < 0) (throwError $ strMsg "Couldn't open codec")+ when (rOpen < 0) (error "Couldn't open codec") return (st, ctx) @@ -198,7 +197,7 @@ -- For palettized images, we will provide our own buffer. if fmt == avPixFmtRgb8 || fmt == avPixFmtPal8 then do r <- av_image_fill_linesizes (hasLineSize frame) fmt (epWidth ep)- when (r < 0) (errMsg "Error filling temporary frame line sizes")+ when (r < 0) (error "Error filling temporary frame line sizes") else frame_get_buffer_check frame 32 return frame @@ -212,10 +211,10 @@ ocTmp (AVOutputFormat nullPtr) nullPtr fname' when (r < 0)- (errMsg "Couldn't allocate output format context")+ (error "Couldn't allocate output format context") peek ocTmp when (getPtr oc == nullPtr)- (errMsg "Couldn't allocate output AVFormatContext")+ (error "Couldn't allocate output AVFormatContext") return oc -- | Open the given file for writing.@@ -223,12 +222,12 @@ avio_open_check oc fname = do r <- withCString fname $ \cstr -> avio_open (hasIOContext oc) cstr avioFlagWrite- when (r < 0) (errMsg "Error opening IO for writing")+ when (r < 0) (error "Error opening IO for writing") -- | Close an open IO context. avio_close_check :: AVFormatContext -> IO () avio_close_check oc = do r <- getIOContext oc >>= avio_close- when (r /= 0) (errMsg "Error closing IO")+ when (r /= 0) (error "Error closing IO") -- | Returns 'True' if the 'AVPacket' was updated with new output -- data; 'False' otherwise.@@ -236,7 +235,7 @@ encode_video_check ctx pkt frame = alloca $ \gotOutput -> do r <- avcodec_encode_video2 ctx pkt frame' gotOutput- when (r < 0) (errMsg "Error encoding frame")+ when (r < 0) (error "Error encoding frame") (> 0) <$> peek gotOutput where frame' = fromMaybe (AVFrame nullPtr) frame @@ -244,19 +243,19 @@ -- an output media file. write_header_check :: AVFormatContext -> IO () write_header_check oc = do r <- avformat_write_header oc nullPtr- when (r < 0) (errMsg "Error writing header")+ when (r < 0) (error "Error writing header") -- | Write a packet to an output media file. write_frame_check :: AVFormatContext -> AVPacket -> IO () write_frame_check oc pkt = do r <- av_write_frame oc pkt- when (r < 0) (errMsg "Error writing frame")+ when (r < 0) (error "Error writing frame") -- | Write the stream trailer to an output media file and free the -- private data. May only be called after a successful call to -- 'write_header_check'. write_trailer_check :: AVFormatContext -> IO () write_trailer_check oc = do r <- av_write_trailer oc- when (r /= 0) (errMsg "Error writing trailer")+ when (r /= 0) (error "Error writing trailer") -- | Quantize RGB24 pixels to the systematic RGB8 color palette. The -- image data has space for a palette appended to be compliant with@@ -322,13 +321,19 @@ else return Nothing pkt <- AVPacket <$> av_malloc (fromIntegral packetSize)+ setPts pkt 0 stIndex <- getStreamIndex st avio_open_check oc fname write_header_check oc + let framePeriod = AVRational 1 (fromIntegral $ epFps ep)++ -- The stream time_base can be changed by the call to+ -- 'write_header_check', so we read it back here to establish a way+ -- of scaling the nominal, desired frame rate (given by+ -- 'framePeriod') to the stream's time_base. tb <- getTimeBase st- codecTB <- getCodecContext st >>= getTimeBase isRaw <- checkFlag avfmtRawpicture <$> (getOutputFormat oc >>= getFormatFlags) let checkPalCompat@@ -341,7 +346,7 @@ palettizer | dstFmt == avPixFmtPal8 = Just $ palettizeJuicy ep | dstFmt == avPixFmtRgb8 = Just $ palettizeRGB8 ep | otherwise = Nothing- frameTime = av_rescale_q 1 codecTB tb+ frameTime = av_rescale_q 1 framePeriod tb resetPacket = do init_packet pkt setData pkt nullPtr setSize pkt 0@@ -366,9 +371,10 @@ getPacketFlags pkt >>= setPacketFlags pkt . (.|. avPktFlagKey) --setSize pkt (fromIntegral $ V.length pixels) setSize pkt (fromIntegral pictureSize)- getPts dstFrame >>= setPts dstFrame . (+ frameTime)- getPts dstFrame >>= setPts pkt- getPts dstFrame >>= setDts pkt+ timeStamp <- (+ frameTime) <$> getPts dstFrame+ setPts dstFrame timeStamp+ setPts pkt timeStamp+ -- getPts dstFrame >>= setDts pkt V.unsafeWith pixels $ \ptr -> do setData pkt (castPtr ptr) writePacket
src/Codec/FFmpeg/Juicy.hs view
@@ -14,6 +14,7 @@ import Control.Monad.Error.Class import Control.Monad.IO.Class import Control.Monad.Trans.Class+import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Maybe import Data.Foldable (traverse_) import qualified Data.Vector.Storable as V@@ -100,25 +101,38 @@ sizeOf (undefined :: PixelBaseComponent a) * componentCount (undefined :: a) -- | Read frames from a video stream.-imageReader :: forall m p e.- (Functor m, MonadIO m, Error e, MonadError e m,- JuicyPixelFormat p)- => FilePath -> m (IO (Maybe (Image p)), IO ())-imageReader = fmap (first (runMaybeT . aux toJuicyImage))+imageReaderT :: forall m p.+ (Functor m, MonadIO m, MonadError String m,+ JuicyPixelFormat p)+ => FilePath -> m (IO (Maybe (Image p)), IO ())+imageReaderT = fmap (first (runMaybeT . aux toJuicyImage)) . frameReader (juicyPixelFormat ([] :: [p])) where aux g x = MaybeT x >>= MaybeT . g +-- | Read frames from a video stream. Errors are thrown as+-- 'IOException's.+imageReader :: JuicyPixelFormat p+ => FilePath -> IO (IO (Maybe (Image p)), IO ())+imageReader = (>>= either error return) . runExceptT . imageReaderT+ -- | Read time stamped frames from a video stream. Time is given in -- seconds from the start of the stream.-imageReaderTime :: forall m p e.- (Functor m, MonadIO m, Error e, MonadError e m,- JuicyPixelFormat p)- => FilePath -> m (IO (Maybe (Image p, Double)), IO ())-imageReaderTime = fmap (first (runMaybeT . aux toJuicyImage))- . frameReaderTime (juicyPixelFormat ([] :: [p]))+imageReaderTimeT :: forall m p.+ (Functor m, MonadIO m, MonadError String m,+ JuicyPixelFormat p)+ => FilePath -> 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)++-- | 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+ => FilePath -> IO (IO (Maybe (Image p, Double)), IO ())+imageReaderTime = (>>= either error return) . runExceptT . imageReaderTimeT -- | Open a target file for writing a video stream. When the returned -- function is applied to 'Nothing', the output stream is closed. Note