{-# LINE 1 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
-- | Helpers for dumping information about codecs to stdout.
{-# LINE 2 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
module Codec.FFmpeg.Internal.Debug where
import Codec.FFmpeg.Enums
import Codec.FFmpeg.Types
import Control.Monad (when, (>=>))
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Array (advancePtr)
import Foreign.Ptr (nullPtr)
import Foreign.Storable


{-# LINE 13 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}

{-# LINE 14 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}

-- | FFmpeg's built-in format debug utlity.
foreign import ccall "av_dump_format"
  av_dump_format :: AVFormatContext -> CInt -> CString -> CInt -> IO ()

-- | Print the short name, long name, and ID of a codec.
debugCodec :: AVCodec -> IO ()
debugCodec cod = do
  longName <- getLongName cod >>= peekCString
  shortName <- getName cod >>= peekCString
  cid <- getCodecID cod
  putStrLn $ "Codec short_name = " ++ show shortName
  putStrLn $ "Codec long_name = " ++ show longName
  putStrLn $ "Codec ID = " ++ show cid

-- | Print various codec settings.
debugCodecContext :: AVCodecContext -> IO()
debugCodecContext (AVCodecContext p) = do
  putStrLn "*** AVCodecContext dump:"
  ((\hsc_ptr -> peekByteOff hsc_ptr 948)) p >>= si "profile"
{-# LINE 34 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 112)) p >>= si "flags"
{-# LINE 35 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 116)) p >>= si "flags2"
{-# LINE 36 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 164)) p >>= si "gop_size"
{-# LINE 37 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 96)) p >>= si "bit_rate"
{-# LINE 38 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 192)) p >>= si "max_b_frames"
{-# LINE 39 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 204)) p >>= si "b_frame_strategy"
{-# LINE 40 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 564)) p >>= si "qmin"
{-# LINE 41 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 568)) p >>= si "qmax"
{-# LINE 42 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 272)) p >>= si "me_cmp"
{-# LINE 43 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 316)) p >>= si "me_range"
{-# LINE 44 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  putStrLn ""
  where si msg = putStrLn . ((msg++" = ")++) . show :: CInt -> IO ()

foreign import ccall "av_get_pix_fmt_name"
  av_get_pix_fmt_name :: AVPixelFormat -> IO CString

pixFmtName :: AVPixelFormat -> IO String
pixFmtName = av_get_pix_fmt_name >=> peekCString

-- | Print all pixel formats supported by a given 'AVCodec'.
debugPixelFormats :: AVCodec -> IO ()
debugPixelFormats cod = putStrLn "Supported pixel formats:" >>
                        getPixelFormats cod >>= go 0
  where go i fmts
          = let ptr = advancePtr fmts i
            in when (ptr /= nullPtr) $ do
                 fmt <- peek ptr
                 when (fmt /= avPixFmtNone) $ do
                   av_get_pix_fmt_name fmt >>= peekCString >>=
                     putStrLn .  ("  " ++)
                   go (i+1) fmts

foreign import ccall "avcodec_get_name"
  avcodec_get_name :: AVCodecID -> IO CString

-- | Get the name of a codec.
debugCodecName :: AVCodecID -> IO String
debugCodecName = avcodec_get_name >=> peekCString