AVFormat.hsc

-- -*- 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