ffmpeg-light 0.12.0 → 0.12.0.1
raw patch · 3 files changed
+91/−12 lines, 3 filesdep ~JuicyPixelsdep ~basenew-component:exe:transcode
Dependency ranges changed: JuicyPixels, base
Files
- demo/Transcode.hs +53/−0
- ffmpeg-light.cabal +18/−2
- src/Codec/FFmpeg/Encode.hs +20/−10
+ demo/Transcode.hs view
@@ -0,0 +1,53 @@+module Main where++import System.Environment (getArgs)+import qualified Codec.FFmpeg as FF+import qualified Codec.FFmpeg.Encode as FF+import Codec.Picture++type Frame = Image PixelRGB8++usage :: String+usage =+ unlines [ "Usage: transcode inputFile outputFile [outputFormat] [outputWidth] [outputHeight]"+ , " Example: transcode rtmp://localhost/app/one rtmp://localhost/app/two flv 640 480"+ , ""+ , " Copies the content from inputFile to outputFile using H264."+ , " Defaults:"+ , " outputFormat=flv"+ , " outputWidth=640"+ , " outputHeight=480"+ ]++main :: IO ()+main = do+ args <- getArgs+ FF.initFFmpeg+ FF.setLogLevel FF.avLogDebug+ case args of+ [from, to] -> copy from to "flv" 640 480+ [from, to, format, w, h] -> copy from to format (read w) (read h)+ _ -> error usage++copy :: FilePath -> FilePath -> String -> Int -> Int -> IO ()+copy from to format w h = let ep = (FF.defaultH264 (fromIntegral w) (fromIntegral h))+ { FF.epFormatName = Just format } in do+ (getFrame, cleanup) <- FF.imageReader (FF.File from)+ putFrame <- FF.imageWriter ep to+ loop getFrame cleanup putFrame (\x -> return x)++loop :: IO (Maybe Frame)+ -> IO cleanup+ -> (Maybe Frame -> IO ())+ -> (Frame -> IO Frame)+ -> IO cleanup+loop getFrame finishReading putFrame editFrame = do+ maybeFrame <- getFrame+ case maybeFrame of+ Nothing -> do+ putFrame Nothing+ finishReading+ Just x -> do+ x' <- editFrame x+ putFrame (Just x')+ loop getFrame finishReading putFrame editFrame
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.12.0+version: 0.12.0.1 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -48,6 +48,11 @@ default: False manual: True +flag BuildTranscodeDemo+ description: Build transcode demo executable+ default: False+ manual: True+ library exposed-modules: Codec.FFmpeg, Codec.FFmpeg.Common,@@ -61,7 +66,7 @@ Codec.FFmpeg.Internal.Debug, Codec.FFmpeg.Internal.Linear build-tools: hsc2hs- build-depends: base >=4.6 && < 4.10,+ build-depends: base >=4.6 && < 4.11, either, exceptions, vector >= 0.10.9 && < 0.13,@@ -108,3 +113,14 @@ main-is: VPlay.hs default-language: Haskell2010 ghc-options: -Wall -O2++executable transcode+ if !flag(BuildTranscodeDemo)+ buildable: False+ build-depends: base < 5, JuicyPixels+ if flag(BuildTranscodeDemo)+ build-depends: ffmpeg-light+ hs-source-dirs: demo+ main-is: Transcode.hs+ default-language: Haskell2010+ ghc-options: -Wall
src/Codec/FFmpeg/Encode.hs view
@@ -60,8 +60,8 @@ av_guess_format :: CString -> CString -> CString -> IO AVOutputFormat foreign import ccall "avformat_alloc_output_context2"- avformat_alloc_output_context :: Ptr AVFormatContext -> AVOutputFormat- -> CString -> CString -> IO CInt+ avformat_alloc_output_context2 :: Ptr AVFormatContext -> AVOutputFormat+ -> CString -> CString -> IO CInt foreign import ccall "avformat_new_stream" avformat_new_stream :: AVFormatContext -> AVCodec -> IO AVStream@@ -117,17 +117,21 @@ -- during the palettization process. This will -- improve image quality, but result in a larger -- file.+ , epFormatName :: Maybe String+ -- ^ FFmpeg muxer format name. If 'Nothing', tries to infer+ -- from the output file name. If 'Just', the string value+ -- should be the one available in @ffmpeg -formats@. } -- | Use default parameters for a video of the given width and -- height, forcing the choice of the h264 encoder. defaultH264 :: CInt -> CInt -> EncodingParams-defaultH264 w h = EncodingParams w h 30 (Just avCodecIdH264) Nothing "medium"+defaultH264 w h = EncodingParams w h 30 (Just avCodecIdH264) Nothing "medium" Nothing -- | 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 Nothing Nothing ""+defaultParams w h = EncodingParams w h 30 Nothing Nothing "" Nothing -- | Determine if the bitwise intersection of two values is non-zero. checkFlag :: Bits a => a -> a -> Bool@@ -203,13 +207,19 @@ -- | Allocate an output context inferring the codec from the given -- file name.-allocOutputContext :: FilePath -> IO AVFormatContext-allocOutputContext fname = do+allocOutputContext :: Maybe String -> FilePath -> IO AVFormatContext+allocOutputContext outputFormat fname =+ let+ withFormat = case outputFormat of+ Just f -> withCString f+ Nothing -> (\f -> f nullPtr)+ in do oc <- alloca $ \ocTmp -> do r <- withCString fname $ \fname' ->- avformat_alloc_output_context- ocTmp (AVOutputFormat nullPtr)- nullPtr fname'+ withFormat $ \format ->+ avformat_alloc_output_context2+ ocTmp (AVOutputFormat nullPtr)+ format fname' when (r < 0) (error "Couldn't allocate output format context") peek ocTmp@@ -305,7 +315,7 @@ frameWriter :: EncodingParams -> FilePath -> IO (Maybe (AVPixelFormat, V2 CInt, Vector CUChar) -> IO ()) frameWriter ep fname = do- oc <- allocOutputContext fname+ oc <- allocOutputContext (epFormatName ep) fname (st,ctx) <- initStream ep oc dstFmt <- getPixelFormat ctx