diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,15 +1,22 @@ -0.8.2 ---- +# 0.9.0 +* Add support for camera input (Thomas M. DuBuisson) + * Try it: build the demo executable (`cabal configure -fBuildDemo`) + and run `cabal run demo -- cam` to record 10s of video from a + connected camera to an output file `camera.mov`. + +* Extract frame time stamps from the video stream rather than the + codec context (hat tip to Jaro Reinders) + +# 0.8.2 + * Added probe features -0.8.1 ---- +# 0.8.1 * Update raster demo to use new JuicyPixels-3.2 API -0.8 ---- +# 0.8 * Update to transformers-0.4.1 and mtl-2.2.1 * Changed decode-related types to accomodate deprecation of the @@ -30,8 +37,7 @@ * Rasterific bump * Rasterific exports its own linear algebra types as of 0.3 -0.7.1 ---- +# 0.7.1 * Bumped transformers dependency @@ -43,26 +49,22 @@ * Added BGRA pixel format -0.7 ---- +# 0.7 * Simplified top-level API to focus on JuicyPixels-based interface -0.6 ---- +# 0.6 * Cleaned the API of detritus. Use the image* functions. -0.5 ---- +# 0.5 * Juiced the Encode and Decode APIs. Using `imageWriter` and `imageReader` provides a degree of pixel format polymorphism based on JuicyPixels pixel types. -0.4 ---- +# 0.4 * Fixed corrupted output of palettized animated GIFs. @@ -79,20 +81,17 @@ * See the `demo/Raster.hs` for examples. -0.3.1 ---- +# 0.3.1 * Automatically palettize RGB24 to RGB8 for GIF output. * Add a Rasterific demo program that records an animation. -0.3 ---- +# 0.3 * Support for GIF encoding (and other palletized formats). -0.2 ---- +# 0.2 * Separate `Scaler` module and friendly `libswscaler` interface. @@ -100,7 +99,6 @@ * Added demo program. -0.1 ---- +# 0.1 * Basic h264 encoding and decoding. diff --git a/demo/Main.hs b/demo/Main.hs --- a/demo/Main.hs +++ b/demo/Main.hs @@ -2,12 +2,14 @@ import Codec.Picture import Control.Applicative import Control.Monad (replicateM_) +import qualified Data.Time.Clock as C import qualified Data.Vector.Storable as V import System.Environment +import Control.Monad (unless) -- The example used in the README firstFrame :: IO (Maybe DynamicImage) -firstFrame = do (getFrame, cleanup) <- imageReader "myVideo.mov" +firstFrame = do (getFrame, cleanup) <- imageReader (File "myVideo.mov") (fmap ImageRGB8 <$> getFrame) <* cleanup -- | Generate a video that pulses from light to dark. @@ -37,7 +39,7 @@ testDecode :: FilePath -> IO () testDecode vidFile = do initFFmpeg - (getFrame, cleanup) <- imageReaderTime vidFile + (getFrame, cleanup) <- imageReaderTime (File vidFile) frame1 <- getFrame case frame1 of Just (avf,ts) -> do putStrLn $ "Frame at "++show ts @@ -52,10 +54,39 @@ cleanup putStrLn "All done!" +-- | @loopFor timeSpan action@ repeats @action@ until at least @timeSpan@ +-- seconds have elapsed. +loopFor :: Double -> IO () -> IO () +loopFor time m = + do start <- C.getCurrentTime + let go = do m + now <- C.getCurrentTime + unless (realToFrac (C.diffUTCTime now start) >= time) go + go + +testCamera :: IO () +testCamera = + do initFFmpeg + (getFrame, cleanup) <- imageReader (Camera "0:0") + frame1 <- getFrame + case frame1 of + img@(Just (Image w h _)) -> + do let [w',h'] = map fromIntegral [w,h] + writeFrame <- imageWriter (defaultParams w' h') "camera.mov" + writeFrame (img :: Maybe (Image PixelRGB8)) + let go = getFrame >>= writeFrame + loopFor 10 go + writeFrame Nothing + _ -> putStrLn "Couldn't read the first frame from the camera" + cleanup + main :: IO () main = do args <- getArgs case args of [] -> testEncode + [s] + | s `elem` ["--help", "-help", "-h"] -> error usage + | s == "cam" -> testCamera [vidFile] -> testDecode vidFile _ -> error usage where usage = diff --git a/ffmpeg-light.cabal b/ffmpeg-light.cabal --- a/ffmpeg-light.cabal +++ b/ffmpeg-light.cabal @@ -1,5 +1,5 @@ name: ffmpeg-light -version: 0.8.2 +version: 0.9.0 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to @@ -62,7 +62,7 @@ transformers >= 0.4.1 && < 0.5, mtl >= 2.2.1 && < 2.3, JuicyPixels >= 3.1 && < 3.3 - pkgconfig-depends: libavutil, libavformat, libavcodec, libswscale + pkgconfig-depends: libavutil, libavformat, libavcodec, libswscale, libavdevice hs-source-dirs: src include-dirs: src default-language: Haskell2010 @@ -73,7 +73,7 @@ buildable: False build-depends: base < 5, vector, mtl, transformers, JuicyPixels if flag(BuildDemo) - build-depends: ffmpeg-light + build-depends: ffmpeg-light, time hs-source-dirs: demo main-is: Main.hs default-language: Haskell2010 diff --git a/src/Codec/FFmpeg.hs b/src/Codec/FFmpeg.hs --- a/src/Codec/FFmpeg.hs +++ b/src/Codec/FFmpeg.hs @@ -18,11 +18,12 @@ import Codec.FFmpeg.Types foreign import ccall "av_register_all" av_register_all :: IO () +foreign import ccall "avdevice_register_all" avdevice_register_all :: IO () -- foreign import ccall "avcodec_register_all" avcodec_register_all :: IO () -- | Initialize FFmpeg by registering all known codecs. This /must/ -- be called before using other FFmpeg functions. initFFmpeg :: IO () -initFFmpeg = av_register_all +initFFmpeg = av_register_all >> avdevice_register_all diff --git a/src/Codec/FFmpeg/Decode.hs b/src/Codec/FFmpeg/Decode.hs --- a/src/Codec/FFmpeg/Decode.hs +++ b/src/Codec/FFmpeg/Decode.hs @@ -25,7 +25,7 @@ foreign import ccall "avformat_open_input" avformat_open_input :: Ptr AVFormatContext -> CString -> Ptr () - -> Ptr (Ptr ()) -> IO CInt + -> Ptr AVDictionary -> IO CInt foreign import ccall "avformat_find_stream_info" avformat_find_stream_info :: AVFormatContext -> Ptr () -> IO CInt @@ -58,11 +58,46 @@ foreign import ccall "avformat_close_input" close_input :: Ptr AVFormatContext -> IO () +foreign import ccall "av_dict_set" + av_dict_set :: Ptr AVDictionary -> CString -> CString -> CInt -> IO CInt + +dictSet :: Ptr AVDictionary -> String -> String -> IO () +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) + -- * FFmpeg Decoding Interface +-- | Open the first video input device enumerated by FFMPEG. +openCamera :: (MonadIO m, MonadError String m) => String -> m AVFormatContext +openCamera cam = + wrapIOError . alloca $ \ctx -> + withCString cam $ \cstr -> + do avPtr <- mallocAVFormatContext + setupCamera avPtr cam + poke ctx avPtr + r <- alloca $ \dict -> do + dictSet dict "framerate" "30" + avformat_open_input ctx cstr nullPtr dict + when (r /= 0) (fail $ "ffmpeg failed opening file: " ++ show r) + peek ctx + where + setupCamera :: AVFormatContext -> String -> IO () + setupCamera avfc c = do + setCamera avfc + setFilename avfc c + +openInput :: (MonadIO m, MonadError String m) => InputSource -> m AVFormatContext +openInput ipt = + case ipt of + File fileName -> openFile fileName + Camera cam -> openCamera cam + -- | Open an input media file. -openInput :: (MonadIO m, MonadError String m) => String -> m AVFormatContext -openInput filename = +openFile :: (MonadIO m, MonadError String m) => String -> m AVFormatContext +openFile filename = wrapIOError . alloca $ \ctx -> withCString filename $ \cstr -> do poke (castPtr ctx) nullPtr @@ -94,7 +129,8 @@ -- found, returns the index of the stream in the container, and its -- associated 'AVCodecContext' and 'AVCodec'. findVideoStream :: (MonadIO m, MonadError String m) - => AVFormatContext -> m (CInt, AVCodecContext, AVCodec) + => AVFormatContext + -> m (CInt, AVCodecContext, AVCodec, AVStream) findVideoStream fmt = do wrapIOError . alloca $ \codec -> do poke codec (AVCodec nullPtr) @@ -104,7 +140,7 @@ streams <- getStreams fmt vidStream <- peek (advancePtr streams (fromIntegral i)) ctx <- getCodecContext vidStream - return (i, ctx, cod) + return (i, ctx, cod, vidStream) -- | Find a registered decoder with a codec ID matching that found in -- the given 'AVCodecContext'. @@ -132,11 +168,11 @@ -- | Read frames of the given 'AVPixelFormat' from a video stream. frameReader :: (MonadIO m, MonadError String m) - => AVPixelFormat -> FilePath -> m (IO (Maybe AVFrame), IO ()) -frameReader dstFmt fileName = - do inputContext <- openInput fileName + => AVPixelFormat -> InputSource -> m (IO (Maybe AVFrame), IO ()) +frameReader dstFmt ipt = + do inputContext <- openInput ipt checkStreams inputContext - (vidStreamIndex, ctx, cod) <- findVideoStream inputContext + (vidStreamIndex, ctx, cod, _vidStream) <- findVideoStream inputContext _ <- openCodec ctx cod prepareReader inputContext vidStreamIndex dstFmt ctx @@ -144,22 +180,22 @@ -- -- > frameReaderT = fmap (first MaybeT) . frameReader frameReaderT :: (Functor m, MonadIO m, MonadError String m) - => FilePath -> m (MaybeT IO AVFrame, IO ()) + => InputSource -> 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, MonadError String m) - => AVPixelFormat -> FilePath + => AVPixelFormat -> InputSource -> m (IO (Maybe (AVFrame, Double)), IO ()) -frameReaderTime dstFmt fileName = - do inputContext <- openInput fileName +frameReaderTime dstFmt src = + do inputContext <- openInput src checkStreams inputContext - (vidStreamIndex, ctx, cod) <- findVideoStream inputContext + (vidStreamIndex, ctx, cod, vidStream) <- findVideoStream inputContext _ <- openCodec ctx cod (reader, cleanup) <- prepareReader inputContext vidStreamIndex dstFmt ctx - AVRational num den <- liftIO $ getTimeBase ctx + AVRational num den <- liftIO $ getTimeBase vidStream let (numl, dend) = (fromIntegral num, fromIntegral den) frameTime' frame = do n <- getPts frame @@ -176,7 +212,7 @@ -- -- > frameReaderT = fmap (first MaybeT) . frameReader frameReaderTimeT :: (Functor m, MonadIO m, MonadError String m) - => FilePath -> m (MaybeT IO (AVFrame, Double), IO ()) + => InputSource -> m (MaybeT IO (AVFrame, Double), IO ()) frameReaderTimeT = fmap (first MaybeT) . frameReaderTime avPixFmtRgb24 -- | Construct an action that gets the next available frame, and an diff --git a/src/Codec/FFmpeg/Juicy.hs b/src/Codec/FFmpeg/Juicy.hs --- a/src/Codec/FFmpeg/Juicy.hs +++ b/src/Codec/FFmpeg/Juicy.hs @@ -104,7 +104,7 @@ imageReaderT :: forall m p. (Functor m, MonadIO m, MonadError String m, JuicyPixelFormat p) - => FilePath -> m (IO (Maybe (Image p)), IO ()) + => InputSource -> m (IO (Maybe (Image p)), IO ()) imageReaderT = fmap (first (runMaybeT . aux toJuicyImage)) . frameReader (juicyPixelFormat ([] :: [p])) where aux g x = MaybeT x >>= MaybeT . g @@ -112,7 +112,7 @@ -- | Read frames from a video stream. Errors are thrown as -- 'IOException's. imageReader :: JuicyPixelFormat p - => FilePath -> IO (IO (Maybe (Image p)), IO ()) + => InputSource -> IO (IO (Maybe (Image p)), IO ()) imageReader = (>>= either error return) . runExceptT . imageReaderT -- | Read time stamped frames from a video stream. Time is given in @@ -120,7 +120,7 @@ imageReaderTimeT :: forall m p. (Functor m, MonadIO m, MonadError String m, JuicyPixelFormat p) - => FilePath -> m (IO (Maybe (Image p, Double)), IO ()) + => InputSource -> 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 @@ -131,7 +131,7 @@ -- seconds from the start of the stream. Errors are thrown as -- 'IOException's. imageReaderTime :: JuicyPixelFormat p - => FilePath -> IO (IO (Maybe (Image p, Double)), IO ()) + => InputSource -> 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 diff --git a/src/Codec/FFmpeg/Probe.hsc b/src/Codec/FFmpeg/Probe.hsc --- a/src/Codec/FFmpeg/Probe.hsc +++ b/src/Codec/FFmpeg/Probe.hsc @@ -49,7 +49,7 @@ withAvFile :: (MonadMask m, MonadIO m) => String -> AvFormat m a -> m a withAvFile fn f = do - ectx <- runEitherT $ openInput fn + ectx <- runEitherT $ openFile fn case ectx of Left e -> liftIO $ fail e Right ctx -> finally diff --git a/src/Codec/FFmpeg/Types.hsc b/src/Codec/FFmpeg/Types.hsc --- a/src/Codec/FFmpeg/Types.hsc +++ b/src/Codec/FFmpeg/Types.hsc @@ -3,6 +3,7 @@ module Codec.FFmpeg.Types where import Codec.FFmpeg.Enums import Control.Applicative +import Control.Monad (zipWithM_,when) import Foreign.C.String (CString) import Foreign.C.Types import Foreign.Ptr @@ -24,12 +25,45 @@ #mkField Streams, (Ptr AVStream) #mkField OutputFormat, AVOutputFormat #mkField IOContext, AVIOContext +#mkField InputFormat, AVInputFormat #hasField AVFormatContext, NumStreams, nb_streams #hasField AVFormatContext, Streams, streams #hasField AVFormatContext, OutputFormat, oformat +#hasField AVFormatContext, InputFormat, iformat #hasField AVFormatContext, IOContext, pb +setFilename :: AVFormatContext -> String -> IO () +setFilename ctx fn = + do let ptr = getPtr ctx + dst = (#ptr AVFormatContext, filename) ptr + bytes = map (fromIntegral . fromEnum) fn + zipWithM_ (pokeElemOff dst) bytes [(0 :: CInt) ..] + + +foreign import ccall "av_input_video_device_next" + av_input_video_device_next :: AVInputFormat -> IO AVInputFormat + +setCamera :: AVFormatContext -> IO () +setCamera ctx = do + ipt <- getCameraAVInputFormat (AVInputFormat nullPtr) + setInputFormat ctx ipt + where + -- Currently straight-line, but we can filter each 'nxt' based on + -- predicates, such as device ('avfoundtion', 'v4l2' etc) in the + -- future, if needed. + getCameraAVInputFormat :: AVInputFormat -> IO AVInputFormat + getCameraAVInputFormat p = do + nxt <- av_input_video_device_next p + when (nullPtr == getPtr nxt) (error "No video input device found.") + return nxt + +foreign import ccall "avformat_alloc_context" + avformat_alloc_context :: IO (Ptr ()) + +mallocAVFormatContext :: IO AVFormatContext +mallocAVFormatContext = AVFormatContext <$> avformat_alloc_context + newtype AVCodecContext = AVCodecContext (Ptr ()) deriving (Storable, HasPtr) #mkField BitRate, CInt @@ -98,6 +132,27 @@ #hasField AVOutputFormat, FormatFlags, flags #hasField AVOutputFormat, VideoCodecID, video_codec +newtype AVInputFormat = AVInputFormat (Ptr ()) deriving (Storable, HasPtr) +newtype AVClass = AVClass (Ptr ()) deriving (Storable, HasPtr) +#mkField AVClass, AVClass +#hasField AVInputFormat, AVClass, priv_class + +getAVCategory :: AVInputFormat -> IO Category +getAVCategory aif = + do c <- getAVClass aif + if nullPtr == getPtr c + then return (Category (-1)) + else Category <$> peek ((#ptr AVClass, category) $ castPtr $ getPtr c) + +newtype Category = Category CInt deriving (Eq,Ord,Show,Read,Enum) +#enum Category, Category, AV_CLASS_CATEGORY_NA, AV_CLASS_CATEGORY_INPUT,\ + AV_CLASS_CATEGORY_OUTPUT, AV_CLASS_CATEGORY_MUXER, AV_CLASS_CATEGORY_DEMUXER,\ + AV_CLASS_CATEGORY_ENCODER, AV_CLASS_CATEGORY_DECODER, AV_CLASS_CATEGORY_FILTER,\ + AV_CLASS_CATEGORY_BITSTREAM_FILTER, AV_CLASS_CATEGORY_SWSCALER, AV_CLASS_CATEGORY_SWRESAMPLER,\ + AV_CLASS_CATEGORY_DEVICE_VIDEO_OUTPUT, AV_CLASS_CATEGORY_DEVICE_VIDEO_INPUT, AV_CLASS_CATEGORY_DEVICE_AUDIO_OUTPUT,\ + AV_CLASS_CATEGORY_DEVICE_AUDIO_INPUT, AV_CLASS_CATEGORY_DEVICE_OUTPUT, AV_CLASS_CATEGORY_DEVICE_INPUT,\ + AV_CLASS_CATEGORY_NB + newtype AVIOContext = AVIOContext (Ptr ()) deriving (Storable, HasPtr) newtype AVPacket = AVPacket (Ptr ()) deriving (Storable, HasPtr) @@ -159,3 +214,9 @@ poke ptr (AVFrac v n d) = do (#poke AVFrac, val) ptr v (#poke AVFrac, num) ptr n (#poke AVFrac, den) ptr d + +-- | The input source can be a file or a camera. When using 'Camera', +-- frequently in the form @Camera "0:0"@, the first input video device +-- enumerated by libavdevice is selected. +data InputSource = File FilePath | Camera String + deriving (Eq, Ord, Show, Read)