ffmpeg-tutorials 0.2.1 → 0.3.2
raw patch · 4 files changed
+287/−14 lines, 4 filesdep +bytestringdep +stmdep ~SDLdep ~hs-ffmpegnew-component:exe:tutorial03
Dependencies added: bytestring, stm
Dependency ranges changed: SDL, hs-ffmpeg
Files
- ffmpeg-tutorials.cabal +14/−4
- src/tutorial01/Main.hs +5/−5
- src/tutorial02/Main.hs +5/−5
- src/tutorial03/Main.hs +263/−0
ffmpeg-tutorials.cabal view
@@ -1,10 +1,12 @@ name: ffmpeg-tutorials-version: 0.2.1+version: 0.3.2 cabal-version: >= 1.6 license: BSD3 author: Vasyl Pasternak synopsis: Tutorials on ffmpeg usage to play video/audio-maintainer: vasyl.pasternak@gmail.com+maintainer: vasylpasternak@gmail.com+homepage: http://patch-tag.com/r/VasylPasternak/ffmpeg-tutorials+bug-reports: http://code.google.com/p/hs-ffmpeg/issues/list description: A set of tutorials with raising complexity copyright: (c) 2009 Vasyl Pasternak stability: alpha@@ -15,11 +17,19 @@ executable tutorial01 main-is: tutorial01/Main.hs hs-source-dirs: src- build-depends: base < 4, haskell98, hs-ffmpeg >= 0.2.1+ build-depends: base < 4, haskell98, hs-ffmpeg >= 0.3.0 executable tutorial02 main-is: tutorial02/Main.hs hs-source-dirs: src- build-depends: base < 4, haskell98, SDL, hs-ffmpeg >= 0.2.1+ build-depends: base < 4, haskell98, SDL, hs-ffmpeg >= 0.3.0++executable tutorial03+ main-is: tutorial03/Main.hs+ hs-source-dirs: src+ build-depends: base < 4, haskell98, + SDL >= 0.5.6, hs-ffmpeg >= 0.3.1,+ stm, bytestring+ ghc-options: -threaded
src/tutorial01/Main.hs view
@@ -11,7 +11,7 @@ -- FFMpeg imports import qualified Media.FFMpeg as FF-import qualified Media.FFMpeg.Scale as S+import qualified Media.FFMpeg.SWScale as S -- Common imports import Data.Version@@ -84,7 +84,7 @@ frame <- FF.allocFrame frameRGB <- FF.allocFrame - pictureSize <- FF.pictureGetSize FF.PixFmtRgb24 width height+ let pictureSize = FF.pictureGetSize FF.PixFmtRgb24 width height buffer <- FF.allocBuffer pictureSize @@ -101,7 +101,7 @@ while (FF.readFrame ctx packet) $ do- when (streamIdx == FF.getStreamIndex packet) $+ when (streamIdx == FF.packetGetStreamIndex packet) $ do frameFinished <- FF.decodeVideo codecContext frame packet when frameFinished $ @@ -109,9 +109,9 @@ -- Rescale the picture S.scale scaler - (FF.getPictureSlice frame) (FF.getPictureStride frame)+ (FF.pictureGetSlice frame) (FF.pictureGetStride frame) 0 height- (FF.getPictureSlice frameRGB) (FF.getPictureStride frameRGB)+ (FF.pictureGetSlice frameRGB) (FF.pictureGetStride frameRGB) idx <- readIORef idxRef modifyIORef idxRef (+1)
src/tutorial02/Main.hs view
@@ -11,7 +11,7 @@ -- FFMpeg import qualified Media.FFMpeg as FF-import qualified Media.FFMpeg.Scale as S+import qualified Media.FFMpeg.SWScale as S -- Common import Data.Version@@ -93,7 +93,7 @@ frame <- FF.allocFrame frameRGB <- FF.allocFrame - surfacePixels <- SDL.surfaceGetPixels rgbSurface >>= FF.makeBuffer+ surfacePixels <- SDL.surfaceGetPixels rgbSurface >>= FF.castBuffer FF.pictureFill frameRGB surfacePixels FF.PixFmtRgb24 width height @@ -108,7 +108,7 @@ while (FF.readFrame ctx packet) $ do- when (streamIdx == FF.getStreamIndex packet) $+ when (streamIdx == FF.packetGetStreamIndex packet) $ do frameFinished <- FF.decodeVideo codecContext frame packet when frameFinished $ @@ -118,9 +118,9 @@ SDL.lockSurface rgbSurface S.scale scaler - (FF.getPictureSlice frame) (FF.getPictureStride frame)+ (FF.pictureGetSlice frame) (FF.pictureGetStride frame) 0 height- (FF.getPictureSlice frameRGB) (FF.getPictureStride frameRGB)+ (FF.pictureGetSlice frameRGB) (FF.pictureGetStride frameRGB) -- show on screen SDL.unlockSurface rgbSurface
+ src/tutorial03/Main.hs view
@@ -0,0 +1,263 @@+{-+ 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.SWScale as S++import System.Environment (getArgs, getProgName)+import System.IO+import Text.Printf (printf)+import Data.Version (showVersion)+import Data.Maybe (fromJust)+import Data.IORef (newIORef, readIORef, modifyIORef)+import Control.Monad (when)+import System.Exit (exitSuccess)+import Control.Concurrent.STM+import Data.ByteString (ByteString, empty, take, drop+ ,length, append, useAsCStringLen) +import Foreign+ +-- SDL+import qualified 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 <filename> is the path to the video file"]++data CStreamProps = CStreamProps {+ streamIdx :: Int+ , stream :: FF.Stream+ , codecCtx :: FF.CodecContext+ , codecId :: FF.CodecId+ , decoder :: FF.Codec+ }++instance Show CStreamProps where+ show pr = printf "Stream #%d, codec '%s'\n" (streamIdx pr) (show (codecId pr))++data VStreamProps = VStreamProps {+ width :: Int+ , height :: Int+ , pixFmt :: FF.PixelFormat+ }++instance Show VStreamProps where+ show pr = printf "Format %dx%d '%s'\n" (width pr) (height pr) (show (pixFmt pr))++data AStreamProps = AStreamProps {+ sampleRate :: Int+ , channels :: Int+ , sampleFmt :: FF.SampleFormat+ }++instance Show AStreamProps where+ show pr = printf "Format rate: %d, channels: %d, format: '%s'\n" + (sampleRate pr) (channels pr) (show (sampleFmt pr))+ +data StreamProps = VideoStream CStreamProps VStreamProps + | AudioStream CStreamProps AStreamProps deriving (Show)++commonProps (AudioStream a _) = a+commonProps (VideoStream a _) = a+audioProps (AudioStream _ a) = a+videoProps (VideoStream _ a) = a++requestForAudioData :: + FF.CodecContext -> TChan FF.Packet -> TVar ByteString -> Ptr () -> Ptr Word8 -> Word32 -> IO ()+requestForAudioData ctx pc buff _ dst size = do+ buffer <- retrieveBuffer ctx pc buff (fromIntegral size)+ useAsCStringLen buffer $ \(p, s) ->+ copyArray dst (castPtr p :: Ptr Word8) s+ ++-- combine together two TChans+retrieveBuffer ctx pc buff s = do+ e <- atomically $ do+ bs <- readTVar buff+ return $ Data.ByteString.length bs+ if e < s+ then do + pk <- atomically $ readTChan pc+ buffs <- FF.decodeAudioPacket' ctx pk+ atomically $ do+ bs <- readTVar buff+ writeTVar buff (bs `append` buffs)+ retrieveBuffer ctx pc buff s+ else do+ atomically $ do+ bs <- readTVar buff+ writeTVar buff (Data.ByteString.drop s bs)+ return $ Data.ByteString.take s bs++decodeFile :: String -> IO ()+decodeFile fname = do+ SDL.init [SDL.InitVideo, SDL.InitAudio, SDL.InitTimer]++ 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 fname+ FF.findStreamInfo ctx++ printf "File: %s\n" fname++ -- Get all streams from file+ let streams = FF.getStreams ctx+ printf "Found %d streams\n" (Prelude.length streams)++ -- Retrive video streams+ let videoStreams = filter (\(_,s) -> maybe False ((==FF.CodecTypeVideo) . FF.getCodecType) (FF.getCodecContext s)) $ zip [0..] streams++ let audioStreams = filter (\(_,s) -> maybe False ((==FF.CodecTypeAudio) . FF.getCodecType) (FF.getCodecContext s)) $ zip [0..] streams++ if null videoStreams || null audioStreams + then printf "No video or audio streams found\n"+ else do+ vStreamProps <- getVStreamProps $ head videoStreams+ print vStreamProps++ aStreamProps <- getAStreamProps $ head audioStreams+ print aStreamProps++ packetChain <- atomically $ (newTChan :: STM (TChan FF.Packet))+ buffer <- atomically $ (newTVar Data.ByteString.empty)++ fcb <- SDL.mkAudioBufferFillCb $ requestForAudioData (codecCtx $ commonProps aStreamProps) packetChain buffer++ let wspecs = SDL.AudioSpec {+ SDL.freq = (sampleRate . audioProps) aStreamProps+ , SDL.format = SDL.AudioS16Sys+ , SDL.channels = (fromIntegral . channels . audioProps) aStreamProps+ , SDL.silence = 0+ , SDL.samples = 4096+ , SDL.size = 0+ , SDL.callback = fcb}+ + (Just specs) <- SDL.openAudio wspecs False+ printf "Output audio specs: %s\n" (show specs)++ let (w, h, pf, cc, vsidx) = ((width . videoProps) vStreamProps+ ,(height . videoProps) vStreamProps+ ,(pixFmt . videoProps) vStreamProps+ ,(codecCtx . commonProps) vStreamProps+ ,(streamIdx . commonProps) vStreamProps)++ screen <- SDL.setVideoMode w h 0 []+ rgbSurface <- SDL.createRGBSurface [] w h 24 0x0000FF 0x00FF00 0xFF0000 0x000000+ frame <- FF.allocFrame+ frameRGB <- FF.allocFrame++ surfacePixels <- SDL.surfaceGetPixels rgbSurface >>= FF.castBuffer++ FF.pictureFill frameRGB surfacePixels FF.PixFmtRgb24 w h++ -- packet <- FF.allocPacket++ -- Prepare resizer+ scaler <- S.getContext (w, h, pf) + (w, h, FF.PixFmtRgb24) [S.SwsBicubic]++ -- use IORef to count packets+ idxRef <- newIORef (0 :: Int)++ SDL.pauseAudio False+ + let asidx = (streamIdx . commonProps) aStreamProps++ while (FF.readFrame ctx) $ \packet ->+ do+ if (asidx == FF.packetGetStreamIndex packet)+ then do+ FF.dupPacket packet+ atomically $ writeTChan packetChain packet+ -- abufs <- FF.decodeAudioPacket' ((codecCtx . commonProps) aStreamProps) packet+ -- FF.cleanPacket packet+ return ()+ else if vsidx == FF.packetGetStreamIndex packet + then + do+ frameFinished <- FF.decodeVideo cc frame packet+ when frameFinished $ + do+ -- Rescale the picture+ + -- SDL.lockSurface rgbSurface+ + S.scale scaler + (FF.pictureGetSlice frame) (FF.pictureGetStride frame)+ 0 h+ (FF.pictureGetSlice frameRGB) (FF.pictureGetStride 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)+ + else return ()++ ++ ev <- SDL.pollEvent+ case ev of+ SDL.Quit -> do SDL.quit + exitSuccess+ otherwise -> return ()++ printf "\n"++-- While cycle implementation+while :: (FF.Packet -> IO Bool) -> (FF.Packet -> IO ()) -> IO ()+while cond body = do+ pkt <- FF.allocPacket+ c <- cond pkt+ when c $ body pkt >> while cond body++getStreamProps (sidx, s) = do+ let codecContext = fromJust $ FF.getCodecContext s+ let cId = FF.getCodecId codecContext+ (Just dec) <- FF.findDecoder cId+ FF.openCodec codecContext dec+ return $ CStreamProps {+ streamIdx = sidx+ , stream = s+ , codecCtx = codecContext+ , codecId = cId+ , decoder = dec }++getVStreamProps (sidx, s) = do+ sp <- getStreamProps (sidx, s)+ let [w, h] = map ($ (codecCtx sp)) + [FF.getVideoWidth, FF.getVideoHeight]+ let pf = FF.getPixelFormat (codecCtx sp)+ return $ VideoStream sp $ VStreamProps {width = w, height = h, pixFmt = pf}++getAStreamProps (sidx, s) = do+ sp <- getStreamProps (sidx, s)+ let [sr, ch] = map ($ (codecCtx sp))+ [FF.getAudioSampleRate, FF.getAudioChannels]+ let sf = FF.getAudioSampleFormat (codecCtx sp)+ return $ AudioStream sp $ AStreamProps {sampleRate = sr, channels = ch, sampleFmt = sf}