ffmpeg-light 0.3.1 → 0.4
raw patch · 10 files changed
+180/−71 lines, 10 files
Files
- CHANGELOG.md +18/−0
- demo/Raster.hs +8/−3
- ffmpeg-light.cabal +2/−2
- src/Codec/FFmpeg/Common.hsc +3/−0
- src/Codec/FFmpeg/Encode.hs +86/−35
- src/Codec/FFmpeg/Enums.hsc +1/−0
- src/Codec/FFmpeg/Internal/Linear.hs +47/−0
- src/Codec/FFmpeg/Internal/V3.hs +0/−30
- src/Codec/FFmpeg/Juicy.hs +14/−1
- src/nameCompat.h +1/−0
CHANGELOG.md view
@@ -1,3 +1,21 @@+0.4+---++* Fixed corrupted output of palettized animated GIFs.++* Added palettization options++ * Using `avPixFmtRgb8` results in a small file++ * Using the default pixel format (`avPixFmtPal8`) results in a good-looking,+ fairly large file thanks to JuicyPixels's `palettize` function.++ * Setting the `epPreset` field of the `EncodingParams` value passed to+ `frameWriter` to `"dither"` results in an even prettier, even larger GIF+ file (again, thanks to JuicyPixels's `palettize` function).++ * See the `demo/Raster.hs` for examples.+ 0.3.1 ---
demo/Raster.hs view
@@ -87,9 +87,14 @@ -- | Animate the logo and write it to a video file! main :: IO () main = do initFFmpeg- -- We can change the output file extension to ".gif" to get- -- an animated gif!- w <- frameWriter (defaultParams 350 350) "logo.mov"+ -- Change the output file extension to ".gif" to get an+ -- animated gif! We can get a small GIF file by setting+ -- 'epPixelFormat' to 'avPixFmtRgb8', but it might not look+ -- very good.+ w <- frameWriter params "logo.mov" forM_ path $ w . Just . V.unsafeCast . imageData . logoTest (uniformTexture blue) w Nothing+ where params = defaultParams 350 350+ -- tinyGif = params { epPixelFormat = Just avPixFmtRgb8 }+ -- prettyGif = params { preset = "dither" }
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.3.1+version: 0.4 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -51,7 +51,7 @@ Codec.FFmpeg.Scaler, Codec.FFmpeg.Types, Codec.FFmpeg.Internal.Debug,- Codec.FFmpeg.Internal.V3+ Codec.FFmpeg.Internal.Linear build-tools: hsc2hs build-depends: base >=4.6 && < 5, vector >= 0.10.9 && < 0.11,
src/Codec/FFmpeg/Common.hsc view
@@ -29,6 +29,9 @@ foreign import ccall "av_free_packet" free_packet :: AVPacket -> IO () +foreign import ccall "av_malloc"+ av_malloc :: CSize -> IO (Ptr ())+ foreign import ccall "av_free" av_free :: Ptr () -> IO ()
src/Codec/FFmpeg/Encode.hs view
@@ -8,7 +8,7 @@ module Codec.FFmpeg.Encode where import Codec.FFmpeg.Common import Codec.FFmpeg.Enums-import Codec.FFmpeg.Internal.V3+import Codec.FFmpeg.Internal.Linear import Codec.FFmpeg.Scaler import Codec.FFmpeg.Types import Codec.Picture@@ -20,8 +20,10 @@ import Data.Ord (comparing) import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as VM import Foreign.C.String import Foreign.C.Types+import Foreign.ForeignPtr (touchForeignPtr) import Foreign.Marshal.Alloc import Foreign.Marshal.Utils @@ -88,28 +90,43 @@ av_image_fill_arrays :: Ptr (Ptr CUChar) -> Ptr CInt -> Ptr CUChar -> AVPixelFormat -> CInt -> CInt -> CInt -> IO CInt +foreign import ccall "av_image_fill_linesizes"+ av_image_fill_linesizes :: Ptr CInt -> AVPixelFormat -> CInt -> IO CInt+ -- * FFmpeg Encoding Interface -- | Minimal parameters describing the desired video output.-data EncodingParams = EncodingParams { epWidth :: CInt- , epHeight :: CInt- , epFps :: Int- , epCodec :: Maybe AVCodecID- -- ^ If 'Nothing', then the codec- -- is inferred from the output- -- file name. If 'Just', then- -- this codec is manually chosen.- , epPreset :: String }+data EncodingParams = + EncodingParams { epWidth :: CInt+ , epHeight :: CInt+ , epFps :: Int+ , epCodec :: Maybe AVCodecID+ -- ^ If 'Nothing', then the codec is inferred from+ -- the output file name. If 'Just', then this codec+ -- is manually chosen.+ , epPixelFormat :: Maybe AVPixelFormat+ -- ^ If 'Nothing', automatically chose a pixel format+ -- based on the output coded. If 'Just', force the+ -- selected pixel format.+ , epPreset :: String+ -- ^ Encoder-specific hints. For h264, the default+ -- preset is @\"medium\"@ (other options are+ -- @\"fast\"@, @\"slow\"@, etc.). For the GIF codec,+ -- setting this to @\"dither\"@ will enable dithering+ -- during the palettization process. This will+ -- improve image quality, but result in a larger+ -- file.+ } -- | 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) "medium"+defaultH264 w h = EncodingParams w h 30 (Just avCodecIdH264) Nothing "medium" -- | 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 ""+defaultParams w h = EncodingParams w h 30 Nothing Nothing "" -- | Determine if the bitwise intersection of two values is non-zero. checkFlag :: Bits a => a -> a -> Bool@@ -138,9 +155,11 @@ setHeight ctx (epHeight ep) let framePeriod = AVRational 1 (fromIntegral $ epFps ep) setTimeBase ctx framePeriod- setPixelFormat ctx $ case () of- _ | codec == avCodecIdRawvideo -> avPixFmtRgb24- | codec == avCodecIdGif -> avPixFmtRgb8+ setPixelFormat ctx $ case epPixelFormat ep of+ Just fmt -> fmt+ Nothing+ | codec == avCodecIdRawvideo -> avPixFmtRgb24+ | codec == avCodecIdGif -> avPixFmtPal8 | otherwise -> avPixFmtYuv420p -- Some formats want stream headers to be separate@@ -168,14 +187,19 @@ -- a destination before encoding the video frame. initTempFrame :: EncodingParams -> AVPixelFormat -> IO AVFrame initTempFrame ep fmt = do- yuv <- frame_alloc_check- setPixelFormat yuv fmt- setWidth yuv (epWidth ep)- setHeight yuv (epHeight ep)- setPts yuv 0- frame_get_buffer_check yuv 32- return yuv+ frame <- frame_alloc_check+ setPixelFormat frame fmt+ setWidth frame (epWidth ep)+ setHeight frame (epHeight ep)+ setPts frame 0 + -- For palettized images, we will provide our own buffer.+ if fmt == avPixFmtRgb8 || fmt == avPixFmtPal8+ then do r <- av_image_fill_linesizes (hasLineSize frame) fmt (epWidth ep)+ when (r < 0) (errMsg "Error filling temporary frame line sizes")+ else frame_get_buffer_check frame 32+ return frame+ -- | Allocate an output context inferring the codec from the given -- file name. allocOutputContext :: FilePath -> IO AVFormatContext@@ -232,19 +256,40 @@ write_trailer_check oc = do r <- av_write_trailer oc when (r /= 0) (errMsg "Error writing trailer") --- | Quantize RGB24 pixels to the systematic RGB8 color palette. This--- is slow, but lets us prepare an RGB24 pixel format for output as an--- RGB8 GIF.-palettizeRGB8 :: V.Vector (V3 CUChar) -> V.Vector CUChar-palettizeRGB8 = V.map (searchPal . fmap fromIntegral)- where pal :: V.Vector (V3 CInt)- pal = V.generate 256 $ \i' -> +-- | Quantize RGB24 pixels to the systematic RGB8 color palette. The+-- image data has space for a palette appended to be compliant with+-- 'av_image_fill_arrays''s expectations. This is slow.+palettizeRGB8 :: EncodingParams -> V.Vector CUChar -> V.Vector CUChar+palettizeRGB8 ep = \pix -> V.create $+ do let pix' = V.unsafeCast pix :: V.Vector (V3 CUChar)+ m <- VM.new (numPix + 1024)+ V.mapM_ (\i -> let p = searchPal $ fromIntegral <$> (pix' V.! i)+ in VM.unsafeWrite m i p)+ (V.enumFromN 0 numPix)+ VM.set (VM.unsafeSlice numPix 1024 m) 0+ return m+ where numPix = fromIntegral $ epWidth ep * epHeight ep+ pal :: V.Vector (V3 CInt)+ pal = V.generate 256 $ \i' -> let i = fromIntegral i' in V3 ((i `shiftR` 5) * 36) (((i `shiftR` 2) .&. 7) * 36) ((i .&. 3) * 85) searchPal = fromIntegral . flip V.minIndexBy pal . comparing . qd +-- | High quality dithered, median cut palette using 'palettize'. The+-- result is packed such that the BGRA palette is laid out+-- contiguously following the palettized image data.+palettizeJuicy :: EncodingParams -> V.Vector CUChar -> V.Vector CUChar+palettizeJuicy ep pix = + let (pix', pal) = palettize (PaletteOptions MedianMeanCut doDither 256)+ (mkImage $ V.unsafeCast pix)+ pal' = V.map (\(V3 r g b) -> V4 b g r (255::CUChar))+ (V.unsafeCast $ imageData pal)+ in V.unsafeCast (imageData pix') V.++ V.unsafeCast pal'+ where mkImage = Image (fromIntegral $ epWidth ep) (fromIntegral $ epHeight ep)+ doDither = epPreset ep == "dither"+ -- | Open a target file for writing a video stream. The function -- returned may be used to write RGB images of the resolution given by -- the provided 'EncodingParams'. The function will convert the@@ -269,7 +314,7 @@ swsBilinear else return Nothing - pkt <- AVPacket <$> mallocBytes packetSize+ pkt <- AVPacket <$> av_malloc (fromIntegral packetSize) stIndex <- getStreamIndex st avio_open_check oc fname@@ -279,7 +324,10 @@ codecTB <- getCodecContext st >>= getTimeBase isRaw <- checkFlag avfmtRawpicture <$> (getOutputFormat oc >>= getFormatFlags) - let frameTime = av_rescale_q 1 codecTB tb+ let palettizer | dstFmt == avPixFmtPal8 = Just $ palettizeJuicy ep+ | dstFmt == avPixFmtRgb8 = Just $ palettizeRGB8 ep+ | otherwise = Nothing+ frameTime = av_rescale_q 1 codecTB tb mkImage :: Vector CUChar -> Image PixelRGB8 mkImage = let [w,h] = map fromIntegral [epWidth ep, epHeight ep] in Image w h . V.unsafeCast@@ -288,9 +336,7 @@ setSize pkt 0 writePacket = do setStreamIndex pkt stIndex write_frame_check oc pkt- copyDstData- | dstFmt == avPixFmtRgb8 = copyDstDataAux . palettizeRGB8 . V.unsafeCast- | otherwise = copyDstDataAux+ copyDstData = copyDstDataAux copyDstDataAux pixels = void . V.unsafeWith pixels $ \ptr ->@@ -320,14 +366,19 @@ flip when (writePacket >> addEncoded Nothing) addEncoded (Just pixels) = do resetPacket- fillDst pixels+ let pixels' = maybe pixels ($ V.unsafeCast pixels) palettizer+ fillDst pixels' getPts dstFrame >>= setPts dstFrame . (+ frameTime) encode_video_check ctx pkt (Just dstFrame) >>= flip when writePacket+ -- Make sure the GC hasn't clobbered our palettized pixel data+ let (fp,_,_) = V.unsafeToForeignPtr pixels'+ touchForeignPtr fp addFrame = if isRaw then addRaw else addEncoded go Nothing = do addFrame Nothing write_trailer_check oc _ <- codec_close ctx with dstFrame av_frame_free+ av_free (getPtr pkt) avio_close_check oc avformat_free_context oc go (Just pixels) = addFrame (Just pixels)
src/Codec/FFmpeg/Enums.hsc view
@@ -32,6 +32,7 @@ #enum AVPixelFormat,AVPixelFormat \ , AV_PIX_FMT_NONE\ , AV_PIX_FMT_RGB24\+ , AV_PIX_FMT_RGBA\ , AV_PIX_FMT_Y400A\ , AV_PIX_FMT_RGB32\ , AV_PIX_FMT_RGB32_1\
+ src/Codec/FFmpeg/Internal/Linear.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- | Minimal operations on small vector types.+module Codec.FFmpeg.Internal.Linear where+import Control.Applicative+import Foreign.C.Types+import Foreign.Ptr (castPtr)+import Foreign.Storable++-- | A basic three component vector.+data V3 a = V3 !a !a !a++instance Functor V3 where+ fmap f (V3 x y z) = V3 (f x) (f y) (f z)++instance Storable a => Storable (V3 a) where+ sizeOf _ = 3 * sizeOf (undefined::a)+ alignment _ = alignment (undefined::a)+ peek ptr = let ptr' = castPtr ptr+ in V3 <$> peek ptr' <*> peekElemOff ptr' 1 <*> peekElemOff ptr' 2+ poke ptr (V3 x y z) = let ptr' = castPtr ptr+ in do poke ptr' x+ pokeElemOff ptr' 1 y+ pokeElemOff ptr' 2 z++-- | Quadrance between two 3D points.+qd :: V3 CInt -> V3 CInt -> CInt+qd (V3 x1 y1 z1) (V3 x2 y2 z2) = let dx = x2 - x1+ dy = y2 - y1+ dz = z2 - z1+ in dx * dx + dy * dy + dz * dz++data V4 a = V4 !a !a !a !a++instance Functor V4 where+ fmap f (V4 x y z w) = V4 (f x) (f y) (f z) (f w)++instance Storable a => Storable (V4 a) where+ sizeOf _ = 4 * sizeOf (undefined::a)+ alignment _ = alignment (undefined::a)+ peek ptr = let ptr' = castPtr ptr+ in V4 <$> peek ptr' <*> peekElemOff ptr' 1+ <*> peekElemOff ptr' 2 <*> peekElemOff ptr' 3+ poke ptr (V4 x y z w) = let ptr' = castPtr ptr+ in do poke ptr' x+ pokeElemOff ptr' 1 y+ pokeElemOff ptr' 2 z+ pokeElemOff ptr' 3 w
− src/Codec/FFmpeg/Internal/V3.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | A basic three component vector.-module Codec.FFmpeg.Internal.V3 where-import Control.Applicative-import Foreign.C.Types-import Foreign.Ptr (castPtr)-import Foreign.Storable---- | A basic three component vector.-data V3 a = V3 !a !a !a--instance Functor V3 where- fmap f (V3 x y z) = V3 (f x) (f y) (f z)--instance Storable a => Storable (V3 a) where- sizeOf _ = 3 * sizeOf (undefined::a)- alignment _ = alignment (undefined::a)- peek ptr = let ptr' = castPtr ptr- in V3 <$> peek ptr' <*> peekElemOff ptr' 1 <*> peekElemOff ptr' 2- poke ptr (V3 x y z) = let ptr' = castPtr ptr- in do poke ptr' x- pokeElemOff ptr' 1 y- pokeElemOff ptr' 2 z---- | Quadrance between two 3D points.-qd :: V3 CInt -> V3 CInt -> CInt-qd (V3 x1 y1 z1) (V3 x2 y2 z2) = let dx = x2 - x1- dy = y2 - y1- dz = z2 - z1- in dx * dx + dy * dy + dz * dz
src/Codec/FFmpeg/Juicy.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances #-} -- | Convert between FFmpeg frames and JuicyPixels images. module Codec.FFmpeg.Juicy where import Codec.Picture@@ -54,3 +54,16 @@ -- be converted to a 'DynamicImage' using 'toJuicy'. saveJuicy :: FilePath -> AVFrame -> IO () saveJuicy name = toJuicy >=> traverse_ (savePngImage name)++-- | Mapping of @JuicyPixels@ pixel types to FFmpeg pixel formats.+class JuicyPixelFormat a where+ juicyPixelFormat :: proxy a -> AVPixelFormat++instance JuicyPixelFormat Pixel8 where+ juicyPixelFormat _ = avPixFmtGray8++instance JuicyPixelFormat PixelRGB8 where+ juicyPixelFormat _ = avPixFmtRgb24++instance JuicyPixelFormat PixelRGBA8 where+ juicyPixelFormat _ = avPixFmtRgba
src/nameCompat.h view
@@ -5,6 +5,7 @@ #define AV_PIX_FMT_NONE PIX_FMT_NONE #define AV_PIX_FMT_RGB24 PIX_FMT_RGB24+#define AV_PIX_FMT_RGBA PIX_FMT_RGBA #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