ffmpeg-light 0.4 → 0.5
raw patch · 11 files changed
+238/−91 lines, 11 files
Files
- CHANGELOG.md +8/−0
- demo/Main.hs +14/−12
- demo/Raster.hs +19/−9
- ffmpeg-light.cabal +3/−4
- src/Codec/FFmpeg.hs +3/−1
- src/Codec/FFmpeg/Common.hsc +10/−0
- src/Codec/FFmpeg/Decode.hs +13/−13
- src/Codec/FFmpeg/Encode.hs +46/−20
- src/Codec/FFmpeg/Internal/Linear.hs +5/−1
- src/Codec/FFmpeg/Juicy.hs +99/−29
- src/Codec/FFmpeg/Scaler.hs +18/−2
CHANGELOG.md view
@@ -1,3 +1,11 @@+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 ---
demo/Main.hs view
@@ -2,50 +2,52 @@ import Codec.Picture import Control.Applicative import Control.Monad.Error-import Control.Monad.Trans.Maybe import qualified Data.Vector.Storable as V import System.Environment -- The example used in the README firstFrame :: IO (Maybe DynamicImage)-firstFrame = do (getFrame, cleanup) <- frameReaderT "myVideo.mov"- (runMaybeT $ getFrame >>= toJuicyT) <* cleanup+firstFrame = do (getFrame, cleanup) <- imageReader "myVideo.mov"+ (fmap ImageRGB8 <$> getFrame) <* cleanup -- | Generate a video that pulses from light to dark. pulseVid :: IO () pulseVid =- do boom <- frameWriter (defaultParams sz sz) "pulse.mov"- let go :: Int -> Int -> Int -> IO ()+ do boom <- imageWriter (defaultParams sz sz) "pulse.mov"+ let boom' = (boom :: Maybe (Image Pixel8) -> IO ()) . Just . Image sz sz+ go :: Int -> Int -> Int -> IO () go 600 _ _ = boom Nothing- go n d i = do boom (Just $ V.replicate (fromIntegral $ sz*sz*3) - (fromIntegral i))+ go n d i = do boom' $ V.replicate (sz*sz) (fromIntegral i) let i' = i + d if i' < 100 then go (n+1) 1 101 else if i' > 255 then go (n+1) (-1) 254 else go (n+1) d i'- go 0 (-1) 255- where sz = 64+ where sz :: Integral a => a+ sz = 64 +-- | Generate a video that fades from white to gray to white. testEncode :: IO () testEncode = initFFmpeg >> pulseVid >> putStrLn "All done!" +-- | Decoding example. Try changing 'ImageRGB8' to 'ImageY8' in the+-- 'savePngImage' lines to automatically decode to grayscale images! testDecode :: FilePath -> IO () testDecode vidFile = do initFFmpeg- (getFrame, cleanup) <- frameReaderTime vidFile+ (getFrame, cleanup) <- imageReaderTime vidFile frame1 <- getFrame case frame1 of Just (avf,ts) -> do putStrLn $ "Frame at "++show ts- saveJuicy "frame1.png" avf+ savePngImage "frame1.png" (ImageRGB8 avf) Nothing -> putStrLn "No frame for me :(" replicateM_ 299 getFrame frame2 <- getFrame case frame2 of Just (avf,ts) -> do putStrLn $ "Frame at "++show ts- saveJuicy "frame2.png" avf+ savePngImage "frame2.png" (ImageRGB8 avf) Nothing -> putStrLn "No frame for me :(" cleanup putStrLn "All done!"
demo/Raster.hs view
@@ -2,7 +2,6 @@ import Codec.FFmpeg import Codec.Picture import Control.Monad (forM_)-import qualified Data.Vector.Storable as V import Graphics.Rasterific import Graphics.Rasterific.Texture import Graphics.Rasterific.Transformations@@ -59,11 +58,22 @@ background = PixelRGB8 128 128 128 blue = PixelRGB8 0 020 150 +-- `fgSize` will determine our image size. `bgSize` is smaller so we+-- see the effect of the `SamplerRepeat` sampler.++fgSize, fgScale, bgSize :: Float+fgSize = 350+fgScale = fgSize / 100+bgSize = 57 * fgScale++fgSizei :: Integral a => a+fgSizei = floor fgSize+ -- | A ring with a drop-shadow on the inside. The texture is repeated, -- resulting in concentric rings centered at @(200,200)@. bgGrad :: Texture PixelRGB8 bgGrad = withSampler SamplerRepeat $- radialGradientTexture gradDef (V2 200 200) 100+ radialGradientTexture gradDef (V2 bgSize bgSize) (bgSize * 0.5) where gradDef = [(0 , PixelRGB8 255 255 255) ,(0.5, PixelRGB8 255 255 255) ,(0.5, PixelRGB8 255 255 255)@@ -75,13 +85,14 @@ -- | Adapted from the Rasterific logo example. logoTest :: Texture PixelRGB8 -> Vector -> Image PixelRGB8-logoTest texture insetOrigin = renderDrawing 350 350 background (bg >> drawing)+logoTest texture insetOrigin = + renderDrawing fgSizei fgSizei background (bg >> drawing) where beziers = logo 40 False $ V2 10 10 inverse = logo 20 True $ (V2 20 20 + insetOrigin)- bg = withTexture bgGrad . fill $ rectangle (V2 0 0) 350 350+ bg = withTexture bgGrad . fill $ rectangle (V2 0 0) fgSize fgSize drawing = withTexture texture . fill - . transform (applyTransformation $ scale 3.5 3.5)+ . transform (applyTransformation $ scale fgScale fgScale) $ beziers ++ inverse -- | Animate the logo and write it to a video file!@@ -91,10 +102,9 @@ -- 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 <- imageWriter params "logo.mov"+ forM_ path $ w . Just . logoTest (uniformTexture blue) w Nothing- where params = defaultParams 350 350+ where params = defaultParams fgSizei fgSizei -- tinyGif = params { epPixelFormat = Just avPixFmtRgb8 } -- prettyGif = params { preset = "dither" }
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.4+version: 0.5 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -10,11 +10,10 @@ > import Codec.FFmpeg > import Codec.Picture > import Control.Applicative- > import Control.Monad.Trans.Maybe > > go :: IO (Maybe DynamicImage)- > go = do (getFrame, cleanup) <- frameReaderT "myVideo.mov"- > (runMaybeT $ getFrame >>= toJuicyT) <* cleanup+ > go = do (getFrame, cleanup) <- imageReader "myVideo.mov"+ > (fmap ImageRGB8 <$> getFrame) <* cleanup . Tested on OS X 10.9.2 with <http://www.ffmpeg.org FFmpeg> 2.2.1 installed via <http://brew.sh homebrew>.
src/Codec/FFmpeg.hs view
@@ -6,8 +6,10 @@ -- * Decoding frameReader, frameReaderT, frameReaderTime, frameReaderTimeT,+ imageReader, imageReaderTime, -- * Encoding- EncodingParams(..), defaultParams, frameWriter,+ EncodingParams(..), defaultParams,+ frameWriterRgb, imageWriter, -- * JuicyPixels interop toJuicy, toJuicyT, saveJuicy, -- * Types and Enums
src/Codec/FFmpeg/Common.hsc view
@@ -76,3 +76,13 @@ frame_get_buffer_check f x = do r <- av_frame_get_buffer f x when (r /= 0) (errMsg "Failed to allocate buffers")++-- | Bytes-per-pixel for an 'AVPixelFormat'+avPixelStride :: AVPixelFormat -> Maybe Int+avPixelStride fmt+ | fmt == avPixFmtGray8 = Just 1+ | fmt == avPixFmtRgb24 = Just 3+ | fmt == avPixFmtRgba = Just 4+ | fmt == avPixFmtRgb8 = Just 1+ | fmt == avPixFmtPal8 = Just 1+ | otherwise = Nothing
src/Codec/FFmpeg/Decode.hs view
@@ -131,31 +131,32 @@ -- | Read RGB frames from a video stream. frameReader :: (MonadIO m, Error e, MonadError e m)- => FilePath -> m (IO (Maybe AVFrame), IO ())-frameReader fileName =+ => AVPixelFormat -> FilePath -> m (IO (Maybe AVFrame), IO ())+frameReader dstFmt fileName = do inputContext <- openInput fileName checkStreams inputContext (vidStreamIndex, ctx, cod) <- findVideoStream inputContext _ <- openCodec ctx cod- prepareReader inputContext vidStreamIndex ctx+ prepareReader inputContext vidStreamIndex dstFmt ctx -- | Read RGB frames with the result in the 'MaybeT' transformer. -- -- > frameReaderT = fmap (first MaybeT) . frameReader frameReaderT :: (Functor m, MonadIO m, Error e, MonadError e m) => FilePath -> m (MaybeT IO AVFrame, IO ())-frameReaderT = fmap (first MaybeT) . frameReader+frameReaderT = fmap (first MaybeT) . frameReader avPixFmtRgb24 -- | Read time stamped RGB frames from a video stream. Time is given -- in seconds from the start of the stream. frameReaderTime :: (MonadIO m, Error e, MonadError e m)- => FilePath -> m (IO (Maybe (AVFrame, Double)), IO ())-frameReaderTime fileName =+ => AVPixelFormat -> FilePath+ -> m (IO (Maybe (AVFrame, Double)), IO ())+frameReaderTime dstFmt fileName = do inputContext <- openInput fileName checkStreams inputContext (vidStreamIndex, ctx, cod) <- findVideoStream inputContext _ <- openCodec ctx cod- (reader, cleanup) <- prepareReader inputContext vidStreamIndex ctx+ (reader, cleanup) <- prepareReader inputContext vidStreamIndex dstFmt ctx AVRational num den <- liftIO $ getTimeBase ctx let (numl, dend) = (fromIntegral num, fromIntegral den) frameTime' frame = @@ -174,14 +175,14 @@ -- > frameReaderT = fmap (first MaybeT) . frameReader frameReaderTimeT :: (Functor m, MonadIO m, Error e, MonadError e m) => FilePath -> m (MaybeT IO (AVFrame, Double), IO ())-frameReaderTimeT = fmap (first MaybeT) . frameReaderTime+frameReaderTimeT = fmap (first MaybeT) . frameReaderTime avPixFmtRgb24 -- | Construct an action that gets the next available frame, and an -- action to release all resources associated with this video stream. prepareReader :: (MonadIO m, Error e, MonadError e m)- => AVFormatContext -> CInt -> AVCodecContext+ => AVFormatContext -> CInt -> AVPixelFormat -> AVCodecContext -> m (IO (Maybe AVFrame), IO ())-prepareReader fmtCtx vidStream codCtx =+prepareReader fmtCtx vidStream dstFmt codCtx = wrapIOError $ do fRaw <- frame_alloc_check fRgb <- frame_alloc_check@@ -192,12 +193,11 @@ setWidth fRgb w setHeight fRgb h- setPixelFormat fRgb avPixFmtRgb24+ setPixelFormat fRgb dstFmt frame_get_buffer_check fRgb 32 - sws <- swsInit (ImageInfo w h fmt) (ImageInfo w h avPixFmtRgb24) - swsBilinear+ sws <- swsInit (ImageInfo w h fmt) (ImageInfo w h dstFmt) swsBilinear pkt <- AVPacket <$> mallocBytes packetSize let cleanup = do with fRgb av_frame_free
src/Codec/FFmpeg/Encode.hs view
@@ -18,6 +18,7 @@ import Data.Bits import Data.Maybe (fromMaybe) import Data.Ord (comparing)+import Data.Traversable (for) import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as V import qualified Data.Vector.Storable.Mutable as VM@@ -106,7 +107,7 @@ -- is manually chosen. , epPixelFormat :: Maybe AVPixelFormat -- ^ If 'Nothing', automatically chose a pixel format- -- based on the output coded. If 'Just', force the+ -- based on the output codec. If 'Just', force the -- selected pixel format. , epPreset :: String -- ^ Encoder-specific hints. For h264, the default@@ -291,27 +292,32 @@ 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--- supplied RGB frame to YUV (specifically, @yuv420p@) before encoding--- the image to the video stream. If this function is applied to+-- returned may be used to write image frames (specified by a pixel+-- format, resolution, and pixel data). If this function is applied to -- 'Nothing', then the output stream is closed. Note that 'Nothing' -- /must/ be provided to properly terminate video encoding.-frameWriter :: EncodingParams -> FilePath -> IO (Maybe (Vector CUChar) -> IO ())+-- +-- Support for source images that are of a different size to the+-- output resolution is limited to non-palettized destination formats+-- (i.e. those that are handled by @libswscaler@). Practically, this+-- means that animated gif output only works if the source images are+-- of the target resolution.+frameWriter :: EncodingParams -> FilePath+ -> IO (Maybe (AVPixelFormat, V2 CInt, Vector CUChar) -> IO ()) frameWriter ep fname = do oc <- allocOutputContext fname (st,ctx) <- initStream ep oc dstFmt <- getPixelFormat ctx dstFrame <- initTempFrame ep dstFmt+ let dstInfo = ImageInfo (epWidth ep) (epHeight ep) dstFmt -- Initialize the scaler that we use to convert RGB -> dstFmt -- Note that libswscaler does not support Pal8 as an output format. sws <- if dstFmt /= avPixFmtPal8 && dstFmt /= avPixFmtRgb8 then Just <$> swsInit (ImageInfo (epWidth ep) (epHeight ep) avPixFmtRgb24)- (ImageInfo (epWidth ep) (epHeight ep) dstFmt)- swsBilinear+ dstInfo swsBilinear else return Nothing pkt <- AVPacket <$> av_malloc (fromIntegral packetSize)@@ -324,21 +330,24 @@ codecTB <- getCodecContext st >>= getTimeBase isRaw <- checkFlag avfmtRawpicture <$> (getOutputFormat oc >>= getFormatFlags) - let palettizer | dstFmt == avPixFmtPal8 = Just $ palettizeJuicy ep+ let checkPalCompat+ | dstFmt /= avPixFmtPal8 && dstFmt /= avPixFmtRgb8 = const True+ | otherwise = \(srcFmt, V2 srcW srcH, _) ->+ srcFmt == avPixFmtRgb24 &&+ srcW == epWidth ep &&+ srcH == epHeight ep++ 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 resetPacket = do init_packet pkt setData pkt nullPtr setSize pkt 0 writePacket = do setStreamIndex pkt stIndex write_frame_check oc pkt- copyDstData = copyDstDataAux - copyDstDataAux pixels =+ copyDstData (_,_,pixels) = void . V.unsafeWith pixels $ \ptr -> av_image_fill_arrays (castPtr $ hasData dstFrame) (hasLineSize dstFrame)@@ -347,10 +356,11 @@ (epWidth ep) (epHeight ep) 1- scaleToDst sws' pixels = void $ swsScale sws' (mkImage pixels) dstFrame- fillDst = maybe copyDstData scaleToDst sws++ scaleToDst sws' img = void $ swsScale sws' img dstFrame+ fillDst = maybe copyDstData scaleToDst addRaw Nothing = return ()- addRaw (Just pixels) =+ addRaw (Just (_, _, pixels)) = do resetPacket getPacketFlags pkt >>= setPacketFlags pkt . (.|. avPktFlagKey) --setSize pkt (fromIntegral $ V.length pixels)@@ -364,10 +374,15 @@ addEncoded Nothing = do resetPacket encode_video_check ctx pkt Nothing >>= flip when (writePacket >> addEncoded Nothing)- addEncoded (Just pixels) =+ addEncoded (Just srcImg@(srcFmt, V2 srcW srcH, pixels)) = do resetPacket+ when (not $ checkPalCompat srcImg)+ (error $ "Palettized output requires source images to be the \+ \same resolution as the output video") let pixels' = maybe pixels ($ V.unsafeCast pixels) palettizer- fillDst pixels'+ sws' <- for sws $ \s ->+ swsReset s (ImageInfo srcW srcH srcFmt) dstInfo swsBilinear+ fillDst sws' (srcFmt, V2 srcW srcH, 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@@ -381,5 +396,16 @@ av_free (getPtr pkt) avio_close_check oc avformat_free_context oc- go (Just pixels) = addFrame (Just pixels)+ go img@(Just _) = addFrame img return go++-- | 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' (i.e. the same resolution as the+-- output video). If this function is applied to 'Nothing', then the+-- output stream is closed. Note that 'Nothing' /must/ be provided to+-- properly terminate video encoding.+frameWriterRgb :: EncodingParams -> FilePath+ -> IO (Maybe (Vector CUChar) -> IO ())+frameWriterRgb ep f = (. fmap aux) <$> frameWriter ep f+ where aux pixels = (avPixFmtRgb24, V2 (epWidth ep) (epHeight ep), pixels)
src/Codec/FFmpeg/Internal/Linear.hs view
@@ -6,7 +6,10 @@ import Foreign.Ptr (castPtr) import Foreign.Storable --- | A basic three component vector.+-- | A two-component vector+data V2 a = V2 !a !a++-- | A three-component vector data V3 a = V3 !a !a !a instance Functor V3 where@@ -29,6 +32,7 @@ dz = z2 - z1 in dx * dx + dy * dy + dz * dz +-- | A four-component vector data V4 a = V4 !a !a !a !a instance Functor V4 where
src/Codec/FFmpeg/Juicy.hs view
@@ -1,12 +1,19 @@-{-# LANGUAGE FlexibleContexts, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances #-} -- | Convert between FFmpeg frames and JuicyPixels images. module Codec.FFmpeg.Juicy where import Codec.Picture+import Codec.FFmpeg.Common+import Codec.FFmpeg.Decode+import Codec.FFmpeg.Encode import Codec.FFmpeg.Enums+import Codec.FFmpeg.Internal.Linear (V2(..)) import Codec.FFmpeg.Types import Control.Applicative-import Control.Arrow ((&&&))-import Control.Monad (when, (>=>))+import Control.Arrow (first, (&&&))+import Control.Monad ((>=>))+import Control.Monad.Error.Class+import Control.Monad.IO.Class+import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Foldable (traverse_) import qualified Data.Vector.Storable as V@@ -14,6 +21,7 @@ import Foreign.C.Types import Foreign.Marshal.Array (advancePtr, copyArray) import Foreign.Ptr (castPtr, Ptr)+import Foreign.Storable (sizeOf) -- | Convert an 'AVFrame' to a 'DynamicImage' with the result in the -- 'MaybeT' transformer.@@ -24,39 +32,57 @@ -- | Convert an 'AVFrame' to a 'DynamicImage'. toJuicy :: AVFrame -> IO (Maybe DynamicImage)-toJuicy frame = do- fmt <- getPixelFormat frame- when (fmt /= avPixFmtRgb24)- (putStrLn "Not RGB24?!")- w <- fromIntegral <$> getWidth frame- h <- fromIntegral <$> getHeight frame- pixels <- castPtr <$> getData frame :: IO (Ptr CUChar)- srcStride <- fromIntegral <$> getLineSize frame- let dstStride = w * 3- v <- VM.new (w*h*3)- VM.unsafeWith v $ \vptr ->- mapM_ (\(i,o) -> copyArray (advancePtr vptr o)- (advancePtr pixels i)- (w * 3))- (map ((srcStride *) &&& (dstStride*)) [0 .. h - 1])- v' <- V.unsafeFreeze v- let mkImage :: V.Storable (PixelBaseComponent a)- => (Image a -> DynamicImage) -> Maybe DynamicImage- mkImage c = Just $ c (Image w h (V.unsafeCast v'))- return $- case () of- _ | fmt == avPixFmtRgb24 -> mkImage ImageRGB8- | fmt == avPixFmtGray8 -> mkImage ImageY8- | fmt == avPixFmtGray16 -> mkImage ImageY16- | otherwise -> Nothing+toJuicy frame = runMaybeT $ do+ fmt <- lift $ getPixelFormat frame+ pixelStride <- MaybeT . return $ avPixelStride fmt+ MaybeT $ do+ w <- fromIntegral <$> getWidth frame+ h <- fromIntegral <$> getHeight frame+ pixels <- castPtr <$> getData frame :: IO (Ptr CUChar)+ srcStride <- fromIntegral <$> getLineSize frame+ let dstStride = w * pixelStride+ v <- VM.new $ h * dstStride+ VM.unsafeWith v $ \vptr ->+ mapM_ (\(i,o) -> copyArray (advancePtr vptr o)+ (advancePtr pixels i)+ dstStride)+ (map ((srcStride *) &&& (dstStride*)) [0 .. h - 1])+ v' <- V.unsafeFreeze v+ let mkImage :: V.Storable (PixelBaseComponent a)+ => (Image a -> DynamicImage) -> Maybe DynamicImage+ mkImage c = Just $ c (Image w h (V.unsafeCast v'))+ return $ case () of+ _ | fmt == avPixFmtRgb24 -> mkImage ImageRGB8+ | fmt == avPixFmtGray8 -> mkImage ImageY8+ | fmt == avPixFmtGray16 -> mkImage ImageY16+ | otherwise -> Nothing +-- | Convert an 'AVFrame' to an 'Image'.+toJuicyImage :: forall p. JuicyPixelFormat p => AVFrame -> IO (Maybe (Image p))+toJuicyImage frame =+ do fmt <- getPixelFormat frame+ if fmt /= juicyPixelFormat ([] :: [p])+ then return Nothing+ else do w <- fromIntegral <$> getWidth frame+ h <- fromIntegral <$> getHeight frame+ pixels <- castPtr <$> getData frame :: IO (Ptr CUChar)+ srcStride <- fromIntegral <$> getLineSize frame+ let dstStride = w * juicyPixelStride ([]::[p])+ v <- VM.new $ h * dstStride+ VM.unsafeWith v $ \vptr ->+ mapM_ (\(i,o) -> copyArray (advancePtr vptr o)+ (advancePtr pixels i)+ dstStride)+ (map ((srcStride *) &&& (dstStride*)) [0 .. h - 1])+ Just . Image w h . V.unsafeCast <$> V.unsafeFreeze v+ -- | Save an 'AVFrame' to a PNG file on disk assuming the frame could -- 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+class Pixel a => JuicyPixelFormat a where juicyPixelFormat :: proxy a -> AVPixelFormat instance JuicyPixelFormat Pixel8 where@@ -67,3 +93,47 @@ instance JuicyPixelFormat PixelRGBA8 where juicyPixelFormat _ = avPixFmtRgba++-- | Bytes-per-pixel for a JuicyPixels 'Pixel' type.+juicyPixelStride :: forall a proxy. Pixel a => proxy a -> Int+juicyPixelStride _ = + sizeOf (undefined :: PixelBaseComponent a) * componentCount (undefined :: a)++-- | Read RGB frames from a video stream.+imageReader :: forall m p e.+ (Functor m, MonadIO m, Error e, MonadError e m,+ JuicyPixelFormat p)+ => FilePath -> m (IO (Maybe (Image p)), IO ())+imageReader = fmap (first (runMaybeT . aux toJuicyImage))+ . frameReader (juicyPixelFormat ([] :: [p]))+ where aux g x = MaybeT x >>= MaybeT . g++-- | Read time stamped RGB frames from a video stream. Time is given+-- in seconds from the start of the stream.+imageReaderTime :: forall m p e.+ (Functor m, MonadIO m, Error e, MonadError e m,+ JuicyPixelFormat p)+ => FilePath -> m (IO (Maybe (Image p, Double)), IO ())+imageReaderTime = fmap (first (runMaybeT . aux toJuicyImage))+ . frameReaderTime (juicyPixelFormat ([] :: [p]))+ where aux g x = do (f,t) <- MaybeT x+ f' <- MaybeT $ g f+ return (f', t)++-- | Open a target file for writing a video stream. When the returned+-- function is applied to 'Nothing', the output stream is closed. Note+-- that 'Nothing' /must/ be provided when finishing in order to+-- properly terminate video encoding.+-- +-- Support for source images that are of a different size to the+-- output resolution is limited to non-palettized destination formats+-- (i.e. those that are handled by @libswscaler@). Practically, this+-- means that animated gif output is only supported if the source+-- images are of the target resolution.+imageWriter :: forall p. JuicyPixelFormat p+ => EncodingParams -> FilePath -> IO (Maybe (Image p) -> IO ())+imageWriter ep f = (. fmap aux) <$> frameWriter ep f+ where aux img = let w = fromIntegral $ imageWidth img+ h = fromIntegral $ imageHeight img+ p = V.unsafeCast $ imageData img+ in (juicyPixelFormat ([]::[p]), V2 w h, p)
src/Codec/FFmpeg/Scaler.hs view
@@ -1,9 +1,12 @@-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables,+ UndecidableInstances #-} module Codec.FFmpeg.Scaler where import Codec.FFmpeg.Common import Codec.FFmpeg.Enums+import Codec.FFmpeg.Internal.Linear (V2(..)) import Codec.FFmpeg.Types import Codec.Picture+import Data.Maybe (fromMaybe) import qualified Data.Vector.Storable as V import Foreign.C.Types import Foreign.Marshal.Array (withArray)@@ -14,13 +17,17 @@ , imgHeight :: CInt , imgFormat :: AVPixelFormat } +-- | @swsInit srcInfo dstInfo alg@ initializations an 'SwsContext' to+-- scale and convert from @srcInfo@ to @dstInfo@ using the algorithm+-- @alg@ when scaling. swsInit :: ImageInfo -> ImageInfo -> SwsAlgorithm -> IO SwsContext swsInit = swsReset (SwsContext nullPtr) -- | Obtain a context for converting the source to destination -- format. If the given context is already configured for the required -- conversion, it is returned. Otherwise, the given context is freed--- and a new, configured context is returned.+-- and a new, configured context is returned. See 'swsInit' for a+-- description of the arguments. swsReset :: SwsContext -> ImageInfo -> ImageInfo -> SwsAlgorithm -> IO SwsContext swsReset ctx src dst alg = sws_getCachedContext ctx@@ -51,6 +58,15 @@ componentCount (undefined :: a) stride = fromIntegral $ imageWidth img * sz sliceHeight img k = k (fromIntegral $ imageHeight img)++instance SwsCompatible (AVPixelFormat, V2 CInt, V.Vector CUChar) where+ swsPlanes (_,_,p) k = V.unsafeWith p $ \ptr ->+ withArray (castPtr ptr : replicate 7 nullPtr) k+ swsStrides (fmt, V2 w _, _) k = withArray (stride : replicate 7 0) k+ where sz = fromMaybe (error $ "Unknown pixel stride for format "++show fmt)+ (avPixelStride fmt)+ stride = w * fromIntegral sz+ sliceHeight (_, V2 _ h, _) k = k h -- | Supplies a continuation with all components provided by the -- 'SwsCompatible' class.