{-# LINE 1 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
-- | Helpers for dumping information about codecs to stdout.
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




-- | 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 :: AVCodec -> IO ()
debugCodec cod :: AVCodec
cod = do
  String
longName <- AVCodec -> IO CString
forall t. HasLongName t => t -> IO CString
getLongName AVCodec
cod IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
  String
shortName <- AVCodec -> IO CString
forall t. HasName t => t -> IO CString
getName AVCodec
cod IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
  AVCodecID
cid <- AVCodec -> IO AVCodecID
forall t. HasCodecID t => t -> IO AVCodecID
getCodecID AVCodec
cod
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Codec short_name = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
shortName
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Codec long_name = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
longName
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Codec ID = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AVCodecID -> String
forall a. Show a => a -> String
show AVCodecID
cid

-- | Print various codec settings.
debugCodecContext :: AVCodecContext -> IO()
debugCodecContext :: AVCodecContext -> IO ()
debugCodecContext (AVCodecContext p :: Ptr ()
p) = do
  String -> IO ()
putStrLn "*** AVCodecContext dump:"
  ((\hsc_ptr :: Ptr ()
hsc_ptr -> Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr 932)) Ptr ()
p IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> CInt -> IO ()
si "profile"
{-# LINE 34 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 116)) p >>= si "flags"
{-# LINE 35 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 120)) p >>= si "flags2"
{-# LINE 36 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 172)) 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 200)) p >>= si "max_b_frames"
{-# LINE 39 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 212)) p >>= si "b_frame_strategy"
{-# LINE 40 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 548)) p >>= si "qmin"
{-# LINE 41 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 552)) p >>= si "qmax"
{-# LINE 42 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 280)) p >>= si "me_cmp"
{-# LINE 43 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  ((\hsc_ptr -> peekByteOff hsc_ptr 324)) p >>= si "me_range"
{-# LINE 44 "src/Codec/FFmpeg/Internal/Debug.hsc" #-}
  putStrLn ""
  where si :: String -> CInt -> IO ()
si msg :: String
msg = String -> IO ()
putStrLn (String -> IO ()) -> (CInt -> String) -> CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
msgString -> String -> String
forall a. [a] -> [a] -> [a]
++" = ")String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (CInt -> String) -> CInt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> String
forall a. Show a => a -> String
show :: CInt -> IO ()

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

pixFmtName :: AVPixelFormat -> IO String
pixFmtName :: AVPixelFormat -> IO String
pixFmtName = AVPixelFormat -> IO CString
av_get_pix_fmt_name (AVPixelFormat -> IO CString)
-> (CString -> IO String) -> AVPixelFormat -> IO String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CString -> IO String
peekCString

-- | Print all pixel formats supported by a given 'AVCodec'.
debugPixelFormats :: AVCodec -> IO ()
debugPixelFormats :: AVCodec -> IO ()
debugPixelFormats cod :: AVCodec
cod = String -> IO ()
putStrLn "Supported pixel formats:" IO () -> IO (Ptr AVPixelFormat) -> IO (Ptr AVPixelFormat)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        AVCodec -> IO (Ptr AVPixelFormat)
forall t. HasPixelFormats t => t -> IO (Ptr AVPixelFormat)
getPixelFormats AVCodec
cod IO (Ptr AVPixelFormat) -> (Ptr AVPixelFormat -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Ptr AVPixelFormat -> IO ()
go 0
  where go :: Int -> Ptr AVPixelFormat -> IO ()
go i :: Int
i fmts :: Ptr AVPixelFormat
fmts
          = let ptr :: Ptr AVPixelFormat
ptr = Ptr AVPixelFormat -> Int -> Ptr AVPixelFormat
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr AVPixelFormat
fmts Int
i
            in Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr AVPixelFormat
ptr Ptr AVPixelFormat -> Ptr AVPixelFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AVPixelFormat
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                 AVPixelFormat
fmt <- Ptr AVPixelFormat -> IO AVPixelFormat
forall a. Storable a => Ptr a -> IO a
peek Ptr AVPixelFormat
ptr
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AVPixelFormat
fmt AVPixelFormat -> AVPixelFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= AVPixelFormat
avPixFmtNone) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                   AVPixelFormat -> IO CString
av_get_pix_fmt_name AVPixelFormat
fmt IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                     String -> IO ()
putStrLn (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ("  " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
                   Int -> Ptr AVPixelFormat -> IO ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Ptr AVPixelFormat
fmts

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

-- | Get the name of a codec.
debugCodecName :: AVCodecID -> IO String
debugCodecName :: AVCodecID -> IO String
debugCodecName = AVCodecID -> IO CString
avcodec_get_name (AVCodecID -> IO CString)
-> (CString -> IO String) -> AVCodecID -> IO String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CString -> IO String
peekCString