ffmpeg-light 0.2.0.1 → 0.3
raw patch · 7 files changed
+179/−45 lines, 7 filesdep +Rasterificdep ~JuicyPixelsdep ~basedep ~mtlnew-component:exe:raster
Dependencies added: Rasterific
Dependency ranges changed: JuicyPixels, base, mtl, transformers, vector
Files
- demo/Raster.hs +2/−0
- ffmpeg-light.cabal +17/−4
- src/Codec/FFmpeg/Encode.hs +93/−39
- src/Codec/FFmpeg/Enums.hsc +13/−0
- src/Codec/FFmpeg/Internal/Debug.hsc +30/−0
- src/Codec/FFmpeg/Types.hsc +16/−2
- src/nameCompat.h +8/−0
+ demo/Raster.hs view
@@ -0,0 +1,2 @@+module Main where+import Codec.FFmpeg
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.2.0.1+version: 0.3 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -34,9 +34,13 @@ location: http://github.com/acowley/ffmpeg-light.git flag BuildDemo- description: Build demo executable+ description: Build simple demo executable default: False +flag BuildRasterDemo+ description: Build Rasterific demo executable+ default: False+ library exposed-modules: Codec.FFmpeg, Codec.FFmpeg.Common,@@ -48,7 +52,7 @@ Codec.FFmpeg.Types, Codec.FFmpeg.Internal.Debug build-tools: hsc2hs- build-depends: base >=4.6 && < 5, + build-depends: base >=4.6 && < 5, vector >= 0.10.9 && < 0.11, transformers >= 0.3 && < 0.4, mtl >= 2.1.3 && < 2.2,@@ -68,4 +72,13 @@ main-is: Main.hs default-language: Haskell2010 ghc-options: -Wall- ++executable raster+ if !flag(BuildRasterDemo)+ buildable: False+ build-depends: base < 5, vector, mtl, transformers,+ ffmpeg-light, JuicyPixels, Rasterific+ hs-source-dirs: demo+ main-is: Raster.hs+ default-language: Haskell2010+ ghc-options: -Wall
src/Codec/FFmpeg/Encode.hs view
@@ -9,7 +9,7 @@ import Codec.FFmpeg.Types import Codec.Picture import Control.Applicative-import Control.Monad (when)+import Control.Monad (when, void) import Control.Monad.Error.Class import Data.Bits import Data.Maybe (fromMaybe)@@ -79,20 +79,38 @@ foreign import ccall "avformat_free_context" avformat_free_context :: AVFormatContext -> IO () +foreign import ccall "av_image_fill_arrays"+ av_image_fill_arrays :: Ptr (Ptr CUChar) -> Ptr CInt -> Ptr CUChar+ -> AVPixelFormat -> CInt -> CInt -> CInt -> IO CInt+ -- * FFmpeg Encoding Interface -- | Minimal parameters describing the desired video output. data EncodingParams = EncodingParams { epWidth :: CInt , epHeight :: CInt , epFps :: Int- , epCodec :: AVCodecID+ , epCodec :: Maybe AVCodecID+ -- ^ If 'Nothing', then the codec+ -- is inferred from the output+ -- file name. If 'Just', then+ -- this codec is manually chosen. , epPreset :: String } -- | Use default parameters for a video of the given width and--- height. This produces an h264 encoded stream.+-- height, forcing the choice of the h264 encoder.+defaultH264 :: CInt -> CInt -> EncodingParams+defaultH264 w h = EncodingParams w h 30 (Just avCodecIdH264) "medium"++-- | Use default parameters for a video of the given width and+-- height. The output format is determined by the output file name. defaultParams :: CInt -> CInt -> EncodingParams-defaultParams w h = EncodingParams w h 30 avCodecIdH264 "medium"+defaultParams w h = EncodingParams w h 30 Nothing "" +-- | Determine if the bitwise intersection of two values is non-zero.+checkFlag :: Bits a => a -> a -> Bool+checkFlag flg = \x -> (flg .&. x) /= allZeroBits+ where allZeroBits = clearBit (bit 0) 0+ -- | Find and initialize the requested encoder, and add a video stream -- to the output container. initStream :: EncodingParams -> AVFormatContext -> IO (AVStream, AVCodecContext)@@ -100,9 +118,12 @@ | (epWidth ep `rem` 2, epHeight ep `rem` 2) /= (0,0) = throwError $ strMsg "Video dimensions must be multiples of two" initStream ep oc = do- cod <- avcodec_find_encoder (epCodec ep)+ -- 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)- (throwError $ strMsg "Couldn't find H264 encoder")+ (errMsg "Couldn't find encoder") st <- avformat_new_stream oc cod getNumStreams oc >>= setId st . subtract 1@@ -112,11 +133,15 @@ setHeight ctx (epHeight ep) let framePeriod = AVRational 1 (fromIntegral $ epFps ep) setTimeBase ctx framePeriod- setPixelFormat ctx avPixFmtYuv420p- + setPixelFormat ctx $ case () of+ _ | codec == avCodecIdRawvideo -> avPixFmtRgb24+ | codec == avCodecIdGif -> avPixFmtPal8+ | otherwise -> avPixFmtYuv420p+ -- Some formats want stream headers to be separate- outputFlags <- getOutputFormat oc >>= getFormatFlags- when (outputFlags .&. avfmtGlobalheader /= clearBit (bit 0) 0) $+ needsHeader <- checkFlag avfmtGlobalheader <$> + (getOutputFormat oc >>= getFormatFlags)+ when needsHeader $ getCodecFlags ctx >>= setCodecFlags ctx . (.|. codecFlagGlobalHeader) -- _ <- withCString "vprofile" $ \kStr ->@@ -130,6 +155,7 @@ rOpen <- open_codec ctx cod nullPtr when (rOpen < 0) (throwError $ strMsg "Couldn't open codec")+ return (st, ctx) -- | Initialize a temporary YUV frame of the same resolution as the@@ -149,15 +175,16 @@ -- file name. allocOutputContext :: FilePath -> IO AVFormatContext allocOutputContext fname = do- oc <- alloca $ \ocTmp ->- withCString fname $ \fname' -> do- r <- avformat_alloc_output_context ocTmp (AVOutputFormat nullPtr)- nullPtr fname'- when (r < 0)- (throwError $ strMsg "Couldn't allocate output format context")- peek ocTmp+ oc <- alloca $ \ocTmp -> do+ r <- withCString fname $ \fname' -> + avformat_alloc_output_context+ ocTmp (AVOutputFormat nullPtr)+ nullPtr fname'+ when (r < 0)+ (errMsg "Couldn't allocate output format context")+ peek ocTmp when (getPtr oc == nullPtr)- (throwError $ strMsg "Couldn't allocate output AVFormatContext")+ (errMsg "Couldn't allocate output AVFormatContext") return oc -- | Open the given file for writing.@@ -215,10 +242,14 @@ dstFmt <- getPixelFormat ctx dstFrame <- initTempFrame ep dstFmt - -- Initialize the scaler that we use to convert RGB -> YUV - sws <- swsInit (ImageInfo (epWidth ep) (epHeight ep) avPixFmtRgb24)- (ImageInfo (epWidth ep) (epHeight ep) dstFmt)- swsBilinear+ -- Initialize the scaler that we use to convert RGB -> dstFmt+ -- Note that libswscaler does not support Pal8 as an output format.+ sws <- if dstFmt /= avPixFmtPal8+ then Just <$> + swsInit (ImageInfo (epWidth ep) (epHeight ep) avPixFmtRgb24)+ (ImageInfo (epWidth ep) (epHeight ep) dstFmt)+ swsBilinear+ else return Nothing pkt <- AVPacket <$> mallocBytes packetSize @@ -228,6 +259,8 @@ tb <- getTimeBase st codecTB <- getCodecContext st >>= getTimeBase+ isRaw <- checkFlag avfmtRawpicture <$> (getOutputFormat oc >>= getFormatFlags)+ let frameTime = av_rescale_q 1 codecTB tb mkImage :: Vector CUChar -> Image PixelRGB8 mkImage = let [w,h] = map fromIntegral [epWidth ep, epHeight ep]@@ -237,21 +270,42 @@ setSize pkt 0 writePacket = do setStreamIndex pkt stIndex write_frame_check oc pkt- go Nothing = do- resetPacket- goOn <- encode_video_check ctx pkt Nothing- if goOn- then writePacket >> go Nothing- else do write_trailer_check oc- _ <- codec_close ctx- with dstFrame av_frame_free- avio_close_check oc- avformat_free_context oc-- go (Just pixels) = do- resetPacket- _ <- swsScale sws (mkImage pixels) dstFrame-- getPts dstFrame >>= setPts dstFrame . (+ frameTime)- encode_video_check ctx pkt (Just dstFrame) >>= flip when writePacket+ copyDstData pixels =+ void . V.unsafeWith pixels $ \ptr ->+ av_image_fill_arrays (castPtr $ hasData dstFrame)+ (hasLineSize dstFrame)+ (castPtr ptr)+ dstFmt+ (epWidth ep)+ (epHeight ep)+ 1+ scaleToDst sws' pixels = void $ swsScale sws' (mkImage pixels) dstFrame+ fillDst = maybe copyDstData scaleToDst sws+ addRaw Nothing = return ()+ addRaw (Just pixels) =+ do resetPacket+ getPacketFlags pkt >>= setPacketFlags pkt . (.|. avPktFlagKey)+ setSize pkt (fromIntegral $ V.length pixels)+ getPts dstFrame >>= setPts dstFrame . (+ frameTime)+ getPts dstFrame >>= setPts pkt+ getPts dstFrame >>= setDts pkt+ V.unsafeWith pixels $ \ptr -> do+ setData pkt (castPtr ptr)+ writePacket+ addEncoded Nothing = do resetPacket+ encode_video_check ctx pkt Nothing >>=+ flip when (writePacket >> addEncoded Nothing)+ addEncoded (Just pixels) =+ do resetPacket+ fillDst pixels+ getPts dstFrame >>= setPts dstFrame . (+ frameTime)+ encode_video_check ctx pkt (Just dstFrame) >>= flip when writePacket+ addFrame = if isRaw then addRaw else addEncoded+ go Nothing = do addFrame Nothing+ write_trailer_check oc+ _ <- codec_close ctx+ with dstFrame av_frame_free+ avio_close_check oc+ avformat_free_context oc+ go (Just pixels) = addFrame (Just pixels) return go
src/Codec/FFmpeg/Enums.hsc view
@@ -30,12 +30,17 @@ newtype AVPixelFormat = AVPixelFormat CInt deriving (Eq, Storable) #enum AVPixelFormat,AVPixelFormat \+ , AV_PIX_FMT_NONE\ , AV_PIX_FMT_RGB24\ , AV_PIX_FMT_Y400A\ , AV_PIX_FMT_RGB32\ , AV_PIX_FMT_RGB32_1\ , AV_PIX_FMT_BGR32\ , AV_PIX_FMT_BGR32_1\+ , AV_PIX_FMT_RGB8\+ , AV_PIX_FMT_BGR8\+ , AV_PIX_FMT_RGB4_BYTE\+ , AV_PIX_FMT_BGR4_BYTE\ , AV_PIX_FMT_GRAY8\ , AV_PIX_FMT_GRAY16\ , AV_PIX_FMT_GRAY8A\@@ -69,9 +74,12 @@ newtype AVCodecID = AVCodecID CInt deriving (Eq, Show, Storable) #enum AVCodecID,AVCodecID \ , AV_CODEC_ID_H264\+ , AV_CODEC_ID_HEVC\ , AV_CODEC_ID_THEORA\+ , AV_CODEC_ID_VC1\ , AV_CODEC_ID_MPEG4\ , AV_CODEC_ID_MPEG2VIDEO\+ , AV_CODEC_ID_RAWVIDEO\ , AV_CODEC_ID_GIF\ , AV_CODEC_ID_AAC\ , AV_CODEC_ID_MP3\@@ -205,3 +213,8 @@ , AVFMT_NOSTREAMS\ , AVFMT_ALLOW_FLUSH\ , AVFMT_TS_NONSTRICT++newtype PacketFlag = PacketFlag CInt deriving (Eq, Bits, Storable)+#enum PacketFlag, PacketFlag \+ , AV_PKT_FLAG_KEY\+ , AV_PKT_FLAG_CORRUPT
src/Codec/FFmpeg/Internal/Debug.hsc view
@@ -1,8 +1,12 @@ -- | Helpers for dumping information about codecs to stdout. module Codec.FFmpeg.Internal.Debug where+import Codec.FFmpeg.Enums import Codec.FFmpeg.Types+import Control.Monad (when, (>=>)) import Foreign.C.String import Foreign.C.Types+import Foreign.Marshal.Array (advancePtr)+import Foreign.Ptr (nullPtr) import Foreign.Storable #include <libavcodec/avcodec.h>@@ -39,3 +43,29 @@ (#peek AVCodecContext, me_range) p >>= si "me_range" putStrLn "" where si msg = putStrLn . ((msg++" = ")++) . show :: CInt -> IO ()++foreign import ccall "av_get_pix_fmt_name"+ av_get_pix_fmt_name :: AVPixelFormat -> IO CString++pixFmtName :: AVPixelFormat -> IO String+pixFmtName = av_get_pix_fmt_name >=> peekCString++-- | Print all pixel formats supported by a given 'AVCodec'.+debugPixelFormats :: AVCodec -> IO ()+debugPixelFormats cod = putStrLn "Supported pixel formats:" >>+ getPixelFormats cod >>= go 0+ where go i fmts+ = let ptr = advancePtr fmts i+ in when (ptr /= nullPtr) $ do+ fmt <- peek ptr+ when (fmt /= avPixFmtNone) $ do+ av_get_pix_fmt_name fmt >>= peekCString >>=+ putStrLn . (" " ++)+ go (i+1) fmts++foreign import ccall "avcodec_get_name"+ avcodec_get_name :: AVCodecID -> IO CString++-- | Get the name of a codec.+debugCodecName :: AVCodecID -> IO String+debugCodecName = avcodec_get_name >=> peekCString
src/Codec/FFmpeg/Types.hsc view
@@ -65,10 +65,12 @@ newtype AVCodec = AVCodec (Ptr ()) deriving (Storable, HasPtr) #mkField LongName, CString #mkField Name, CString+#mkField PixelFormats, (Ptr AVPixelFormat) #hasField AVCodec, LongName, long_name #hasField AVCodec, Name, name #hasField AVCodec, CodecID, id+#hasField AVCodec, PixelFormats, pix_fmts newtype AVDictionary = AVDictionary (Ptr ()) deriving (Storable, HasPtr) newtype AVFrame = AVFrame (Ptr ()) deriving (Storable, HasPtr)@@ -85,24 +87,36 @@ #hasField AVFrame, Data, data newtype AVPicture = AVPicture (Ptr ()) deriving (Storable, HasPtr)+#hasField AVPicture, Data, data+ newtype SwsContext = SwsContext (Ptr ()) deriving (Storable, HasPtr) newtype AVOutputFormat = AVOutputFormat (Ptr ()) deriving (Storable, HasPtr) #mkField FormatFlags, FormatFlag+#mkField VideoCodecID, AVCodecID #hasField AVOutputFormat, FormatFlags, flags+#hasField AVOutputFormat, VideoCodecID, video_codec newtype AVIOContext = AVIOContext (Ptr ()) deriving (Storable, HasPtr) newtype AVPacket = AVPacket (Ptr ()) deriving (Storable, HasPtr) #mkField Data, (Ptr ())-#hasField AVPacket, Data, data #mkField Size, CInt-#hasField AVPacket, Size, size+#mkField PacketFlags, PacketFlag+#mkField Dts, CLong +#hasField AVPacket, Data, data+#hasField AVPacket, Size, size+#hasField AVPacket, PacketFlags, flags #hasField AVPacket, StreamIndex, stream_index+#hasField AVPacket, Pts, pts+#hasField AVPacket, Dts, dts -- | @sizeof@ the 'AVPacket' structure in bytes. packetSize :: Int packetSize = #size AVPacket++pictureSize :: Int+pictureSize = #size AVPicture -- * Types with Haskell equivalents
src/nameCompat.h view
@@ -3,12 +3,17 @@ are locked down with these old versions, we hack in support for the newer constant names. */ +#define AV_PIX_FMT_NONE PIX_FMT_NONE #define AV_PIX_FMT_RGB24 PIX_FMT_RGB24 #define AV_PIX_FMT_Y400A PIX_FMT_Y400A #define AV_PIX_FMT_RGB32 PIX_FMT_RGB32 #define AV_PIX_FMT_RGB32_1 PIX_FMT_RGB32_1 #define AV_PIX_FMT_BGR32 PIX_FMT_BGR32 #define AV_PIX_FMT_BGR32_1 PIX_FMT_BGR32_1+#define AV_PIX_FMT_RGB8 -1+#define AV_PIX_FMT_BGR8 -1+#define AV_PIX_FMT_RGB4_BYTE -1+#define AV_PIX_FMT_BGR4_BYTE -1 #define AV_PIX_FMT_GRAY8 PIX_FMT_GRAY8 #define AV_PIX_FMT_GRAY16 PIX_FMT_GRAY16 #define AV_PIX_FMT_GRAY8A -1@@ -38,6 +43,9 @@ #define AV_CODEC_ID_AAC CODEC_ID_AAC #define AV_CODEC_ID_MP3 CODEC_ID_MP3 #define AV_CODEC_ID_DTS CODEC_ID_DTS+#define AV_CODEC_ID_HEVC -1+#define AV_CODEC_ID_VC1 -1+#define AV_CODEC_ID_RAWVIDEO CODEC_ID_RAWVIDEO #define FF_PROFILE_AAC_HE -1 #define FF_PROFILE_AAC_HE_V2 -1