packages feed

ffmpeg-light 0.1.0.1 → 0.2

raw patch · 9 files changed

+300/−46 lines, 9 filesdep +ffmpeg-lightdep ~JuicyPixelsdep ~basedep ~mtlnew-component:exe:demo

Dependencies added: ffmpeg-light

Dependency ranges changed: JuicyPixels, base, mtl, transformers, vector

Files

+ demo/Main.hs view
@@ -0,0 +1,67 @@+import Codec.FFmpeg+import Codec.Picture+import Control.Applicative+import Control.Monad.Error+import Control.Monad.Trans.Maybe+import qualified Data.Vector.Storable as V+import System.Environment++-- The example used in the README+firstFrame :: IO (Maybe DynamicImage)+firstFrame = do (getFrame, cleanup) <- frameReaderT "myVideo.mov"+                (runMaybeT $ getFrame >>= toJuicyT) <* cleanup++-- | Generate a video that pulses from light to dark.+pulseVid :: IO ()+pulseVid =+  do boom <- frameWriter (defaultParams sz sz) "pulse.mov"+     let go :: Int -> Int -> Int -> IO ()+         go 600 _ _ = boom Nothing+         go n d i = do boom (Just $ V.replicate (fromIntegral $ sz*sz*3) +                                                (fromIntegral i))+                       let i' = i + d+                       if i' < 100 +                       then go (n+1) 1 101+                       else if i' > 255 +                            then go (n+1) (-1) 254+                            else go (n+1) d i'+                +     go 0 (-1) 255+  where sz = 64++testEncode :: IO ()+testEncode = initFFmpeg >> pulseVid >> putStrLn "All done!"++testDecode :: FilePath -> IO ()+testDecode vidFile = +  do initFFmpeg+     (getFrame, cleanup) <- frameReaderTime vidFile+     frame1 <- getFrame+     case frame1 of+       Just (avf,ts) -> do putStrLn $ "Frame at "++show ts+                           saveJuicy "frame1.png" avf+       Nothing -> putStrLn "No frame for me :("+     replicateM_ 299 getFrame+     frame2 <- getFrame+     case frame2 of+       Just (avf,ts) -> do putStrLn $ "Frame at "++show ts+                           saveJuicy "frame2.png" avf+       Nothing -> putStrLn "No frame for me :("+     cleanup+     putStrLn "All done!"++main :: IO ()+main = do args <- getArgs+          case args of+            [] -> testEncode+            [vidFile] -> testDecode vidFile+            _ -> error usage+  where usage = +          unlines [ "Usage: demo [videoFile]"+                  , "  If no argument is given, a test video named "+                  , "  pulse.mov is generated."+                  , ""+                  , "  If a file name is given, then two frames are "+                  , "  extracted: the first frame, and the 301st."+                  , "  These are saved to frame1.png and frame2.png" ]+
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name:                ffmpeg-light-version:             0.1.0.1+version:             0.2 synopsis:            Minimal bindings to the FFmpeg library.  description:         Stream frames from an encoded video, or stream frames to@@ -10,11 +10,11 @@                      > import Codec.FFmpeg                      > import Codec.Picture                      > import Control.Applicative-                     > import Data.Traversable+                     > import Control.Monad.Trans.Maybe                      >                      > go :: IO (Maybe DynamicImage)-                     > go = do (getFrame, cleanup) <- frameReader "myVideo.mov"-                     >         (getFrame >>= traverse juicyRGB) <* cleanup+                     > go = do (getFrame, cleanup) <- frameReaderT "myVideo.mov"+                     >         (runMaybeT $ getFrame >>= toJuicyT) <* cleanup                      .                      Tested on OS X 10.9.2 with <http://www.ffmpeg.org FFmpeg> 2.2.1                      installed via <http://brew.sh homebrew>.@@ -26,13 +26,17 @@ copyright:           Copyright (C) 2014 Anthony Cowley category:            Codec build-type:          Simple-extra-source-files:  src/hscMacros.h+extra-source-files:  src/hscMacros.h, src/nameCompat.h cabal-version:       >=1.10  source-repository head   type:     git   location: http://github.com/acowley/ffmpeg-light.git +flag BuildDemo+  description: Build demo executable+  default:     False+ library   exposed-modules:     Codec.FFmpeg,                        Codec.FFmpeg.Common,@@ -40,6 +44,7 @@                        Codec.FFmpeg.Encode,                        Codec.FFmpeg.Enums,                        Codec.FFmpeg.Juicy,+                       Codec.FFmpeg.Scaler,                        Codec.FFmpeg.Types,                        Codec.FFmpeg.Internal.Debug   build-tools:         hsc2hs@@ -53,3 +58,14 @@   include-dirs:        src   default-language:    Haskell2010   ghc-options:         -Wall++executable demo+  if !flag(BuildDemo)+    buildable:      False+  build-depends:    base < 5, vector, mtl, transformers,+                    ffmpeg-light, JuicyPixels+  hs-source-dirs:   demo+  main-is:          Main.hs+  default-language: Haskell2010+  ghc-options:      -Wall+
src/Codec/FFmpeg.hs view
@@ -4,11 +4,12 @@ module Codec.FFmpeg (-- * Initialization                      initFFmpeg,                       -- * Decoding-                     frameReader, frameReaderTime,+                     frameReader, frameReaderT,+                     frameReaderTime, frameReaderTimeT,                      -- * Encoding                      EncodingParams(..), defaultParams, frameWriter,                      -- * JuicyPixels interop-                     juicyRGB, saveJuicyRGB,+                     toJuicy, toJuicyT, saveJuicy,                      -- * Types and Enums                      module Codec.FFmpeg.Types,                       module Codec.FFmpeg.Enums
src/Codec/FFmpeg/Decode.hs view
@@ -5,11 +5,14 @@ module Codec.FFmpeg.Decode where import Codec.FFmpeg.Common import Codec.FFmpeg.Enums+import Codec.FFmpeg.Scaler import Codec.FFmpeg.Types import Control.Applicative+import Control.Arrow (first) import Control.Monad (when) import Control.Monad.Error.Class import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc (alloca, free, mallocBytes)@@ -136,6 +139,13 @@      _ <- openCodec ctx cod      prepareReader inputContext vidStreamIndex ctx +-- | 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)+             => FilePath -> m (MaybeT IO AVFrame, IO ())+frameReaderT = fmap (first MaybeT) . frameReader+ -- | Read time stamped RGB frames from a video stream. Time is given -- in seconds from the start of the stream. frameReaderTime :: (MonadIO m, Error e, MonadError e m)@@ -158,6 +168,14 @@                                     return $ Just (f, t)      return (readTS, cleanup) +-- | Read time stamped RGB frames with the result in the 'MaybeT'+-- transformer.+-- +-- > frameReaderT = fmap (first MaybeT) . frameReader+frameReaderTimeT :: (Functor m, MonadIO m, Error e, MonadError e m)+                 => FilePath -> m (MaybeT IO (AVFrame, Double), IO ())+frameReaderTimeT = fmap (first MaybeT) . frameReaderTime+ -- | 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)@@ -178,11 +196,8 @@       frame_get_buffer_check fRgb 32 -     sws <- sws_getCachedContext (SwsContext nullPtr) -              w h fmt-              w h avPixFmtRgb24-              swsBilinear-              nullPtr nullPtr nullPtr+     sws <- swsInit (ImageInfo w h fmt) (ImageInfo w h avPixFmtRgb24) +                    swsBilinear       pkt <- AVPacket <$> mallocBytes packetSize      let cleanup = do with fRgb av_frame_free@@ -208,12 +223,8 @@                --           (#poke AVPacket, size) pkt (0::CInt)                --           decode_video codCtx fRaw fin2 pkt                --           peek fin2-               let frameData = castPtr $ hasData fRaw-                   lnSize = hasLineSize fRaw-                   rgbData = castPtr $ hasData fRgb-                   rgbLnSize = hasLineSize fRgb -               _ <- sws_scale sws frameData lnSize 0 h rgbData rgbLnSize+               _ <- swsScale sws fRaw fRgb                 -- Copy the raw frame's timestamp to the RGB frame                getPktPts fRaw >>= setPts fRgb
src/Codec/FFmpeg/Encode.hs view
@@ -5,7 +5,9 @@ module Codec.FFmpeg.Encode where import Codec.FFmpeg.Common import Codec.FFmpeg.Enums+import Codec.FFmpeg.Scaler import Codec.FFmpeg.Types+import Codec.Picture import Control.Applicative import Control.Monad (when) import Control.Monad.Error.Class@@ -16,7 +18,6 @@ import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc-import Foreign.Marshal.Array import Foreign.Marshal.Utils  import Foreign.Ptr@@ -134,10 +135,10 @@ -- | Initialize a temporary YUV frame of the same resolution as the -- output video stream. We well convert RGB frames using this frame as -- a destination before encoding the video frame.-initTempYuv :: EncodingParams -> IO AVFrame-initTempYuv ep = do+initTempFrame :: EncodingParams -> AVPixelFormat -> IO AVFrame+initTempFrame ep fmt = do   yuv <- frame_alloc_check-  setPixelFormat yuv avPixFmtYuv420p+  setPixelFormat yuv fmt   setWidth yuv (epWidth ep)   setHeight yuv (epHeight ep)   setPts yuv 0@@ -211,12 +212,13 @@   oc <- allocOutputContext fname   (st,ctx) <- initStream ep oc -  yuv <- initTempYuv ep+  dstFmt <- getPixelFormat ctx+  dstFrame <- initTempFrame ep dstFmt -  sws <- sws_getCachedContext (SwsContext nullPtr)-           (epWidth ep) (epHeight ep) avPixFmtRgb24-           (epWidth ep) (epHeight ep) avPixFmtYuv420p-           swsBilinear nullPtr nullPtr nullPtr+  -- 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    pkt <- AVPacket <$> mallocBytes packetSize @@ -227,8 +229,10 @@   tb <- getTimeBase st   codecTB <- getCodecContext st >>= getTimeBase   let frameTime = av_rescale_q 1 codecTB tb--  let resetPacket = do init_packet pkt+      mkImage :: Vector CUChar -> Image PixelRGB8+      mkImage = let [w,h] = map fromIntegral [epWidth ep, epHeight ep]+                in Image w h . V.unsafeCast+      resetPacket = do init_packet pkt                        setData pkt nullPtr                        setSize pkt 0       writePacket = do setStreamIndex pkt stIndex@@ -240,21 +244,14 @@         then writePacket >> go Nothing         else do write_trailer_check oc                 _ <- codec_close ctx-                with yuv av_frame_free+                with dstFrame av_frame_free                 avio_close_check oc                 avformat_free_context oc        go (Just pixels) = do         resetPacket-        let yuvData = castPtr $ hasData yuv-            yuvStride = hasLineSize yuv--        _ <- V.unsafeWith pixels $ \pixelPtr ->-               withArray (pixelPtr : replicate 7 nullPtr) $ \srcArray ->-                 withArray (epWidth ep * 3 : replicate 7 0) $ \strides ->-                   sws_scale sws srcArray strides 0 (epHeight ep) -                             yuvData yuvStride+        _ <- swsScale sws (mkImage pixels) dstFrame -        getPts yuv >>= setPts yuv . (+ frameTime)-        encode_video_check ctx pkt (Just yuv) >>= flip when writePacket+        getPts dstFrame >>= setPts dstFrame . (+ frameTime)+        encode_video_check ctx pkt (Just dstFrame) >>= flip when writePacket   return go
src/Codec/FFmpeg/Enums.hsc view
@@ -7,8 +7,18 @@ #include <libavcodec/avcodec.h> #include <libavformat/avformat.h> #include <libavutil/avutil.h>+#include <libavutil/pixfmt.h>+#include <libavutil/mathematics.h> #include <libswscale/swscale.h> +#ifndef PIX_FMT_RGBA64+-- WARNING: Fragile! This pixel format is not defined in older+-- versions. Note that many FFI calls will fail at runtime with older+-- versions, so all this does is let us the haskell code.+#warning "This version of libav/ffmpeg is too old. It is not likely to work."+#include "nameCompat.h"+#endif+ newtype AVMediaType = AVMediaType CInt deriving (Eq, Storable) #enum AVMediaType,AVMediaType \  , AVMEDIA_TYPE_VIDEO\@@ -29,6 +39,7 @@  , AV_PIX_FMT_GRAY8\  , AV_PIX_FMT_GRAY16\  , AV_PIX_FMT_GRAY8A\+ , AV_PIX_FMT_PAL8\  , AV_PIX_FMT_RGB565\  , AV_PIX_FMT_RGB555\  , AV_PIX_FMT_YUV420P\@@ -149,6 +160,10 @@  newtype AVRoundMode = AVRoundMode CInt deriving (Eq, Storable) #enum AVRoundMode, AVRoundMode \+ , AV_ROUND_ZERO\+ , AV_ROUND_INF\+ , AV_ROUND_DOWN\+ , AV_ROUND_UP\  , AV_ROUND_NEAR_INF\  , AV_ROUND_PASS_MINMAX
src/Codec/FFmpeg/Juicy.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} -- | Convert between FFmpeg frames and JuicyPixels images. module Codec.FFmpeg.Juicy where import Codec.Picture@@ -6,15 +7,24 @@ import Control.Applicative import Control.Arrow ((&&&)) import Control.Monad (when, (>=>))+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.Marshal.Array (advancePtr, copyArray) import Foreign.Ptr (castPtr, Ptr) --- | Convert an RGB24 'AVFrame' to a 'DynamicImage'.-juicyRGB :: AVFrame -> IO DynamicImage-juicyRGB frame = do+-- | Convert an 'AVFrame' to a 'DynamicImage' with the result in the+-- 'MaybeT' transformer.+-- +-- > toJuicyT = MaybeT . toJuicy+toJuicyT :: AVFrame -> MaybeT IO DynamicImage+toJuicyT = MaybeT . toJuicy++-- | Convert an 'AVFrame' to a 'DynamicImage'.+toJuicy :: AVFrame -> IO (Maybe DynamicImage)+toJuicy frame = do   fmt <- getPixelFormat frame   when (fmt /= avPixFmtRgb24)        (putStrLn "Not RGB24?!")@@ -30,8 +40,17 @@                                (w * 3))           (map ((srcStride *) &&& (dstStride*)) [0 .. h - 1])   v' <- V.unsafeFreeze v-  return $ ImageRGB8 (Image w h (V.unsafeCast v'))+  let mkImage :: V.Storable (PixelBaseComponent a)+              => (Image a -> DynamicImage) -> Maybe DynamicImage+      mkImage c = Just $ c (Image w h (V.unsafeCast v'))+  return $+    case () of+      _ | fmt == avPixFmtRgb24 -> mkImage ImageRGB8+        | fmt == avPixFmtGray8 -> mkImage ImageY8+        | fmt == avPixFmtGray16 -> mkImage ImageY16+        | otherwise -> Nothing --- | Save an RGB24 'AVFrame' to a PNG file on disk.-saveJuicyRGB :: FilePath -> AVFrame -> IO ()-saveJuicyRGB name = juicyRGB >=> savePngImage name +-- | 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 name = toJuicy >=> traverse_ (savePngImage name)
+ src/Codec/FFmpeg/Scaler.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}+module Codec.FFmpeg.Scaler where+import Codec.FFmpeg.Common+import Codec.FFmpeg.Enums+import Codec.FFmpeg.Types+import Codec.Picture+import qualified Data.Vector.Storable as V+import Foreign.C.Types+import Foreign.Marshal.Array (withArray)+import Foreign.Ptr (castPtr, nullPtr, Ptr)+import Foreign.Storable (Storable(sizeOf))++data ImageInfo = ImageInfo { imgWidth  :: CInt+                           , imgHeight :: CInt+                           , imgFormat :: AVPixelFormat }++swsInit :: ImageInfo -> ImageInfo -> SwsAlgorithm -> IO SwsContext+swsInit = swsReset (SwsContext nullPtr)++-- | Obtain a context for converting the source to destination+-- format. If the given context is already configured for the required+-- conversion, it is returned. Otherwise, the given context is freed+-- and a new, configured context is returned.+swsReset :: SwsContext -> ImageInfo -> ImageInfo -> SwsAlgorithm+         -> IO SwsContext+swsReset ctx src dst alg = sws_getCachedContext ctx+                             srcW srcH srcFmt+                             dstW dstH dstFmt+                             alg nullPtr nullPtr nullPtr+  where ImageInfo srcW srcH srcFmt = src+        ImageInfo dstW dstH dstFmt = dst++-- | A common interface required of arguments to 'swsScale' (a higher+-- level wrapper for the 'sws_scale' function from @libswscale@).+class SwsCompatible a where+  swsPlanes :: a -> (Ptr (Ptr CUChar) -> IO r) -> IO r+  swsStrides :: a -> (Ptr CInt -> IO r) -> IO r+  sliceHeight :: a -> (CInt -> IO r) -> IO r++instance SwsCompatible AVFrame where+  swsPlanes frame k = k (castPtr $ hasData frame)+  swsStrides frame k = k (hasLineSize frame)+  sliceHeight frame k = getHeight frame >>= k++instance (Pixel a, Storable (PixelBaseComponent a))+  => SwsCompatible (Image a) where+  swsPlanes img k = V.unsafeWith (imageData img) $ \ptr ->+                      withArray (castPtr ptr : replicate 7 nullPtr) k+  swsStrides img k = withArray (stride : replicate 7 0) k+    where sz = sizeOf (undefined::PixelBaseComponent a) * +               componentCount (undefined :: a)+          stride = fromIntegral $ imageWidth img * sz+  sliceHeight img k = k (fromIntegral $ imageHeight img)++-- | Supplies a continuation with all components provided by the+-- 'SwsCompatible' class.+withSws :: SwsCompatible a+        => a -> (Ptr (Ptr CUChar) -> Ptr CInt -> CInt -> IO r) -> IO r+withSws img k = swsPlanes img $ \planes ->+                  swsStrides img $ \strides ->+                    sliceHeight img $ \height ->+                      k planes strides height+                        +-- | @swsScale ctx src dst@ scales the entire @src@ image to @dst@+-- using the previously initialized @ctx@.+swsScale :: (SwsCompatible src, SwsCompatible dst)+         => SwsContext -> src -> dst -> IO CInt+swsScale ctx src dst = withSws src $ \srcPlanes srcStrides srcHeight ->+                         withSws dst $ \dstPlanes dstStrides _ ->+                           sws_scale ctx srcPlanes srcStrides+                                     0 srcHeight+                                     dstPlanes dstStrides
+ src/nameCompat.h view
@@ -0,0 +1,56 @@+/* Older versions of libav (and perhaps ffmpeg) used a different+   naming scheme for constants. Since distributions like Ubuntu 12.04+   are locked down with these old versions, we hack in support for the+   newer constant names. */++#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_GRAY8 PIX_FMT_GRAY8+#define AV_PIX_FMT_GRAY16 PIX_FMT_GRAY16+#define AV_PIX_FMT_GRAY8A -1+#define AV_PIX_FMT_RGB565 PIX_FMT_RGB565+#define AV_PIX_FMT_RGB555 PIX_FMT_RGB555+#define AV_PIX_FMT_YUV420P PIX_FMT_YUV420P+#define AV_PIX_FMT_YUV420P9 PIX_FMT_YUV420P9+#define AV_PIX_FMT_YUV420P10 PIX_FMT_YUV420P10+#define AV_PIX_FMT_YUV420P12 -1+#define AV_PIX_FMT_YUV422P12 -1+#define AV_PIX_FMT_YUV444P12 -1+#define AV_PIX_FMT_YUV420P14 -1+#define AV_PIX_FMT_YUV422P14 -1+#define AV_PIX_FMT_YUV444P14 -1+#define AV_PIX_FMT_YUV420P16 PIX_FMT_YUV420P16+#define AV_PIX_FMT_YUV422P16 PIX_FMT_YUV422P16+#define AV_PIX_FMT_YUV444P16 PIX_FMT_YUV444P16+#define AV_PIX_FMT_RGBA64 -1+#define AV_PIX_FMT_BGRA64 -1++#define AV_CODEC_ID_H264 CODEC_ID_H264+#define AV_CODEC_ID_THEORA CODEC_ID_THEORA+#define AV_CODEC_ID_MPEG4 CODEC_ID_MPEG4+#define AV_CODEC_ID_MPEG2VIDEO CODEC_ID_MPEG2VIDEO+#define AV_CODEC_ID_GIF CODEC_ID_GIF+#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 FF_PROFILE_AAC_HE -1+#define FF_PROFILE_AAC_HE_V2 -1+#define FF_PROFILE_AAC_LD -1+#define FF_PROFILE_AAC_ELD -1+#define FF_PROFILE_MPEG2_AAC_LOW -1+#define FF_PROFILE_MPEG2_AAC_HE -1++#define AVIO_FLAG_DIRECT -1++#define AV_ROUND_PASS_MINMAX -1++#define CODEC_FLAG_UNALIGNED -1+#define CODEC_FLAG_OUTPUT_CORRUPT -1++#define AVFMT_ALLOW_FLUSH -1+#define AVFMT_TS_NONSTRICT -1