packages feed

hs-ffmpeg (empty) → 0.2.3

raw patch · 15 files changed

+1208/−0 lines, 15 filesdep +basedep +haskell98setup-changed

Dependencies added: base, haskell98

Files

+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMain
+ hs-ffmpeg.cabal view
@@ -0,0 +1,36 @@+name:           hs-ffmpeg+version:        0.2.3+cabal-version:  >= 1.6+license:        BSD3+author:         Vasyl Pasternak+synopsis:       Bindings to FFMPEG library+maintainer:     vasylpasternak@gmail.com+description:    Bindings to FFMPEG library+copyright:      (c) 2009 Vasyl Pasternak+stability:      alpha+category:       Media++build-type:     Simple+extra-source-files: src/macros.hsc2hs.h++library+        build-depends:   base < 4, haskell98+        hs-source-dirs:  src+        include-dirs:    /usr/local/include+                         src+        exposed-modules: Media.FFMpeg+                         Media.FFMpeg.Types+                         Media.FFMpeg.Format+                         Media.FFMpeg.Version+                         Media.FFMpeg.Scale+        other-modules:   Media.FFMpeg.Internals+                         Media.FFMpeg.Internals.Types+                         Media.FFMpeg.Internals.Utils+                         Media.FFMpeg.Internals.AVFormat+                         Media.FFMpeg.Internals.AVCodec+                         Media.FFMpeg.Internals.SWScale+        c-sources:       src/Media/FFMpeg/Internals/_c_utils.c+        extra-lib-dirs:  /usr/local/lib+        extra-libraries: avformat, avcodec, avutil, avfilter,+                         avdevice, swscale, vorbisfile, vorbis, vorbisenc, +                         theora, mp3lame, faac, z, dc1394_control
+ src/Media/FFMpeg.hs view
@@ -0,0 +1,16 @@+-- -*- haskell -*-+{- | Module 'Media.FFMpeg' - an interface to 'ffmpeg' library+  +  (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg+    (+     module Media.FFMpeg.Version+    ,module Media.FFMpeg.Format+    ) where++import Media.FFMpeg.Version+import Media.FFMpeg.Format++
+ src/Media/FFMpeg/Format.hsc view
@@ -0,0 +1,31 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}++{- |Module 'Media.FFMpeg.Format' implements bindings to AVFormat library++   (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg.Format +    (+     registerAll+    ,withFFMpeg+    ,module Media.FFMpeg.Internals+    ) where++import Foreign+import Foreign.C.String+import Media.FFMpeg.Internals+import Text.Printf++#include "libavformat/avformat.h"++-- | import defines+foreign import ccall "av_register_all" registerAll :: IO ()+++withFFMpeg :: IO a -> IO a+withFFMpeg clos = registerAll >> clos+++
+ src/Media/FFMpeg/Internals.hsc view
@@ -0,0 +1,20 @@+-- -*- haskell -*-++{- |The module 'Media.FFMpeg.Internals' implements helpers and+   internal data representaion for the rest of 'hs-ffmpeg' library+   +   (c) 2009 Vasyl Pasternak+ -}+module Media.FFMpeg.Internals +    (+     module Media.FFMpeg.Internals.Types+    ,module Media.FFMpeg.Internals.Utils+    ,module Media.FFMpeg.Internals.AVFormat+    ,module Media.FFMpeg.Internals.AVCodec+    ) where++import Media.FFMpeg.Internals.Types+import Media.FFMpeg.Internals.Utils+import Media.FFMpeg.Internals.AVFormat+import Media.FFMpeg.Internals.AVCodec hiding (toCodecContext)+
+ src/Media/FFMpeg/Internals/AVCodec.hsc view
@@ -0,0 +1,541 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}++{- | Module 'Media.FFMpeg.Internals.AVFormat' implements +   avformat header (its structures and datatypes) along with +   getters and setters to work with them+   +   (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg.Internals.AVCodec+    (+     -- Enumerations+     CodecType (..)+    ,CodecId (..)+     +    ,WithCodecType (..)+    ,WithCodecId (..)+    ,WithVideoProps (..)++    -- CodecContext +    ,CodecContext+    ,withCodecContext+    ,toCodecContext+    ,openCodec+    ,decodeVideo+     +    -- Codec+    ,Codec +    ,withCodec+    ,findDecoder+     +    -- Frame+    ,Frame+    ,withFrame+    ,allocFrame++    -- Picture+    ,CommonPicture (..)+    ,pictureGetSize++    -- Packet+    ,Packet+    ,withPacket+    ,allocPacket+    ,cleanPacket+    ,getStreamIndex+    )where++import Foreign+import Foreign.C.String+import Control.Monad (liftM)+import Text.Printf+import Media.FFMpeg.Internals.Types+import Media.FFMpeg.Internals.Utils++#include "libavcodec/avcodec.h"+#include "macros.hsc2hs.h"+++-- |Different enumerations+-- |CodecType+#{begin_enum CodecType, CODEC_TYPE_UNKNOWN}+#{add_enum CODEC_TYPE_VIDEO}+#{add_enum CODEC_TYPE_AUDIO}+#{add_enum CODEC_TYPE_DATA}+#{add_enum CODEC_TYPE_SUBTITLE}+#{add_enum CODEC_TYPE_ATTACHMENT}+#{add_enum CODEC_TYPE_NB}+#{end_enum "Eq,Ord,Show"}++-- | CodecId+#{begin_enum CodecId, CODEC_ID_NONE}+#{add_enum CODEC_ID_MPEG1VIDEO}+#{add_enum CODEC_ID_MPEG2VIDEO}+#{add_enum CODEC_ID_MPEG2VIDEO_XVMC}+#{add_enum CODEC_ID_H261}+#{add_enum CODEC_ID_H263}+#{add_enum CODEC_ID_RV10}+#{add_enum CODEC_ID_RV20}+#{add_enum CODEC_ID_MJPEG}+#{add_enum CODEC_ID_MJPEGB}+#{add_enum CODEC_ID_LJPEG}+#{add_enum CODEC_ID_SP5X}+#{add_enum CODEC_ID_JPEGLS}+#{add_enum CODEC_ID_MPEG4}+#{add_enum CODEC_ID_RAWVIDEO}+#{add_enum CODEC_ID_MSMPEG4V1}+#{add_enum CODEC_ID_MSMPEG4V2}+#{add_enum CODEC_ID_MSMPEG4V3}+#{add_enum CODEC_ID_WMV1}+#{add_enum CODEC_ID_WMV2}+#{add_enum CODEC_ID_H263P}+#{add_enum CODEC_ID_H263I}+#{add_enum CODEC_ID_FLV1}+#{add_enum CODEC_ID_SVQ1}+#{add_enum CODEC_ID_SVQ3}+#{add_enum CODEC_ID_DVVIDEO}+#{add_enum CODEC_ID_HUFFYUV}+#{add_enum CODEC_ID_CYUV}+#{add_enum CODEC_ID_H264}+#{add_enum CODEC_ID_INDEO3}+#{add_enum CODEC_ID_VP3}+#{add_enum CODEC_ID_THEORA}+#{add_enum CODEC_ID_ASV1}+#{add_enum CODEC_ID_ASV2}+#{add_enum CODEC_ID_FFV1}+#{add_enum CODEC_ID_4XM}+#{add_enum CODEC_ID_VCR1}+#{add_enum CODEC_ID_CLJR}+#{add_enum CODEC_ID_MDEC}+#{add_enum CODEC_ID_ROQ}+#{add_enum CODEC_ID_INTERPLAY_VIDEO}+#{add_enum CODEC_ID_XAN_WC3}+#{add_enum CODEC_ID_XAN_WC4}+#{add_enum CODEC_ID_RPZA}+#{add_enum CODEC_ID_CINEPAK}+#{add_enum CODEC_ID_WS_VQA}+#{add_enum CODEC_ID_MSRLE}+#{add_enum CODEC_ID_MSVIDEO1}+#{add_enum CODEC_ID_IDCIN}+#{add_enum CODEC_ID_8BPS}+#{add_enum CODEC_ID_SMC}+#{add_enum CODEC_ID_FLIC}+#{add_enum CODEC_ID_TRUEMOTION1}+#{add_enum CODEC_ID_VMDVIDEO}+#{add_enum CODEC_ID_MSZH}+#{add_enum CODEC_ID_ZLIB}+#{add_enum CODEC_ID_QTRLE}+#{add_enum CODEC_ID_SNOW}+#{add_enum CODEC_ID_TSCC}+#{add_enum CODEC_ID_ULTI}+#{add_enum CODEC_ID_QDRAW}+#{add_enum CODEC_ID_VIXL}+#{add_enum CODEC_ID_QPEG}+#{add_enum CODEC_ID_XVID}+#{add_enum CODEC_ID_PNG}+#{add_enum CODEC_ID_PPM}+#{add_enum CODEC_ID_PBM}+#{add_enum CODEC_ID_PGM}+#{add_enum CODEC_ID_PGMYUV}+#{add_enum CODEC_ID_PAM}+#{add_enum CODEC_ID_FFVHUFF}+#{add_enum CODEC_ID_RV30}+#{add_enum CODEC_ID_RV40}+#{add_enum CODEC_ID_VC1}+#{add_enum CODEC_ID_WMV3}+#{add_enum CODEC_ID_LOCO}+#{add_enum CODEC_ID_WNV1}+#{add_enum CODEC_ID_AASC}+#{add_enum CODEC_ID_INDEO2}+#{add_enum CODEC_ID_FRAPS}+#{add_enum CODEC_ID_TRUEMOTION2}+#{add_enum CODEC_ID_BMP}+#{add_enum CODEC_ID_CSCD}+#{add_enum CODEC_ID_MMVIDEO}+#{add_enum CODEC_ID_ZMBV}+#{add_enum CODEC_ID_AVS}+#{add_enum CODEC_ID_SMACKVIDEO}+#{add_enum CODEC_ID_NUV}+#{add_enum CODEC_ID_KMVC}+#{add_enum CODEC_ID_FLASHSV}+#{add_enum CODEC_ID_CAVS}+#{add_enum CODEC_ID_JPEG2000}+#{add_enum CODEC_ID_VMNC}+#{add_enum CODEC_ID_VP5}+#{add_enum CODEC_ID_VP6}+#{add_enum CODEC_ID_VP6F}+#{add_enum CODEC_ID_TARGA}+#{add_enum CODEC_ID_DSICINVIDEO}+#{add_enum CODEC_ID_TIERTEXSEQVIDEO}+#{add_enum CODEC_ID_TIFF}+#{add_enum CODEC_ID_GIF}+#{add_enum CODEC_ID_FFH264}+#{add_enum CODEC_ID_DXA}+#{add_enum CODEC_ID_DNXHD}+#{add_enum CODEC_ID_THP}+#{add_enum CODEC_ID_SGI}+#{add_enum CODEC_ID_C93}+#{add_enum CODEC_ID_BETHSOFTVID}+#{add_enum CODEC_ID_PTX}+#{add_enum CODEC_ID_TXD}+#{add_enum CODEC_ID_VP6A}+#{add_enum CODEC_ID_AMV}+#{add_enum CODEC_ID_VB}+#{add_enum CODEC_ID_PCX}+#{add_enum CODEC_ID_SUNRAST}+#{add_enum CODEC_ID_INDEO4}+#{add_enum CODEC_ID_INDEO5}+#{add_enum CODEC_ID_MIMIC}+#{add_enum CODEC_ID_RL2}+#{add_enum CODEC_ID_8SVX_EXP}+#{add_enum CODEC_ID_8SVX_FIB}+#{add_enum CODEC_ID_ESCAPE124}+#{add_enum CODEC_ID_DIRAC}+#{add_enum CODEC_ID_BFI}+#{add_enum CODEC_ID_CMV}+#{add_enum CODEC_ID_MOTIONPIXELS}+#{add_enum CODEC_ID_TGV}+#{add_enum CODEC_ID_TGQ}+#{add_enum CODEC_ID_TQI}+#{add_enum CODEC_ID_AURA}+#{add_enum CODEC_ID_AURA2}+#{add_enum CODEC_ID_PCM_S16LE}+#{add_enum CODEC_ID_PCM_S16BE}+#{add_enum CODEC_ID_PCM_U16LE}+#{add_enum CODEC_ID_PCM_U16BE}+#{add_enum CODEC_ID_PCM_S8}+#{add_enum CODEC_ID_PCM_U8}+#{add_enum CODEC_ID_PCM_MULAW}+#{add_enum CODEC_ID_PCM_ALAW}+#{add_enum CODEC_ID_PCM_S32LE}+#{add_enum CODEC_ID_PCM_S32BE}+#{add_enum CODEC_ID_PCM_U32LE}+#{add_enum CODEC_ID_PCM_U32BE}+#{add_enum CODEC_ID_PCM_S24LE}+#{add_enum CODEC_ID_PCM_S24BE}+#{add_enum CODEC_ID_PCM_U24LE}+#{add_enum CODEC_ID_PCM_U24BE}+#{add_enum CODEC_ID_PCM_S24DAUD}+#{add_enum CODEC_ID_PCM_ZORK}+#{add_enum CODEC_ID_PCM_S16LE_PLANAR}+#{add_enum CODEC_ID_PCM_DVD}+#{add_enum CODEC_ID_PCM_F32BE}+#{add_enum CODEC_ID_PCM_F32LE}+#{add_enum CODEC_ID_PCM_F64BE}+#{add_enum CODEC_ID_PCM_F64LE}+#{add_enum CODEC_ID_ADPCM_IMA_QT}+#{add_enum CODEC_ID_ADPCM_IMA_WAV}+#{add_enum CODEC_ID_ADPCM_IMA_DK3}+#{add_enum CODEC_ID_ADPCM_IMA_DK4}+#{add_enum CODEC_ID_ADPCM_IMA_WS}+#{add_enum CODEC_ID_ADPCM_IMA_SMJPEG}+#{add_enum CODEC_ID_ADPCM_MS}+#{add_enum CODEC_ID_ADPCM_4XM}+#{add_enum CODEC_ID_ADPCM_XA}+#{add_enum CODEC_ID_ADPCM_ADX}+#{add_enum CODEC_ID_ADPCM_EA}+#{add_enum CODEC_ID_ADPCM_G726}+#{add_enum CODEC_ID_ADPCM_CT}+#{add_enum CODEC_ID_ADPCM_SWF}+#{add_enum CODEC_ID_ADPCM_YAMAHA}+#{add_enum CODEC_ID_ADPCM_SBPRO_4}+#{add_enum CODEC_ID_ADPCM_SBPRO_3}+#{add_enum CODEC_ID_ADPCM_SBPRO_2}+#{add_enum CODEC_ID_ADPCM_THP}+#{add_enum CODEC_ID_ADPCM_IMA_AMV}+#{add_enum CODEC_ID_ADPCM_EA_R1}+#{add_enum CODEC_ID_ADPCM_EA_R3}+#{add_enum CODEC_ID_ADPCM_EA_R2}+#{add_enum CODEC_ID_ADPCM_IMA_EA_SEAD}+#{add_enum CODEC_ID_ADPCM_IMA_EA_EACS}+#{add_enum CODEC_ID_ADPCM_EA_XAS}+#{add_enum CODEC_ID_ADPCM_EA_MAXIS_XA}+#{add_enum CODEC_ID_ADPCM_IMA_ISS}+#{add_enum CODEC_ID_AMR_NB}+#{add_enum CODEC_ID_AMR_WB}+#{add_enum CODEC_ID_RA_144}+#{add_enum CODEC_ID_RA_288}+#{add_enum CODEC_ID_ROQ_DPCM}+#{add_enum CODEC_ID_INTERPLAY_DPCM}+#{add_enum CODEC_ID_XAN_DPCM}+#{add_enum CODEC_ID_SOL_DPCM}+#{add_enum CODEC_ID_MP2}+#{add_enum CODEC_ID_MP3}+#{add_enum CODEC_ID_AAC}+#{add_enum CODEC_ID_AC3}+#{add_enum CODEC_ID_DTS}+#{add_enum CODEC_ID_VORBIS}+#{add_enum CODEC_ID_DVAUDIO}+#{add_enum CODEC_ID_WMAV1}+#{add_enum CODEC_ID_WMAV2}+#{add_enum CODEC_ID_MACE3}+#{add_enum CODEC_ID_MACE6}+#{add_enum CODEC_ID_VMDAUDIO}+#{add_enum CODEC_ID_SONIC}+#{add_enum CODEC_ID_SONIC_LS}+#{add_enum CODEC_ID_FLAC}+#{add_enum CODEC_ID_MP3ADU}+#{add_enum CODEC_ID_MP3ON4}+#{add_enum CODEC_ID_SHORTEN}+#{add_enum CODEC_ID_ALAC}+#{add_enum CODEC_ID_WESTWOOD_SND1}+#{add_enum CODEC_ID_GSM}+#{add_enum CODEC_ID_QDM2}+#{add_enum CODEC_ID_COOK}+#{add_enum CODEC_ID_TRUESPEECH}+#{add_enum CODEC_ID_TTA}+#{add_enum CODEC_ID_SMACKAUDIO}+#{add_enum CODEC_ID_QCELP}+#{add_enum CODEC_ID_WAVPACK}+#{add_enum CODEC_ID_DSICINAUDIO}+#{add_enum CODEC_ID_IMC}+#{add_enum CODEC_ID_MUSEPACK7}+#{add_enum CODEC_ID_MLP}+#{add_enum CODEC_ID_GSM_MS}+#{add_enum CODEC_ID_ATRAC3}+#{add_enum CODEC_ID_VOXWARE}+#{add_enum CODEC_ID_APE}+#{add_enum CODEC_ID_NELLYMOSER}+#{add_enum CODEC_ID_MUSEPACK8}+#{add_enum CODEC_ID_SPEEX}+#{add_enum CODEC_ID_WMAVOICE}+#{add_enum CODEC_ID_WMAPRO}+#{add_enum CODEC_ID_WMALOSSLESS}+#{add_enum CODEC_ID_ATRAC3P}+#{add_enum CODEC_ID_EAC3}+#{add_enum CODEC_ID_SIPR}+#{add_enum CODEC_ID_MP1}+#{add_enum CODEC_ID_TWINVQ}+#{add_enum CODEC_ID_TRUEHD}+#{add_enum CODEC_ID_DVD_SUBTITLE}+#{add_enum CODEC_ID_DVB_SUBTITLE}+#{add_enum CODEC_ID_TEXT}+#{add_enum CODEC_ID_XSUB}+#{add_enum CODEC_ID_SSA}+#{add_enum CODEC_ID_MOV_TEXT}+#{add_enum CODEC_ID_TTF}+#{add_enum CODEC_ID_PROBE}+#{add_enum CODEC_ID_MPEG2TS}+#{end_enum "Eq,Ord,Show"}+++class WithCodecId a where+    getCodecId :: a -> CodecId++class WithCodecType a where+    getCodecType :: a -> CodecType++class WithVideoProps a where+    getVideoWidth :: a -> Int+    getVideoHeight :: a -> Int+    getPixelFormat :: a -> PixelFormat++-- |CodecContext - wrapper to AVCodecContext+newtype CodecContext = CodecContext (ForeignPtr CodecContext)++withCodecContext :: CodecContext -> (Ptr a -> IO b) -> IO b+withCodecContext (CodecContext ctx) clos = withForeignPtr ctx (clos . castPtr)++toCodecContext :: Ptr a -> IO CodecContext+toCodecContext p =  liftM CodecContext $ (newForeignPtr_ . castPtr) p++instance WithCodecId CodecContext where+    getCodecId ctx = +        unsafePerformIO $+        withCodecContext ctx $ \ctx' -> +            do+              val <- #{peek AVCodecContext, codec_id} ctx' :: IO #{type enum CodecID}+              return $ (toEnum . fromIntegral) val++instance WithCodecType CodecContext where+    getCodecType ctx = +        unsafePerformIO $+        withCodecContext ctx $ \ctx' -> +            do+              val <- #{peek AVCodecContext, codec_type} ctx' :: IO #{type enum CodecType}+              return $ (toEnum . fromIntegral) val++instance WithVideoProps CodecContext where+    getVideoWidth ctx = +        unsafePerformIO $+        withCodecContext ctx $ \ctx' ->+            liftM fromIntegral $ (#{peek AVCodecContext, width} ctx'  :: IO #{type int})++    getVideoHeight ctx =+        unsafePerformIO $+        withCodecContext ctx $ \ctx' -> +            liftM fromIntegral $ (#{peek AVCodecContext, height} ctx' :: IO #{type int})++    getPixelFormat ctx = +        unsafePerformIO $ +        withCodecContext ctx $ \ctx' ->+            do+              val <- #{peek AVCodecContext, pix_fmt} ctx' :: IO #{type enum PixelFormat}+              return $ (toEnum . fromIntegral) val++-- |CodecContext function+foreign import ccall "avcodec_open" _open :: VoidP -> VoidP -> IO SInt+foreign import ccall "avcodec_close" _close :: VoidP -> IO ()++openCodec :: CodecContext -> Codec -> IO ()+openCodec ctx@(CodecContext ct) c = +    withCodecContext ctx $ \ctx' ->+        withCodec c $ \c' -> do+          throwIf_ (<0)+                   (printf "openCodec: fails to open codec '%s' - errorcode %d\n" (show $ getCodecId c)) $ _open ctx' c'+          finalizer <- mkFinalizerPtr _close+          addForeignPtrFinalizer finalizer (castForeignPtr ct)+++-- |CodecContext getters/setters++                               ++-- |Codec - implementation of AVCodec+newtype Codec = Codec (Ptr Codec)++withCodec :: Codec -> (Ptr a -> IO b) -> IO b+withCodec (Codec c) clos = clos (castPtr c)+++-- |Codec getters/setters+instance WithCodecId Codec where+    getCodecId ctx = +        unsafePerformIO $+        withCodec ctx $ \ctx' -> +            do+              val <- #{peek AVCodec, id} ctx' :: IO #{type enum CodecID}+              return $ (toEnum . fromIntegral) val++instance WithCodecType Codec where+    getCodecType ctx = +        unsafePerformIO $+        withCodec ctx $ \ctx' -> +            do+              val <- #{peek AVCodec, type} ctx' :: IO #{type enum CodecType}+              return $ (toEnum . fromIntegral) val+++-- |Codec functions++foreign import ccall "avcodec_find_decoder" _find_decoder :: #{type enum CodecID} -> IO VoidP++findDecoder :: CodecId -> IO (Maybe Codec)+findDecoder cid = do+  res <- _find_decoder (fromIntegral $ fromEnum cid)+  if res == nullPtr then return Nothing else return $ Just $ Codec $ castPtr res+++foreign import ccall "avcodec_decode_video2" _decode_video :: +    VoidP -> VoidP -> (Ptr SInt) -> VoidP -> IO SInt++-- | returns True if complete picture is decompressed+decodeVideo :: CodecContext -> Frame -> Packet -> IO Bool+decodeVideo ctx frm pkt = +    withCodecContext ctx $ \ctx' ->+        withFrame frm $ \frm' ->+            withPacket pkt $ \pkt' ->+                alloca $ \gotPic' -> do+                  throwIf (<0)+                          (printf "decodeVideo: failed to decode video packet: %d")+                          (_decode_video ctx' frm' gotPic' pkt')+                  peek gotPic' >>= return . (>0)+++-- |AVFrame implementation+newtype Frame = Frame (ForeignPtr Frame)++withFrame :: Frame -> (Ptr a -> IO b) -> IO b+withFrame (Frame f) clos = withForeignPtr f (clos . castPtr)++foreign import ccall "avcodec_alloc_frame" _alloc_frame :: IO VoidP++allocFrame :: IO Frame+allocFrame = do+  p <- throwIf (== nullPtr)+               (\_ -> "allocFrame: failed to allocate frame")+               _alloc_frame+  finalizer <- mkFinalizerPtr avFree+  newForeignPtr finalizer p >>= return . Frame . castForeignPtr++instance CommonPicture Frame where+    withCPicture = withFrame+++-- |AVPicture +++foreign import ccall "avpicture_fill" _picture_fill ::+    VoidP -> VoidP -> #{type int} -> #{type int} -> #{type int} -> IO #{type int}++type CPicture = VoidP++class CommonPicture a where+    withCPicture :: a -> (CPicture -> IO b) -> IO b++    pictureFill :: a -> Buffer -> PixelFormat -> Int -> Int -> IO ()+    pictureFill pic buff pf w h = +        withCPicture pic $ \pic' ->+            withBuffer buff $ \buff' -> +                _picture_fill pic' (castPtr buff') +                     (fromIntegral $ fromEnum pf)+                     (fromIntegral w)+                     (fromIntegral h) >> return ()+    +    getPictureSlice :: a -> PictureSlice+    getPictureSlice pic =+        unsafePerformIO $+        withCPicture pic $ \pic' ->+            return $ castPtr $ pic' `plusPtr` #{offset AVPicture, data}++    getPictureStride :: a -> PictureStride+    getPictureStride pic = +        unsafePerformIO $+        withCPicture pic $ \pic' ->+            return $ castPtr $ pic' `plusPtr` #{offset AVPicture, linesize}+++-- |Other functions+ +foreign import ccall "avpicture_get_size" _picture_get_size :: +    #{type enum PixelFormat} -> #{type int} -> #{type int} -> IO (#{type int})++pictureGetSize :: PixelFormat -> Int -> Int -> IO Int+pictureGetSize pf w h = do+  liftM fromIntegral $ +        (_picture_get_size ((fromIntegral . fromEnum) pf) (fromIntegral w) (fromIntegral h) :: IO (#{type int}))+ ++-- |AVPacket++newtype Packet = Packet (ForeignPtr Packet)++withPacket :: Packet -> (Ptr a -> IO b) -> IO b+withPacket (Packet p) clos = withForeignPtr p (clos . castPtr)++foreign import ccall "av_init_packet" _init_packet :: VoidP -> IO ()+foreign import ccall "b_free_packet" _free_packet :: VoidP -> IO ()++allocPacket :: IO Packet+allocPacket = do+  p <- mallocBytes #{size AVPacket}+  _init_packet p+  fp <- newForeignPtr finalizerFree p+  deinit <- mkFinalizerPtr _free_packet+  addForeignPtrFinalizer deinit fp +  return $ Packet $ castForeignPtr fp++cleanPacket :: Packet -> IO ()+cleanPacket pkt = withPacket pkt _free_packet+++-- | AVPacket getters/setters++getStreamIndex :: Packet -> Int+getStreamIndex pkt = +    unsafePerformIO $+    withPacket pkt $ \pkt' ->+        liftM fromIntegral $ +              (#{peek AVPacket, stream_index} pkt' :: IO #{type int})
+ src/Media/FFMpeg/Internals/AVFormat.hsc view
@@ -0,0 +1,142 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}++{- | Module 'Media.FFMpeg.Internals.AVFormat' implements +   avformat header (its structures and datatypes) along with +   getters and setters to work with them+   +   (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg.Internals.AVFormat +    (+     -- FormatContext +     FormatContext+    ,withFormatContext+    ,newContext+    ,openInputFile+    ,getStreams+    ,findStreamInfo+    ,dumpFormat++    -- Stream+    ,Stream+    ,withStream+    ,getCodecContext++    -- Other+    ,readFrame+    )where++import Foreign+import Foreign.C.String+import Control.Monad (liftM)+import Text.Printf+import Media.FFMpeg.Internals.Types+import Media.FFMpeg.Internals.Utils+import Media.FFMpeg.Internals.AVCodec++#include "libavformat/avformat.h"+++-- |FormatContext - wrapper to AVFormatContext+newtype FormatContext = FormatContext (ForeignPtr FormatContext)++withFormatContext :: FormatContext -> (Ptr a -> IO b) -> IO b+withFormatContext (FormatContext fmt) clos = withForeignPtr fmt (clos . castPtr)+++-- |Different functions on FormatContext++foreign import ccall "av_find_stream_info" _find_stream_info :: VoidP -> IO SInt++findStreamInfo :: FormatContext -> IO ()+findStreamInfo fmt = +    withFormatContext fmt $ \fmt' -> +        throwIf_ (< 0) (printf "findStreamInfo: failed with error code %d\n") +                     (_find_stream_info fmt')+                 ++foreign import ccall "dump_format" _dump_format :: VoidP -> SInt -> CString -> SInt -> IO ()++dumpFormat :: FormatContext -> String -> IO ()+dumpFormat fmt s =+    withFormatContext fmt $ \fmt' ->+        withCString s $ \s' ->+            _dump_format fmt' 0 s' 0++++-- |Stream -- wrapper to AVStream+newtype Stream = Stream (Ptr Stream)++withStream :: Stream -> (VoidP -> IO a) -> IO a+withStream (Stream s) clos = clos (castPtr s)+++-- |Foreign declarations++foreign import ccall "avformat_alloc_context" _alloc_context :: IO VoidP++foreign import ccall "av_open_input_file" _open_file :: +    Ptr (VoidP) -> CString -> VoidP -> SInt -> VoidP -> IO SInt++foreign import ccall "av_close_input_file" _close_file ::+    Ptr a -> IO ()+++-- |FormatContext functions++-- |Empty context creation+newContext :: IO FormatContext+newContext = do +  p <- throwIf (== nullPtr) +               (\_ -> "allocContext: failed to allocate context") +               _alloc_context+  finalizer <- mkFinalizerPtr avFree+  newForeignPtr finalizer p >>= return . FormatContext . castForeignPtr+  ++-- |Open input file+openInputFile :: String -> IO FormatContext+openInputFile name = +    withCString name $ \s ->+        alloca $ \ (pp :: (Ptr VoidP)) -> do+          throwIf_ (/=0) +                       (printf "openInputFile: fail to open %s - errorcode %d\n" name) $+                       _open_file pp s nullPtr 0 nullPtr+          ptr <- peek pp+          finalizer <- mkFinalizerPtr _close_file+          newForeignPtr finalizer ptr >>= return . FormatContext . castForeignPtr+++-- | FormatContext getters/setters++-- |Get streams from FormatContext. Pure, because it is+-- field of already allocated structure+getStreams :: FormatContext -> [Stream]+getStreams fmt = unsafePerformIO $+                 withFormatContext fmt $ \fmt' -> do+                   count <- liftM fromIntegral $ +                            (#{peek AVFormatContext, nb_streams} fmt' :: IO UInt)+                   let streamList = fmt' `plusPtr` #{offset AVFormatContext, streams} +                   peekArray count streamList >>= return . map Stream +                 ++-- | Stream getters/setters++getCodecContext :: Stream -> Maybe CodecContext+getCodecContext s = unsafePerformIO $+                    withStream s $ \s' -> do+                      p <- #{peek AVStream, codec} s' :: IO VoidP+                      if p == nullPtr then return Nothing else liftM Just $ toCodecContext p++foreign import ccall "av_read_frame" _read_frame :: VoidP -> VoidP -> IO SInt++-- |returns False if error or EOF occured, True otherwise+readFrame :: FormatContext -> Packet -> IO Bool+readFrame ctx pkt = +    withFormatContext ctx $ \ctx' ->+        withPacket pkt $ \pkt' -> do+          ret <- _read_frame ctx' pkt'+          return $ ret >= 0
+ src/Media/FFMpeg/Internals/SWScale.hsc view
@@ -0,0 +1,87 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}++{- | Module 'Media.FFMpeg.Internals.SWScale' implements +   swscale header (its structures and datatypes) along with +   getters and setters to work with them+   +   (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg.Internals.SWScale+    (+    -- Enumerations+    ScaleAlgorithm (..)++    -- Context+    ,Context+    ,getContext+    ,scale+    ) where++import Foreign+import Foreign.C.String+import Control.Monad (liftM)+import Text.Printf+import Media.FFMpeg.Internals.Types+import Media.FFMpeg.Internals.Utils++#include "libswscale/swscale.h"+#include "macros.hsc2hs.h"+++-- |Enumerations+#{begin_enum ScaleAlgorithm, SWS_FAST_BILINEAR}+#{add_enum SWS_BICUBIC}+#{add_enum SWS_X}+#{add_enum SWS_POINT}+#{add_enum SWS_AREA}+#{add_enum SWS_BICUBLIN}+#{add_enum SWS_GAUSS}+#{add_enum SWS_SINC}+#{add_enum SWS_LANCZOS}+#{add_enum SWS_SPLINE}+#{end_enum "Eq,Ord,Show"}++-- |SwsContext++newtype Context = Context (ForeignPtr Context)++withContext :: Context -> (Ptr a -> IO b) -> IO b+withContext (Context ctx) clos = withForeignPtr ctx (clos . castPtr)++foreign import ccall "sws_freeContext" _free_context :: VoidP -> IO ()++foreign import ccall "sws_getContext" _get_context :: +    SInt -> SInt -> #{type enum PixelFormat} -> +    SInt -> SInt -> #{type enum PixelFormat} ->+    SInt -> VoidP -> VoidP -> VoidP -> IO VoidP++combineBitMasks :: (Enum a, Bits b) => [a] -> b+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)++getContext :: (Int, Int, PixelFormat) ->+              (Int, Int, PixelFormat) ->+              [ScaleAlgorithm] -> IO Context+getContext (srcW, srcH, srcPf) (dstW, dstH, dstPf) flags = do+  ret <- throwIf (== nullPtr) +         (\_ -> "getContext: failed to create SWScale context") $+         _get_context (fromIntegral srcW) (fromIntegral srcH) (fromIntegral $ fromEnum srcPf)+              (fromIntegral dstW) (fromIntegral dstH) (fromIntegral $ fromEnum dstPf) +              (combineBitMasks flags) nullPtr nullPtr nullPtr +  finalizer <- mkFinalizerPtr _free_context+  newForeignPtr finalizer ret >>= return . Context . castForeignPtr++foreign import ccall "sws_scale" _sws_scale ::+    VoidP -> VoidP -> VoidP -> SInt -> SInt -> VoidP -> VoidP -> IO SInt++scale :: Context -> PictureSlice -> PictureStride -> Int -> Int -> +         PictureSlice -> PictureStride -> IO ()+scale ctx srcSlice srcStride srcSliceY srcSliceH dstSlice dstStride = +    withContext ctx $ \ctx' -> +        _sws_scale ctx' srcSlice srcStride +             (fromIntegral srcSliceY) +             (fromIntegral srcSliceH) +             dstSlice dstStride >> +         return ()+
+ src/Media/FFMpeg/Internals/Types.hsc view
@@ -0,0 +1,25 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface #-}++{- |The 'Media.FFMpeg.Internals.Types' module defines types and +   structures from the ffmpeg library+   +   (c) 2009 Vasyl Pasternak+ -}+module Media.FFMpeg.Internals.Types+    (+     UInt+    ,VoidP+    ,SInt+    ,PictureSlice+    ,PictureStride+    ) where++import Foreign++type UInt = #{type unsigned int}+type SInt = #{type int}+type VoidP = Ptr ()++type PictureSlice = Ptr ()+type PictureStride = Ptr ()
+ src/Media/FFMpeg/Internals/Utils.hsc view
@@ -0,0 +1,126 @@+-- -*- haskell -*- +{-# LANGUAGE ForeignFunctionInterface #-}++{- | Module 'Media.FFMpeg.Internals.Utils' implements +   utility functions from libAVUtil library+   +   (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg.Internals.Utils +    (+     PixelFormat (..)+    ,avMalloc+    ,avFree+    ,mkFinalizerPtr++    -- Buffer datatype+    ,Buffer+    ,withBuffer+    ,allocBuffer+    ,makeBuffer+    )where++import Foreign+import Media.FFMpeg.Internals.Types++#include "libavutil/avutil.h"+#include "macros.hsc2hs.h"++-- |PixelFormat enumeration+#{begin_enum PixelFormat, PIX_FMT_NONE}+#{add_enum PIX_FMT_YUV420P}+#{add_enum PIX_FMT_YUYV422}+#{add_enum PIX_FMT_RGB24}+#{add_enum PIX_FMT_BGR24}+#{add_enum PIX_FMT_YUV422P}+#{add_enum PIX_FMT_YUV444P}+#{add_enum PIX_FMT_YUV410P}+#{add_enum PIX_FMT_YUV411P}+#{add_enum PIX_FMT_GRAY8}+#{add_enum PIX_FMT_MONOWHITE}+#{add_enum PIX_FMT_MONOBLACK}+#{add_enum PIX_FMT_PAL8}+#{add_enum PIX_FMT_YUVJ420P}+#{add_enum PIX_FMT_YUVJ422P}+#{add_enum PIX_FMT_YUVJ444P}+#{add_enum PIX_FMT_XVMC_MPEG2_MC}+#{add_enum PIX_FMT_XVMC_MPEG2_IDCT}+#{add_enum PIX_FMT_UYVY422}+#{add_enum PIX_FMT_UYYVYY411}+#{add_enum PIX_FMT_BGR8}+#{add_enum PIX_FMT_BGR4}+#{add_enum PIX_FMT_BGR4_BYTE}+#{add_enum PIX_FMT_RGB8}+#{add_enum PIX_FMT_RGB4}+#{add_enum PIX_FMT_RGB4_BYTE}+#{add_enum PIX_FMT_NV12}+#{add_enum PIX_FMT_NV21}+#{add_enum PIX_FMT_ARGB}+#{add_enum PIX_FMT_RGBA}+#{add_enum PIX_FMT_ABGR}+#{add_enum PIX_FMT_BGRA}+#{add_enum PIX_FMT_GRAY16BE}+#{add_enum PIX_FMT_GRAY16LE}+#{add_enum PIX_FMT_YUV440P}+#{add_enum PIX_FMT_YUVJ440P}+#{add_enum PIX_FMT_YUVA420P}+#{add_enum PIX_FMT_VDPAU_H264}+#{add_enum PIX_FMT_VDPAU_MPEG1}+#{add_enum PIX_FMT_VDPAU_MPEG2}+#{add_enum PIX_FMT_VDPAU_WMV3}+#{add_enum PIX_FMT_VDPAU_VC1}+#{add_enum PIX_FMT_RGB48BE}+#{add_enum PIX_FMT_RGB48LE}+#{add_enum PIX_FMT_RGB565BE}+#{add_enum PIX_FMT_RGB565LE}+#{add_enum PIX_FMT_RGB555BE}+#{add_enum PIX_FMT_RGB555LE}+#{add_enum PIX_FMT_BGR565BE}+#{add_enum PIX_FMT_BGR565LE}+#{add_enum PIX_FMT_BGR555BE}+#{add_enum PIX_FMT_BGR555LE}+#{add_enum PIX_FMT_VAAPI_MOCO}+#{add_enum PIX_FMT_VAAPI_IDCT}+#{add_enum PIX_FMT_VAAPI_VLD}+#{add_enum PIX_FMT_NB}+#{add_enum PIX_FMT_RGB32}+#{add_enum PIX_FMT_RGB32_1}+#{add_enum PIX_FMT_BGR32}+#{add_enum PIX_FMT_BGR32_1}+#{add_enum PIX_FMT_GRAY16}+#{add_enum PIX_FMT_RGB48}+#{add_enum PIX_FMT_RGB565}+#{add_enum PIX_FMT_RGB555}+#{add_enum PIX_FMT_BGR565}+#{add_enum PIX_FMT_BGR555}+#{end_enum "Eq, Ord, Show"}++foreign import ccall "av_malloc" _malloc :: UInt -> IO VoidP+foreign import ccall "av_free" avFree :: Ptr a -> IO ()++avMalloc :: Integral a => a -> IO (Maybe VoidP)+avMalloc a = do +  ptr <- _malloc (fromIntegral a)+  return $ if ptr == nullPtr then Nothing else Just ptr ++foreign import ccall "wrapper" mkFinalizerPtr :: +    (Ptr a -> IO ()) -> IO (FunPtr (Ptr a -> IO ()))+++-- |Buffer type. +newtype Buffer = Buffer (ForeignPtr Buffer)++withBuffer :: Buffer -> (Ptr a -> IO b) -> IO b+withBuffer (Buffer b) clos = withForeignPtr b (clos . castPtr)++allocBuffer :: Int -> IO Buffer+allocBuffer size = do+  p <- throwIf (== nullPtr)+               (\_ -> "allocBuffer: failed to allocate buffer")+               (_malloc (fromIntegral size))+  finalizer <- mkFinalizerPtr avFree+  newForeignPtr finalizer p >>= return . Buffer . castForeignPtr++makeBuffer :: Ptr a -> IO Buffer+makeBuffer p = newForeignPtr_ p >>= return . Buffer . castForeignPtr
+ src/Media/FFMpeg/Internals/_c_utils.c view
@@ -0,0 +1,6 @@+++#include <libavcodec/avcodec.h>++void b_free_packet (AVPacket* pkt){ av_free_packet (pkt);}+
+ src/Media/FFMpeg/Scale.hs view
@@ -0,0 +1,14 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}++{- |Module 'Media.FFMpeg.Scale' implements bindings to SWScale library++   (c) 2009 Vasyl Pasternak+ -}++module Media.FFMpeg.Scale +    (+     module Media.FFMpeg.Internals.SWScale+    ) where++import Media.FFMpeg.Internals.SWScale
+ src/Media/FFMpeg/Types.hsc view
@@ -0,0 +1,12 @@+-- -*- haskell -*-++{- |Module 'Media.FFMpeg.Types' defines common types of the ffmpeg library+ -}++module Media.FFMpeg.Types +    (+    ) where++import Media.FFMpeg.Internals+import Foreign+
+ src/Media/FFMpeg/Version.hsc view
@@ -0,0 +1,46 @@+-- -*- haskell -*-+{-# LANGUAGE ForeignFunctionInterface #-}++{- |'Media.FFMpeg.Version' - FFMpeg version information -}++module Media.FFMpeg.Version+    (+     libAVCodecVersion+    ,libAVFormatVersion+    ) where++#include "libavformat/avformat.h"+#include "libavcodec/avcodec.h"+#include "libswscale/swscale.h"++import Data.Version++libAVFormatVersion :: Version+libAVFormatVersion = Version {+                       versionBranch = [+                        #{const LIBAVFORMAT_VERSION_MAJOR},+                        #{const LIBAVFORMAT_VERSION_MINOR},+                        #{const LIBAVFORMAT_VERSION_MICRO}+                       ],+                       versionTags = []+                     }++libAVCodecVersion :: Version+libAVCodecVersion = Version {+                      versionBranch = [+                       #{const LIBAVCODEC_VERSION_MAJOR},+                       #{const LIBAVCODEC_VERSION_MINOR},+                       #{const LIBAVCODEC_VERSION_MICRO}+                      ],+                      versionTags = []+                    }++libSWScaleVersion :: Version+libSWScaleVersion = Version {+                      versionBranch = [+                       #{const LIBSWSCALE_VERSION_MAJOR},+                       #{const LIBSWSCALE_VERSION_MINOR},+                       #{const LIBSWSCALE_VERSION_MICRO}+                      ],+                      versionTags = []+                    }
+ src/macros.hsc2hs.h view
@@ -0,0 +1,101 @@++/*+  Helper macros+ */++#define hsc_test(name) \+  printf("%s = undefined\n", #name);++#define hsc_enum2(t, f, print_name, x)         \+    print_name;                               \+    printf (" :: %s\n", #t);                  \+    print_name;                               \+    printf (" = %s ", #f);                    \+    if ((x) < 0)                              \+        printf ("(%ld)\n", (long)(x));        \+    else                                      \+        printf ("%lu\n", (unsigned long)(x));++#define hsc_haskellizef(x)                                          \+    do{                                                              \+        const char *s = (x);                                       \+        int upper = 0;                                             \+        if (*s != '\0')                                            \+        {                                                          \+            putchar (tolower (*s));                                \+            ++s;                                                   \+            while (*s != '\0')                                     \+            {                                                      \+                if (*s == '_')                                     \+                    upper = 1;                                     \+                else                                               \+                {                                                  \+                    putchar (upper ? toupper (*s) : tolower (*s)); \+                    upper = 0;                                     \+                }                                                  \+                ++s;                                               \+            }                                                      \+        }                                                          \+    }while(0)++#define hsc_haskellizet(x)                                         \+    do{                                                              \+        const char *s = (x);                                       \+        int upper = 1;                                             \+        if (*s != '\0')                                            \+        {                                                          \+            while (*s != '\0')                                     \+            {                                                      \+                if (*s == '_')                                     \+                    upper = 1;                                     \+                else                                               \+                {                                                  \+                    putchar (upper ? toupper (*s) : tolower (*s)); \+                    upper = 0;                                     \+                }                                                  \+                ++s;                                               \+            }                                                      \+        }                                                          \+    }while(0)+++#define hsc_begin_enum(type, val)                   \+  do                                                \+    {                                               \+      printf("data %s = \n", #type);                \+      char enum_type[255];                          \+      strcpy(enum_type, #type);                     \+      char enum_buffer[500][255];                   \+      long enum_vals[255];                          \+      int e = 0;                                    \+      printf("\t ");                                 \+      hsc_haskellizet(#val);                        \+      printf("\n");                                 \+      strcpy(enum_buffer[e], #val);                 \+      enum_vals[e++] = (long)val;+      +#define hsc_add_enum(val)                       \+  printf("\t|");                                \+  hsc_haskellizet(#val);                        \+  printf("\n");                                 \+  strcpy(enum_buffer[e], #val);                 \+  enum_vals[e++] = (long)val;++#define hsc_end_enum(deriving)                  \+  if(deriving[0] != 0){                         \+    printf(" deriving (%s)\n\n", deriving);         \+  }                                             \+  printf("instance Enum %s where\n", enum_type);    \+  int i;                                            \+  for(i = 0; i < e; ++i){                       \+    printf("\tfromEnum ");                      \+    hsc_haskellizet(enum_buffer[i]);             \+    printf(" = (%ld)\n", enum_vals[i]);             \+  }                                                 \+  for(i = 0; i < e; ++i){                       \+    printf("\ttoEnum (%ld) = ", enum_vals[i]);  \+    hsc_haskellizet(enum_buffer[i]);                                \+    printf("\n");                                                   \+  }                                                                 \+  printf("\ttoEnum id = error $ \"toEnum: fail to cast\" ++ (show id) ++ \"to %s\"\n", enum_type); \+  }while(0)