diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple + +main = defaultMain diff --git a/hs-ffmpeg.cabal b/hs-ffmpeg.cabal new file mode 100644 --- /dev/null +++ b/hs-ffmpeg.cabal @@ -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 diff --git a/src/Media/FFMpeg.hs b/src/Media/FFMpeg.hs new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg.hs @@ -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 + + diff --git a/src/Media/FFMpeg/Format.hsc b/src/Media/FFMpeg/Format.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Format.hsc @@ -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 + + + diff --git a/src/Media/FFMpeg/Internals.hsc b/src/Media/FFMpeg/Internals.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals.hsc @@ -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) + diff --git a/src/Media/FFMpeg/Internals/AVCodec.hsc b/src/Media/FFMpeg/Internals/AVCodec.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals/AVCodec.hsc @@ -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}) diff --git a/src/Media/FFMpeg/Internals/AVFormat.hsc b/src/Media/FFMpeg/Internals/AVFormat.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals/AVFormat.hsc @@ -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 diff --git a/src/Media/FFMpeg/Internals/SWScale.hsc b/src/Media/FFMpeg/Internals/SWScale.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals/SWScale.hsc @@ -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 () + diff --git a/src/Media/FFMpeg/Internals/Types.hsc b/src/Media/FFMpeg/Internals/Types.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals/Types.hsc @@ -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 () diff --git a/src/Media/FFMpeg/Internals/Utils.hsc b/src/Media/FFMpeg/Internals/Utils.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals/Utils.hsc @@ -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 diff --git a/src/Media/FFMpeg/Internals/_c_utils.c b/src/Media/FFMpeg/Internals/_c_utils.c new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Internals/_c_utils.c @@ -0,0 +1,6 @@ + + +#include + +void b_free_packet (AVPacket* pkt){ av_free_packet (pkt);} + diff --git a/src/Media/FFMpeg/Scale.hs b/src/Media/FFMpeg/Scale.hs new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Scale.hs @@ -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 diff --git a/src/Media/FFMpeg/Types.hsc b/src/Media/FFMpeg/Types.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Types.hsc @@ -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 + diff --git a/src/Media/FFMpeg/Version.hsc b/src/Media/FFMpeg/Version.hsc new file mode 100644 --- /dev/null +++ b/src/Media/FFMpeg/Version.hsc @@ -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 = [] + } diff --git a/src/macros.hsc2hs.h b/src/macros.hsc2hs.h new file mode 100644 --- /dev/null +++ b/src/macros.hsc2hs.h @@ -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)