ffmpeg-light 0.3.0.1 → 0.3.1
raw patch · 6 files changed
+185/−11 lines, 6 filesdep +Rasterificdep +lineardep ~JuicyPixelsdep ~basedep ~mtlnew-component:exe:raster
Dependencies added: Rasterific, linear
Dependency ranges changed: JuicyPixels, base, mtl, transformers, vector
Files
- CHANGELOG.md +7/−0
- demo/Raster.hs +95/−0
- ffmpeg-light.cabal +19/−2
- src/Codec/FFmpeg/Encode.hs +32/−9
- src/Codec/FFmpeg/Internal/V3.hs +30/−0
- src/Codec/FFmpeg/Types.hsc +2/−0
CHANGELOG.md view
@@ -1,3 +1,10 @@+0.3.1+---++* Automatically palettize RGB24 to RGB8 for GIF output.++* Add a Rasterific demo program that records an animation.+ 0.3 ---
+ demo/Raster.hs view
@@ -0,0 +1,95 @@+module Main where+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+import Linear++-- | The Rasterific logo sample shape.+logo :: Int -> Bool -> Vector -> [Primitive]+logo size inv offset = map BezierPrim . bezierFromPath . way $ map (^+^ offset)+ [ (V2 0 is)+ , (V2 0 0)+ , (V2 is 0)+ , (V2 is2 0)+ , (V2 is2 is)+ , (V2 is2 is2)+ , (V2 is is2)+ , (V2 0 is2)+ , (V2 0 is)+ ]+ where is = fromIntegral size+ is2 = is + is++ way | inv = reverse+ | otherwise = id++-- | Sample a quadratic bezier curve.+bezierInterp :: Bezier -> [Point]+bezierInterp (Bezier a b c) = go 0+ where v1 = b - a+ v2 = c - b+ go t+ | t >= 1 = []+ | otherwise = let q0 = a + v1 ^* t+ q1 = b + v2 ^* t+ vq = q1 - q0+ in q0 + t *^ vq : (go $! t + 0.05)++-- | Our animation path.+path :: [Point]+path = concatMap bezierInterp $+ bezierFromPath [ (V2 0 is)+ , (V2 0 0)+ , (V2 (is+5) 0)+ , (V2 (is2+10) 0)+ , (V2 (is2+10) is)+ , (V2 (is2+10) is2)+ , (V2 (is+5) is2)+ , (V2 0 is2)+ , (V2 0 is)+ ]+ where is = 15+ is2 = is + is++background, blue :: PixelRGB8+background = PixelRGB8 128 128 128+blue = PixelRGB8 0 020 150++-- | 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+ where gradDef = [(0 , PixelRGB8 255 255 255)+ ,(0.5, PixelRGB8 255 255 255)+ ,(0.5, PixelRGB8 255 255 255)+ ,(0.525, PixelRGB8 255 255 255)+ ,(0.675, PixelRGB8 128 128 128)+ ,(0.75, PixelRGB8 100 149 237)+ ,(1, PixelRGB8 100 149 237)+ ]++-- | Adapted from the Rasterific logo example.+logoTest :: Texture PixelRGB8 -> Vector -> Image PixelRGB8+logoTest texture insetOrigin = renderDrawing 350 350 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+ drawing = withTexture texture . fill + . transform (applyTransformation $ scale 3.5 3.5)+ $ beziers ++ inverse++-- | 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"+ forM_ path $+ w . Just . V.unsafeCast . imageData . logoTest (uniformTexture blue)+ w Nothing
ffmpeg-light.cabal view
@@ -1,5 +1,5 @@ name: ffmpeg-light-version: 0.3.0.1+version: 0.3.1 synopsis: Minimal bindings to the FFmpeg library. description: Stream frames from an encoded video, or stream frames to@@ -37,6 +37,10 @@ description: Build demo executable default: False +flag BuildRasterDemo+ description: Build Rasterific demo executable+ default: False+ library exposed-modules: Codec.FFmpeg, Codec.FFmpeg.Common,@@ -46,7 +50,8 @@ Codec.FFmpeg.Juicy, Codec.FFmpeg.Scaler, Codec.FFmpeg.Types,- Codec.FFmpeg.Internal.Debug+ Codec.FFmpeg.Internal.Debug,+ Codec.FFmpeg.Internal.V3 build-tools: hsc2hs build-depends: base >=4.6 && < 5, vector >= 0.10.9 && < 0.11,@@ -68,4 +73,16 @@ main-is: Main.hs default-language: Haskell2010 ghc-options: -Wall++executable raster+ if !flag(BuildRasterDemo)+ buildable: False+ build-depends: base < 5, vector, mtl, transformers,+ ffmpeg-light, JuicyPixels+ if flag(BuildRasterDemo)+ build-depends: Rasterific, linear+ hs-source-dirs: demo+ main-is: Raster.hs+ default-language: Haskell2010+ ghc-options: -Wall -O2
src/Codec/FFmpeg/Encode.hs view
@@ -2,9 +2,13 @@ -- | Video encoding API. Includes FFI declarations for the underlying -- FFmpeg functions, wrappers for these functions that wrap error -- condition checking, and high level Haskellized interfaces.+-- +-- Note: If you need to import this module, consider qualifying the+-- import. module Codec.FFmpeg.Encode where import Codec.FFmpeg.Common import Codec.FFmpeg.Enums+import Codec.FFmpeg.Internal.V3 import Codec.FFmpeg.Scaler import Codec.FFmpeg.Types import Codec.Picture@@ -13,6 +17,7 @@ import Control.Monad.Error.Class import Data.Bits import Data.Maybe (fromMaybe)+import Data.Ord (comparing) import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as V import Foreign.C.String@@ -49,7 +54,7 @@ av_freep :: Ptr (Ptr a) -> IO () foreign import ccall "av_guess_format"- guess_format :: CString -> CString -> CString -> IO AVOutputFormat+ av_guess_format :: CString -> CString -> CString -> IO AVOutputFormat foreign import ccall "avformat_alloc_output_context2" avformat_alloc_output_context :: Ptr AVFormatContext -> AVOutputFormat@@ -135,7 +140,7 @@ setTimeBase ctx framePeriod setPixelFormat ctx $ case () of _ | codec == avCodecIdRawvideo -> avPixFmtRgb24- | codec == avCodecIdGif -> avPixFmtPal8+ | codec == avCodecIdGif -> avPixFmtRgb8 | otherwise -> avPixFmtYuv420p -- Some formats want stream headers to be separate@@ -148,10 +153,10 @@ -- withCString (preset ep) $ \vStr -> -- av_opt_set ((#ptr AVCodecContext, priv_data) (getPtr ctx)) -- kStr vStr 0- -- _ <- withCString "preset" $ \kStr ->- -- withCString "medium" $ \vStr ->- -- av_opt_set ((#ptr AVCodecContext, priv_data) (getPtr ctx))- -- kStr vStr 0+ when (not . null $ epPreset ep) . void $+ withCString "preset" $ \kStr ->+ withCString (epPreset ep) $ \vStr ->+ getPrivData ctx >>= \pd -> av_opt_set pd kStr vStr 0 rOpen <- open_codec ctx cod nullPtr when (rOpen < 0) (throwError $ strMsg "Couldn't open codec")@@ -227,6 +232,19 @@ 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' -> + 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+ -- | 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@@ -244,7 +262,7 @@ -- 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+ sws <- if dstFmt /= avPixFmtPal8 && dstFmt /= avPixFmtRgb8 then Just <$> swsInit (ImageInfo (epWidth ep) (epHeight ep) avPixFmtRgb24) (ImageInfo (epWidth ep) (epHeight ep) dstFmt)@@ -270,7 +288,11 @@ setSize pkt 0 writePacket = do setStreamIndex pkt stIndex write_frame_check oc pkt- copyDstData pixels =+ copyDstData+ | dstFmt == avPixFmtRgb8 = copyDstDataAux . palettizeRGB8 . V.unsafeCast+ | otherwise = copyDstDataAux++ copyDstDataAux pixels = void . V.unsafeWith pixels $ \ptr -> av_image_fill_arrays (castPtr $ hasData dstFrame) (hasLineSize dstFrame)@@ -285,7 +307,8 @@ addRaw (Just pixels) = do resetPacket getPacketFlags pkt >>= setPacketFlags pkt . (.|. avPktFlagKey)- setSize pkt (fromIntegral $ V.length pixels)+ --setSize pkt (fromIntegral $ V.length pixels)+ setSize pkt (fromIntegral pictureSize) getPts dstFrame >>= setPts dstFrame . (+ frameTime) getPts dstFrame >>= setPts pkt getPts dstFrame >>= setDts pkt
+ src/Codec/FFmpeg/Internal/V3.hs view
@@ -0,0 +1,30 @@+{-# 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/Types.hsc view
@@ -42,6 +42,7 @@ #mkField PixelFormat, AVPixelFormat #mkField CodecFlags, CodecFlag #mkField CodecID, AVCodecID+#mkField PrivData, (Ptr ()) #hasField AVCodecContext, Width, width #hasField AVCodecContext, Height, height@@ -50,6 +51,7 @@ #hasField AVCodecContext, PixelFormat, pix_fmt #hasField AVCodecContext, CodecFlags, flags #hasField AVCodecContext, CodecID, codec_id+#hasField AVCodecContext, PrivData, priv_data newtype AVStream = AVStream (Ptr ()) deriving (Storable, HasPtr)