diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple + +main = defaultMain diff --git a/ffmpeg-tutorials.cabal b/ffmpeg-tutorials.cabal new file mode 100644 --- /dev/null +++ b/ffmpeg-tutorials.cabal @@ -0,0 +1,25 @@ +name: ffmpeg-tutorials +version: 0.2.1 +cabal-version: >= 1.6 +license: BSD3 +author: Vasyl Pasternak +synopsis: Tutorials on ffmpeg usage to play video/audio +maintainer: vasyl.pasternak@gmail.com +description: A set of tutorials with raising complexity +copyright: (c) 2009 Vasyl Pasternak +stability: alpha +category: Media + +build-type: Simple + +executable tutorial01 + main-is: tutorial01/Main.hs + hs-source-dirs: src + build-depends: base < 4, haskell98, hs-ffmpeg >= 0.2.1 + +executable tutorial02 + main-is: tutorial02/Main.hs + hs-source-dirs: src + build-depends: base < 4, haskell98, SDL, hs-ffmpeg >= 0.2.1 + + diff --git a/src/tutorial01/Main.hs b/src/tutorial01/Main.hs new file mode 100644 --- /dev/null +++ b/src/tutorial01/Main.hs @@ -0,0 +1,137 @@ +{- + Testing the ffmpeg video decoding. + + Rewritten from the C code, from the FFMpeg tutorial + (http://www.dranger.com/ffmpeg/) + + (c) 2009 Vasyl Pasternak + -} + +module Main (main) where + +-- FFMpeg imports +import qualified Media.FFMpeg as FF +import qualified Media.FFMpeg.Scale as S + +-- Common imports +import Data.Version +import System.Environment (getArgs, getProgName) +import Text.Printf (printf) +import Data.Maybe (fromJust) +import Data.IORef (newIORef, readIORef, modifyIORef) +import Control.Monad (when) +import System.IO -- (WriteMode, withBinaryFile, hPutStr, hPutBuf) + +main :: IO () +main = do + getArgs >>= \args -> + case args of + filename:[] -> decodeFile filename + otherwise -> getProgName >>= \pn -> + (putStrLn . unlines) + ["Usage: \n" + ,printf "%s filename\n" pn + ,"Where is the path to the video file"] + + +-- The main rutine, do all work +decodeFile :: String -> IO () +decodeFile filename = + FF.withFFMpeg $ do + -- Print FFMpeg version + printf "FFMpeg library initialized\n" + printf "\tlibAVFormat version: %s\n" (showVersion FF.libAVFormatVersion) + printf "\tlibAVCodec version: %s\n" (showVersion FF.libAVCodecVersion) + + -- Open file + ctx <- FF.openInputFile filename + FF.findStreamInfo ctx + -- FF.dumpFormat ctx filename + + printf "File: %s\n" filename + + -- Get all streams from file + let streams = FF.getStreams ctx + printf "Found %d streams\n" (length streams) + + -- Retrive video streams + let videoStreams = filter (\(_,s) -> maybe False ((==FF.CodecTypeVideo) . FF.getCodecType) (FF.getCodecContext s)) $ zip [0..] streams + + if null videoStreams + then do + printf "No video streams found. Exiting...\n" + else do + let (streamIdx, videoStream) = head videoStreams + printf "Extracting video information from stream %d\n" (streamIdx :: Int) + + -- Starting decoding video + let codecContext = fromJust $ FF.getCodecContext videoStream + let codecId = FF.getCodecId codecContext + printf "Video codec is '%s'\n" (show codecId) + + (Just decoder) <- FF.findDecoder codecId + FF.openCodec codecContext decoder + + let (width, height, pixfmt) = (FF.getVideoWidth codecContext, + FF.getVideoHeight codecContext, + FF.getPixelFormat codecContext) + + printf "Video dimensions are %dx%d\n" width height + + printf "Video pixel format is %s\n" (show pixfmt) + + + frame <- FF.allocFrame + frameRGB <- FF.allocFrame + + pictureSize <- FF.pictureGetSize FF.PixFmtRgb24 width height + + buffer <- FF.allocBuffer pictureSize + + FF.pictureFill frameRGB buffer FF.PixFmtRgb24 width height + + packet <- FF.allocPacket + + -- Prepare resizer + scaler <- S.getContext (width, height, pixfmt) + (width, height, FF.PixFmtRgb24) [S.SwsBicubic] + + -- use IORef to cound packets + idxRef <- newIORef (0 :: Int) + + while (FF.readFrame ctx packet) $ + do + when (streamIdx == FF.getStreamIndex packet) $ + do + frameFinished <- FF.decodeVideo codecContext frame packet + when frameFinished $ + do + -- Rescale the picture + + S.scale scaler + (FF.getPictureSlice frame) (FF.getPictureStride frame) + 0 height + (FF.getPictureSlice frameRGB) (FF.getPictureStride frameRGB) + + idx <- readIORef idxRef + modifyIORef idxRef (+1) + printf "\rDecoded frame %05d" (idx) + when ((idx `mod` 100) == 0) $ + writePPM (printf "frame%05d.ppm" idx) width height + buffer pictureSize + FF.cleanPacket packet + + printf "\n" + + +-- While cycle implementation +while :: IO Bool -> IO () -> IO () +while cond body = do + c <- cond + when c $ body >> while cond body + +writePPM fname width height buff b = + withBinaryFile fname WriteMode $ \h -> do + hPutStr h (printf "P6\n%d %d\n255\n" width height) + FF.withBuffer buff $ \buff' -> + hPutBuf h buff' b diff --git a/src/tutorial02/Main.hs b/src/tutorial02/Main.hs new file mode 100644 --- /dev/null +++ b/src/tutorial02/Main.hs @@ -0,0 +1,143 @@ +{- + Testing the ffmpeg video decoding. + + Rewritten from the C code, from the FFMpeg tutorial + (http://www.dranger.com/ffmpeg/) + + (c) 2009 Vasyl Pasternak + -} + +module Main (main) where + +-- FFMpeg +import qualified Media.FFMpeg as FF +import qualified Media.FFMpeg.Scale as S + +-- Common +import Data.Version +import System.Environment (getArgs, getProgName) +import Text.Printf (printf) +import Data.Maybe (fromJust) +import Data.IORef (newIORef, readIORef, modifyIORef) +import Control.Monad (when) +import System.IO -- (WriteMode, withBinaryFile, hPutStr, hPutBuf) + +-- SDL +import Graphics.UI.SDL as SDL + +main :: IO () +main = do + getArgs >>= \args -> + case args of + filename:[] -> decodeFile filename + otherwise -> getProgName >>= \pn -> + (putStrLn . unlines) + ["Usage: \n" + ,printf "%s filename\n" pn + ,"Where is the path to the video file"] + + +-- The main rutine, do all work +decodeFile :: String -> IO () +decodeFile filename = do + SDL.init [InitTimer, InitAudio, InitVideo] + FF.withFFMpeg $ do + -- Print FFMpeg version + printf "FFMpeg library initialized\n" + printf "\tlibAVFormat version: %s\n" (showVersion FF.libAVFormatVersion) + printf "\tlibAVCodec version: %s\n" (showVersion FF.libAVCodecVersion) + + -- Open file + ctx <- FF.openInputFile filename + FF.findStreamInfo ctx + -- FF.dumpFormat ctx filename + + printf "File: %s\n" filename + + -- Get all streams from file + let streams = FF.getStreams ctx + printf "Found %d streams\n" (length streams) + + -- Retrive video streams + let videoStreams = filter (\(_,s) -> maybe False ((==FF.CodecTypeVideo) . FF.getCodecType) (FF.getCodecContext s)) $ zip [0..] streams + + if null videoStreams + then do + printf "No video streams found. Exiting...\n" + else do + let (streamIdx, videoStream) = head videoStreams + printf "Extracting video information from stream %d\n" (streamIdx :: Int) + + -- Starting decoding video + let codecContext = fromJust $ FF.getCodecContext videoStream + let codecId = FF.getCodecId codecContext + printf "Video codec is '%s'\n" (show codecId) + + (Just decoder) <- FF.findDecoder codecId + FF.openCodec codecContext decoder + + let (width, height, pixfmt) = (FF.getVideoWidth codecContext, + FF.getVideoHeight codecContext, + FF.getPixelFormat codecContext) + + printf "Video dimensions are %dx%d\n" width height + printf "Video pixel format is %s\n" (show pixfmt) + + -- init primary SDL surface + screen <- SDL.setVideoMode width height 0 [] + + -- init output surface + rgbSurface <- SDL.createRGBSurface [] width height 24 + 0x0000FF 0x00FF00 0xFF0000 0x000000 + + frame <- FF.allocFrame + frameRGB <- FF.allocFrame + + surfacePixels <- SDL.surfaceGetPixels rgbSurface >>= FF.makeBuffer + + FF.pictureFill frameRGB surfacePixels FF.PixFmtRgb24 width height + + packet <- FF.allocPacket + + -- Prepare resizer + scaler <- S.getContext (width, height, pixfmt) + (width, height, FF.PixFmtRgb24) [S.SwsBicubic] + + -- use IORef to cound packets + idxRef <- newIORef (0 :: Int) + + while (FF.readFrame ctx packet) $ + do + when (streamIdx == FF.getStreamIndex packet) $ + do + frameFinished <- FF.decodeVideo codecContext frame packet + when frameFinished $ + do + -- Rescale the picture + + SDL.lockSurface rgbSurface + + S.scale scaler + (FF.getPictureSlice frame) (FF.getPictureStride frame) + 0 height + (FF.getPictureSlice frameRGB) (FF.getPictureStride frameRGB) + + -- show on screen + SDL.unlockSurface rgbSurface + SDL.blitSurface rgbSurface Nothing screen Nothing + SDL.flip screen + + idx <- readIORef idxRef + modifyIORef idxRef (+1) + printf "\rDecoded frame %05d" (idx) + FF.cleanPacket packet + + printf "\n" + + +-- While cycle implementation +while :: IO Bool -> IO () -> IO () +while cond body = do + c <- cond + when c $ body >> while cond body +