{-# 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.Types
import Foreign.C.String
import Foreign.C.Types
import Foreign.Storable


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

{-# LINE 10 "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 30 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 112)) p >>= si "flags"
{-# LINE 31 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 116)) p >>= si "flags2"
{-# LINE 32 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 164)) p >>= si "gop_size"
{-# LINE 33 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 96)) p >>= si "bit_rate"
{-# LINE 34 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 192)) p >>= si "max_b_frames"
{-# LINE 35 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 204)) p >>= si "b_frame_strategy"
{-# LINE 36 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 564)) p >>= si "qmin"
{-# LINE 37 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 568)) p >>= si "qmax"
{-# LINE 38 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 272)) p >>= si "me_cmp"
{-# LINE 39 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 316)) p >>= si "me_range"
{-# LINE 40 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  putStrLn ""
  where si msg = putStrLn . ((msg++" = ")++) . show :: CInt -> IO ()