ffmpeg-light 0.12.1.0 → 0.12.2.0
raw patch · 8 files changed
+144/−61 lines, 8 filesdep ~JuicyPixels
Dependency ranges changed: JuicyPixels
Files
- CHANGELOG.md +3/−0
- demo/VPlay.hs +50/−50
- ffmpeg-light.cabal +2/−2
- src/Codec/FFmpeg/Common.hsc +17/−1
- src/Codec/FFmpeg/Decode.hs +8/−4
- src/Codec/FFmpeg/Encode.hs +16/−4
- src/Codec/FFmpeg/Enums.hsc +46/−0
- src/Codec/FFmpeg/Types.hsc +2/−0
CHANGELOG.md view
@@ -1,3 +1,6 @@+# 0.12.2+* Better support for ffmpeg-3.4.2 API changes+ # 0.12.1 * Bump base upper bound * Rewritten Travis-CI support for GHC 8.02, 8.2.2, and 8.4.2
demo/VPlay.hs view
@@ -45,7 +45,7 @@ dict <- openCodec ctx cod return (vidStreamIndex, ctx, cod, vidStream, dict) --- Transform reader to return timestamp too. +-- Transform reader to return timestamp too. readTS :: (HasPts f, Fractional t) => AVRational -> IO (Maybe f)@@ -61,9 +61,9 @@ Nothing -> return Nothing Just f -> do t <- frameTime' f return $ Just (f, t) in reader'- + -- Transform frame and timestamp reader to compute frame--- time as a difference between adjacent timestamps. +-- time as a difference between adjacent timestamps. readTSDiff :: (MonadIO m, MonadIO m', Num t) => m' (Maybe (f, t)) -> m (m' (Maybe (f, t))) readTSDiff readerTS = do@@ -86,8 +86,8 @@ where updateTexture t img = frameLineSizeT frame >>=- SDL.updateTexture t Nothing img - + SDL.updateTexture t Nothing img+ -- Update texture by image data from frame. updateTextureByFrame :: SDL.Texture -> AVFrame -> IO (Maybe SDL.Texture) updateTextureByFrame t = runMaybeT . updateTextureByFrameT t@@ -103,7 +103,7 @@ if p a then return Nothing else action- + -- Retrun Nothing when QuitEvent is received. nothingOnQuit :: MonadIO m@@ -113,34 +113,34 @@ SDL.pollEvents (not . null . filter (\ event ->- case SDL.eventPayload event of + case SDL.eventPayload event of SDL.QuitEvent -> True _ -> False)) action- + {- Return ByteString filled by image data from frame.- + Returned ByteString doesn't refer back to it's source AVFrame. So, source frame may be deleted- or changed, but image will stay. - + or changed, but image will stay.+ -} copyImageData :: AVFrame -> IO (Maybe ByteString) copyImageData frame = runMaybeT $ do- + -- Get required size of buffer to hold image data. imageBufSize <- frameBufferSizeT frame- + -- Allocate buffer to hold image data. imageBuf <- MaybeT $ Just <$> (av_malloc $ fromIntegral imageBufSize)- + -- Image data buffer cleanup. let imageBufCleanup = av_free imageBuf- + -- Copy image to buffer. _ <- frameCopyToBufferT frame (castPtr imageBuf)- + -- Fill up byte-string by data from buffer. MaybeT $ Just <$> unsafePackCStringFinalizer@@ -149,10 +149,10 @@ -- Cleanup for buffer. imageBufCleanup --- Transformer version of copyImageData. +-- Transformer version of copyImageData. copyImageDataT :: AVFrame -> MaybeT IO ByteString copyImageDataT = MaybeT . copyImageData- + -- Convert floating point second to millisecond. sec2msec :: (RealFrac a, Integral b) => a -> b sec2msec = floor . (*1000)@@ -172,8 +172,8 @@ firstDisplay = SDL.getDisplays >>= return . head -{- Main. -} - +{- Main. -}+ -- Configuration for video player. data Config = Config@@ -182,57 +182,57 @@ , cfgFmtFFmpeg :: AVPixelFormat , cfgFmtSDL :: SDL.PixelFormat }- + videoPlayer :: (MonadIO m, MonadError String m) => Config -> InputSource -> m () videoPlayer cfg src = do- + {- Setup. -}- + liftIO initFFmpeg SDL.initializeAll- - (renderTexture, getTexture, cleanup) <- textureReader src - ++ (renderTexture, getTexture, cleanup) <- textureReader src+ liftIO $ whileJust_ (nothingOnQuit getTexture) $ \ (next, time) -> do- + {- Rendering. -}- + -- Rendering start time. rStartTime <- SDL.time- + renderTexture next- + -- Finish time of rendering. rFinishTime <- SDL.time- + {- Synchronizing. -}- + -- Total rendering time. let rTotalTime = sec2msec $ rFinishTime - rStartTime -- Frame time in MS. frameTime = sec2msec time- + -- If rendering time is less then frame time. when ( time > 0 && rTotalTime < frameTime) $ do -- Sleep their difference. SDL.delay $ frameTime - rTotalTime- + {- Cleanup. -}- + liftIO cleanup SDL.quit- + where- + -- Create window using title from config. createWindow w h = do window <- SDL.createWindow (cfgWindowTitle cfg) SDL.defaultWindow (SDL.$=) (SDL.windowSize window) (SDL.V2 w h) return window- + -- Create renderer using driver from config. createRenderer window = SDL.createRenderer window (cfgRendererDriver cfg) SDL.defaultRenderer@@ -244,7 +244,7 @@ (cfgFmtSDL cfg) SDL.TextureAccessStreaming (SDL.V2 w h)- + -- Return texture reader, renderer and cleanup. textureReader :: (MonadIO m', MonadError String m', MonadIO m) => InputSource@@ -252,15 +252,15 @@ , IO (Maybe (SDL.Texture, Double)) , IO ()) textureReader inp = do- + -- Open video. inputContext <- prepareInput inp (vsIdx, ctx, _, vs, _) <- prepareVideoCodec inputContext- + -- Get frame size. w <- liftIO $ getWidth ctx- h <- liftIO $ getHeight ctx - + h <- liftIO $ getHeight ctx+ -- Create window, renderer and texture. window <- createWindow w h renderer <- createRenderer window@@ -269,31 +269,31 @@ -- Create frame reader. let dstFmt = cfgFmtFFmpeg cfg (reader, cleanup) <- prepareReader inputContext vsIdx dstFmt ctx- + -- Transform reader to read frame time. timeBase <- liftIO $ getTimeBase vs tsDiffReader <- readTSDiff (readTS timeBase reader)- + -- Texture reader. let reader' = runMaybeT $ do (f, t) <- MaybeT tsDiffReader updateTextureByFrameT texture f >>= return . flip (,) t- + -- Texture renderer. render t = do SDL.copy renderer t Nothing Nothing SDL.present renderer- + -- New cleanup. cleanup' = cleanup >> SDL.destroyTexture texture >> SDL.destroyRenderer renderer >> SDL.destroyWindow window- + return (render, reader', cleanup')- + {- Main. -} -- Default configuration.@@ -305,7 +305,7 @@ , cfgFmtFFmpeg = avPixFmtRgb24 , cfgFmtSDL = SDL.RGB24 }- + -- Runs videoPlayer in Either monad. runVideoPlayer :: Config -> FilePath -> IO (Either String ()) runVideoPlayer cfg = runExceptT . videoPlayer cfg . File
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.12.1.0+version: 0.12.2.0 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -73,7 +73,7 @@ vector >= 0.10.9 && < 0.13, transformers >= 0.4.1 && < 0.6, mtl >= 2.2.1 && < 2.3,- JuicyPixels >= 3.1 && < 3.3,+ JuicyPixels >= 3.1 && < 3.4, bytestring pkgconfig-depends: libavutil, libavformat, libavcodec, libswscale, libavdevice
src/Codec/FFmpeg/Common.hsc view
@@ -5,8 +5,10 @@ import Control.Monad (when) import Control.Monad.Error.Class import Control.Monad.IO.Class+import Foreign.C.String import Foreign.C.Types import Foreign.Ptr+import Foreign.Marshal.Alloc (allocaBytes) import Control.Monad.Trans.Maybe foreign import ccall "avcodec_open2"@@ -208,7 +210,21 @@ w h a- + -- | Transformer version of 'frameCopyToBuffer'. frameCopyToBufferT :: AVFrame -> Ptr CUChar -> MaybeT IO CInt frameCopyToBufferT frame = MaybeT . frameCopyToBuffer frame++-- * FFmpeg Errors++foreign import ccall "av_strerror"+ av_strerror :: CInt -> Ptr CChar -> CSize -> IO CInt++stringError :: CInt -> IO String+stringError err =+ allocaBytes len $ \block -> do+ let buf = castPtr block+ _ <- av_strerror err buf (fromIntegral len)+ peekCString buf+ where+ len = 1000
src/Codec/FFmpeg/Decode.hs view
@@ -60,8 +60,9 @@ dictSet d k v = do r <- withCString k $ \k' -> withCString v $ \v' -> av_dict_set d k' v' 0- when (r < 0)- (error $ "av_dict_set failed("++show r++"): "++k++" => "++v)+ when (r < 0) $+ stringError r >>= \err ->+ error $ "av_dict_set failed("++ err ++"): "++k++" => "++v -- * FFmpeg Decoding Interface @@ -76,7 +77,9 @@ r <- alloca $ \dict -> do setConfig dict cfg avformat_open_input ctx cstr nullPtr dict- when (r /= 0) (fail $ "ffmpeg failed opening file: " ++ show r)+ when (r /= 0) $+ stringError r >>= \err ->+ fail ("ffmpeg failed opening file: " ++ err) peek ctx where run :: (a -> IO b) -> Maybe a -> IO ()@@ -106,7 +109,8 @@ withCString filename $ \cstr -> do poke (castPtr ctx) nullPtr r <- avformat_open_input ctx cstr nullPtr nullPtr- when (r /= 0) (fail $ "ffmpeg failed opening file: " ++ show r)+ when (r /= 0) (stringError r >>= \s ->+ fail $ "ffmpeg failed opening file: " ++ s) peek ctx -- | @AVFrame@ is a superset of @AVPicture@, so we can upcast an
src/Codec/FFmpeg/Encode.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-} -- | Video encoding API. Includes FFI declarations for the underlying -- FFmpeg functions, wrappers for these functions that wrap error -- condition checking, and high level Haskellized interfaces.@@ -170,7 +170,11 @@ needsHeader <- checkFlag avfmtGlobalheader <$> (getOutputFormat oc >>= getFormatFlags) when needsHeader $+#if FFMPEG_LIGHT_LEGACY getCodecFlags ctx >>= setCodecFlags ctx . (.|. codecFlagGlobalHeader)+#else+ getCodecFlags ctx >>= setCodecFlags ctx . (.|. avCodecFlagGlobalHeader)+#endif -- _ <- withCString "vprofile" $ \kStr -> -- withCString (preset ep) $ \vStr ->@@ -348,7 +352,9 @@ -- of scaling the nominal, desired frame rate (given by -- 'framePeriod') to the stream's time_base. tb <- getTimeBase st+#if FFMPEG_LIGHT_LEGACY isRaw <- checkFlag avfmtRawpicture <$> (getOutputFormat oc >>= getFormatFlags)+#endif let checkPalCompat | dstFmt /= avPixFmtPal8 && dstFmt /= avPixFmtRgb8 = const True@@ -394,7 +400,7 @@ False -> (+ frameTime) <$> getPts dstFrame modifyIORef frameNum (+1) return ts-+#if FFMPEG_LIGHT_LEGACY addRaw Nothing = return () addRaw (Just (_, _, pixels)) = do resetPacket@@ -408,14 +414,16 @@ V.unsafeWith pixels $ \ptr -> do setData pkt (castPtr ptr) writePacket+#endif addEncoded Nothing = do resetPacket encode_video_check ctx pkt Nothing >>= flip when (writePacket >> addEncoded Nothing) addEncoded (Just srcImg@(srcFmt, V2 srcW srcH, pixels)) = do resetPacket when (not $ checkPalCompat srcImg)- (error $ "Palettized output requires source images to be the \- \same resolution as the output video")+ (error $+ unlines [ "Palettized output requires source images to be the "+ , "same resolution as the output video" ]) let pixels' = maybe pixels ($ V.unsafeCast pixels) palettizer sws' <- for sws $ \sPtr -> do s <- readIORef sPtr@@ -430,7 +438,11 @@ -- Make sure the GC hasn't clobbered our palettized pixel data let (fp,_,_) = V.unsafeToForeignPtr pixels' touchForeignPtr fp+#if FFMPEG_LIGHT_LEGACY addFrame = if isRaw then addRaw else addEncoded+#else+ addFrame = addEncoded+#endif go Nothing = do addFrame Nothing write_trailer_check oc _ <- codec_close ctx
src/Codec/FFmpeg/Enums.hsc view
@@ -12,6 +12,12 @@ #include <libswscale/swscale.h> #include "nameCompat.h" +#if LIBAVFORMAT_VERSION_MAJOR < 57+#define FFMPEG_LIGHT_LEGACY 1+#else+#define FFMPEG_LIGHT_LEGACY 0+#endif+ newtype AVMediaType = AVMediaType CInt deriving (Eq, Storable) #enum AVMediaType,AVMediaType \ , AVMEDIA_TYPE_VIDEO\@@ -171,6 +177,7 @@ , AV_ROUND_PASS_MINMAX newtype CodecFlag = CodecFlag CInt deriving (Eq, Bits, Storable)+#if LIBAVCODEC_VERSION_MAJOR < 57 #enum CodecFlag, CodecFlag \ , CODEC_FLAG_UNALIGNED\ , CODEC_FLAG_QSCALE\@@ -195,8 +202,30 @@ , CODEC_FLAG_LOOP_FILTER\ , CODEC_FLAG_INTERLACED_ME\ , CODEC_FLAG_CLOSED_GOP+#else+#enum CodecFlag, CodecFlag \+ , AV_CODEC_FLAG_UNALIGNED\+ , AV_CODEC_FLAG_QSCALE\+ , AV_CODEC_FLAG_4MV\+ , AV_CODEC_FLAG_OUTPUT_CORRUPT\+ , AV_CODEC_FLAG_QPEL\+ , AV_CODEC_FLAG_PASS1\+ , AV_CODEC_FLAG_PASS2\+ , AV_CODEC_FLAG_LOOP_FILTER\+ , AV_CODEC_FLAG_GRAY\+ , AV_CODEC_FLAG_PSNR\+ , AV_CODEC_FLAG_TRUNCATED\+ , AV_CODEC_FLAG_INTERLACED_DCT\+ , AV_CODEC_FLAG_LOW_DELAY\+ , AV_CODEC_FLAG_GLOBAL_HEADER\+ , AV_CODEC_FLAG_BITEXACT\+ , AV_CODEC_FLAG_AC_PRED\+ , AV_CODEC_FLAG_INTERLACED_ME\+ , AV_CODEC_FLAG_CLOSED_GOP+#endif newtype FormatFlag = FormatFlag CInt deriving (Eq, Bits, Storable)+#if LIBAVCODEC_VERSION_MAJOR < 57 #enum FormatFlag, FormatFlag \ , AVFMT_NOFILE\ , AVFMT_NEEDNUMBER\@@ -208,6 +237,23 @@ , AVFMT_NOSTREAMS\ , AVFMT_ALLOW_FLUSH\ , AVFMT_TS_NONSTRICT+#else+#enum FormatFlag, FormatFlag \+ , AVFMT_NOFILE\+ , AVFMT_NEEDNUMBER\+ , AVFMT_GLOBALHEADER\+ , AVFMT_NOTIMESTAMPS\+ , AVFMT_VARIABLE_FPS\+ , AVFMT_NODIMENSIONS\+ , AVFMT_NOSTREAMS\+ , AVFMT_NOBINSEARCH\+ , AVFMT_NOGENSEARCH\+ , AVFMT_NO_BYTE_SEEK\+ , AVFMT_ALLOW_FLUSH\+ , AVFMT_TS_NONSTRICT\+ , AVFMT_TS_NEGATIVE\+ , AVFMT_SEEK_TO_PTS+#endif newtype PacketFlag = PacketFlag CInt deriving (Eq, Bits, Storable) #enum PacketFlag, PacketFlag \
src/Codec/FFmpeg/Types.hsc view
@@ -203,6 +203,7 @@ where b = fromIntegral (numerator bq) * fromIntegral (denomenator cq) c = fromIntegral (numerator cq) * fromIntegral (denomenator bq) +#if LIBAVFORMAT_VERSION_MAJOR < 57 data AVFrac = AVFrac { fracVal :: CLong , fracNum :: CLong , fracDen :: CLong } deriving Show@@ -216,6 +217,7 @@ poke ptr (AVFrac v n d) = do (#poke AVFrac, val) ptr v (#poke AVFrac, num) ptr n (#poke AVFrac, den) ptr d+#endif -- | The input source can be a file or a camera. When using 'Camera', -- frequently in the form @Camera "0:0" defaultCameraConfig@, the first input video device