1 {-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, EmptyDataDecls, OverloadedStrings, NegativeLiterals, GeneralizedNewtypeDeriving #-}
    2 module Databrary.Store.AV
    3   ( AVError(..)
    4   , avErrorString
    5   , AV
    6   , initAV
    7   , AVMediaType(..)
    8   , AVProbe(..)
    9   , avProbe
   10   , avProbeLength
   11   , avProbeHas
   12   , avFrame
   13   ) where
   14 
   15 import Control.Applicative ((<|>))
   16 import Control.Arrow (first)
   17 import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar)
   18 import Control.Exception (Exception, throwIO, bracket, bracket_, finally, onException)
   19 import Control.Monad ((<=<), void, when, forM, forM_)
   20 import qualified Data.ByteString as BS
   21 import Data.Int (Int32, Int64)
   22 import Data.Maybe (isNothing)
   23 import Data.Ratio (Ratio, (%), numerator, denominator)
   24 import Data.Time.Clock (DiffTime)
   25 import Data.Time.Format (parseTimeM, defaultTimeLocale)
   26 import Data.Time.LocalTime (ZonedTime)
   27 import Data.Typeable (Typeable)
   28 import Data.Word (Word16, Word32)
   29 import Foreign.C.Error (throwErrnoIfNull)
   30 import Foreign.C.String (CString, CStringLen, peekCAString, withCAString)
   31 import Foreign.C.Types (CInt(..), CUInt(..), CSize(..))
   32 import Foreign.Marshal.Alloc (allocaBytes)
   33 import Foreign.Marshal.Utils (with, maybePeek)
   34 import Foreign.Ptr (Ptr, FunPtr, nullPtr, plusPtr, castPtr)
   35 import Foreign.StablePtr
   36 import Foreign.Storable
   37 import System.IO.Unsafe (unsafeDupablePerformIO)
   38 
   39 import Databrary.Ops
   40 import Databrary.Files
   41 import Databrary.Model.Offset
   42 
   43 #include <libavformat/avformat.h>
   44 
   45 type AVLockOp = #type enum AVLockOp
   46 type AVLockmgr a = Ptr (Ptr a) -> AVLockOp -> IO CInt
   47 type AVPixelFormat = #type enum AVPixelFormat
   48 type AVCodecID = #type enum AVCodecID
   49 
   50 data AVDictionary
   51 data AVDictionaryEntry
   52 data AVInputFormat
   53 data AVFrame
   54 data AVPacket
   55 data AVCodec
   56 data AVCodecContext
   57 data AVStream
   58 data AVFormatContext
   59 data AVIOContext
   60 data AVOutputFormat
   61 
   62 foreign import ccall unsafe "libavutil/error.h av_strerror"
   63   avStrerror :: CInt -> CString -> CSize -> IO CInt
   64 
   65 foreign import ccall unsafe "libavutil/mem.h av_free"
   66   avFree :: Ptr a -> IO ()
   67 
   68 foreign import ccall unsafe "libavutil/dict.h av_dict_get"
   69   avDictGet :: Ptr AVDictionary -> CString -> Ptr AVDictionaryEntry -> CInt -> IO (Ptr AVDictionaryEntry)
   70 
   71 foreign import ccall unsafe "libavutil/dict.h av_dict_set"
   72   avDictSet :: Ptr (Ptr AVDictionary) -> CString -> CString -> CInt -> IO CInt
   73 
   74 foreign import ccall unsafe "libavutil/dict.h av_dict_free"
   75   avDictFree :: Ptr (Ptr AVDictionary) -> IO ()
   76 
   77 foreign import ccall unsafe "libavutil/frame.h av_frame_alloc"
   78   avFrameAlloc :: IO (Ptr AVFrame)
   79 
   80 foreign import ccall unsafe "libavutil/frame.h av_frame_free"
   81   avFrameFree :: Ptr (Ptr AVFrame) -> IO ()
   82 
   83 foreign import ccall unsafe "libavutil/frame.h av_frame_unref"
   84   avFrameUnref :: Ptr AVFrame -> IO ()
   85 
   86 foreign import ccall unsafe "libavutil/frame.h av_frame_get_best_effort_timestamp"
   87   avFrameGetBestEffortTimestamp :: Ptr AVFrame -> IO Int64
   88 
   89 foreign import ccall "libavcodec/avcodec.h av_lockmgr_register"
   90   avLockmgrRegister :: FunPtr (AVLockmgr a) -> IO CInt
   91 
   92 foreign import ccall "wrapper"
   93   mkAVLockmgr :: AVLockmgr a -> IO (FunPtr (AVLockmgr a))
   94 
   95 foreign import ccall unsafe "libavcodec/avcodec.h avcodec_get_name"
   96   avcodecGetName :: AVCodecID -> IO CString
   97 
   98 foreign import ccall unsafe "libavcodec/avcodec.h av_init_packet"
   99   avInitPacket :: Ptr AVPacket -> IO ()
  100 
  101 foreign import ccall unsafe "libavcodec/avcodec.h av_free_packet"
  102   avFreePacket :: Ptr AVPacket -> IO ()
  103 
  104 foreign import ccall "libavcodec/avcodec.h avcodec_open2"
  105   avcodecOpen2 :: Ptr AVCodecContext -> Ptr AVCodec -> Ptr (Ptr AVDictionary) -> IO CInt
  106 
  107 foreign import ccall "libavcodec/avcodec.h avcodec_close"
  108   avcodecClose :: Ptr AVCodecContext -> IO CInt
  109 
  110 foreign import ccall "libavcodec/avcodec.h avcodec_decode_video2"
  111   avcodecDecodeVideo2 :: Ptr AVCodecContext -> Ptr AVFrame -> Ptr CInt -> Ptr AVPacket -> IO CInt
  112 
  113 foreign import ccall "libavcodec/avcodec.h avcodec_encode_video2"
  114   avcodecEncodeVideo2 :: Ptr AVCodecContext -> Ptr AVPacket -> Ptr AVFrame -> Ptr CInt -> IO CInt
  115 
  116 foreign import ccall "libavcodec/avcodec.h avcodec_find_encoder"
  117   avcodecFindEncoder :: AVCodecID -> IO (Ptr AVCodec)
  118 
  119 foreign import ccall "libavcodec/avcodec.h avcodec_find_best_pix_fmt_of_list"
  120   avcodecFindBestPixFmtOfList :: Ptr AVPixelFormat -> AVPixelFormat -> CInt -> Ptr CInt -> IO AVPixelFormat
  121 
  122 foreign import ccall unsafe "libavformat/avio.h avio_open_dyn_buf"
  123   avioOpenDynBuf :: Ptr (Ptr AVIOContext) -> IO CInt
  124 
  125 foreign import ccall unsafe "libavformat/avio.h avio_close_dyn_buf"
  126   avioCloseDynBuf :: Ptr AVIOContext -> Ptr CString -> IO CInt
  127 
  128 foreign import ccall "libavformat/avformat.h av_register_all"
  129   avRegisterAll :: IO ()
  130 
  131 foreign import ccall "libavformat/avformat.h avformat_open_input"
  132   avformatOpenInput :: Ptr (Ptr AVFormatContext) -> CString -> Ptr AVInputFormat -> Ptr (Ptr AVDictionary) -> IO CInt
  133 
  134 foreign import ccall "libavformat/avformat.h avformat_close_input"
  135   avformatCloseInput :: Ptr (Ptr AVFormatContext) -> IO ()
  136 
  137 foreign import ccall "libavformat/avformat.h avformat_find_stream_info"
  138   avformatFindStreamInfo :: Ptr AVFormatContext -> Ptr (Ptr AVDictionary) -> IO CInt
  139 
  140 foreign import ccall unsafe "libavformat/avformat.h av_find_input_format"
  141   avFindInputFormat :: CString -> IO (Ptr AVInputFormat)
  142 
  143 foreign import ccall "libavformat/avformat.h av_find_best_stream"
  144   avFindBestStream :: Ptr AVFormatContext -> #{type enum AVMediaType} -> CInt -> CInt -> Ptr (Ptr AVCodec) -> CInt -> IO CInt
  145 
  146 foreign import ccall "libavformat/avformat.h avformat_seek_file"
  147   avformatSeekFile :: Ptr AVFormatContext -> CInt -> Int64 -> Int64 -> Int64 -> CInt -> IO CInt
  148 
  149 foreign import ccall "libavformat/avformat.h av_read_frame"
  150   avReadFrame :: Ptr AVFormatContext -> Ptr AVPacket -> IO CInt
  151 
  152 foreign import ccall "libavformat/avformat.h avformat_alloc_output_context2"
  153   avformatAllocOutputContext2 :: Ptr (Ptr AVFormatContext) -> Ptr AVOutputFormat -> CString -> CString -> IO CInt
  154 
  155 foreign import ccall "libavformat/avformat.h avformat_free_context"
  156   avformatFreeContext :: Ptr AVFormatContext -> IO ()
  157 
  158 foreign import ccall "libavformat/avformat.h avformat_new_stream"
  159   avformatNewStream :: Ptr AVFormatContext -> Ptr AVCodec -> IO (Ptr AVStream)
  160 
  161 foreign import ccall "libavformat/avformat.h avformat_write_header"
  162   avformatWriteHeader :: Ptr AVFormatContext -> Ptr (Ptr AVDictionary) -> IO CInt
  163 
  164 foreign import ccall "libavformat/avformat.h av_write_frame"
  165   avWriteFrame :: Ptr AVFormatContext -> Ptr AVPacket -> IO CInt
  166 
  167 foreign import ccall "libavformat/avformat.h av_write_trailer"
  168   avWriteTrailer :: Ptr AVFormatContext -> IO CInt
  169 
  170 
  171 newtype AVRational = AVRational (Ratio CInt) deriving (Eq, Ord, Num, Fractional, Real, RealFrac)
  172 
  173 instance Storable AVRational where
  174   sizeOf _ = #{size AVRational}
  175   alignment (AVRational x) = alignment $ numerator x
  176   peek p = do
  177     num <- #{peek AVRational, num} p
  178     den <- #{peek AVRational, den} p
  179     return $ AVRational $ num % den
  180   poke p (AVRational x) = do
  181     #{poke AVRational, num} p (numerator x)
  182     #{poke AVRational, den} p (denominator x)           
  183 
  184 
  185 avShowError :: CInt -> String
  186 avShowError e = unsafeDupablePerformIO $
  187   allocaBytes len $ \p -> do
  188     _ <- avStrerror e p (fromIntegral len)
  189     peekCAString p
  190   where len = 256
  191 
  192 data AVError = AVError
  193   { avErrorCode :: CInt
  194   , avErrorFunction :: String
  195   , avErrorFile :: Maybe RawFilePath
  196   } deriving (Typeable)
  197 
  198 instance Exception AVError
  199 
  200 avErrorString :: AVError -> String
  201 avErrorString = avShowError . avErrorCode
  202 
  203 instance Show AVError where
  204   showsPrec p (AVError e c f) = showParen (p > 10) $
  205     showString "AVError "
  206     . showString c
  207     . maybe id (((' ' :) .) . shows) f
  208     . if e == 0 then id else
  209       showString ": " . showString (avShowError e)
  210 
  211 data ErrorFile
  212   = NoFile
  213   | FileName !RawFilePath
  214   | FileContext !(Ptr AVFormatContext)
  215 
  216 errorFile :: ErrorFile -> IO (Maybe RawFilePath)
  217 errorFile NoFile = return Nothing
  218 errorFile (FileName f) = return $ Just f
  219 errorFile (FileContext a) =
  220   (n /= nullPtr) `thenReturn` (BS.packCString n)
  221   where n = #{ptr AVFormatContext, filename} a 
  222 
  223 throwAVError :: CInt -> String -> ErrorFile -> IO a
  224 throwAVError e c f = throwIO . AVError e c =<< errorFile f
  225 
  226 throwAVErrorIf :: Integral a => String -> ErrorFile -> IO a -> IO a
  227 throwAVErrorIf c f g = do
  228   r <- g
  229   when (r < 0) $
  230     throwAVError (fromIntegral r) c f
  231   return r
  232 
  233 throwAVErrorIf_ :: Integral a => String -> ErrorFile -> IO a -> IO ()
  234 throwAVErrorIf_ c f = void . throwAVErrorIf c f
  235 
  236 throwAVErrorIfNull :: String -> ErrorFile -> IO (Ptr a) -> IO (Ptr a)
  237 throwAVErrorIfNull c f g = do
  238   r <- g
  239   when (r == nullPtr) $
  240     throwAVError 0 c f
  241   return r
  242 
  243 
  244 withAVDictionary :: (Ptr (Ptr AVDictionary) -> IO a) -> IO a
  245 withAVDictionary f = with nullPtr $ \d ->
  246   f d `finally` avDictFree d
  247 
  248 getAVDictionary :: Ptr AVDictionary -> String -> IO (Maybe String)
  249 getAVDictionary dict key =
  250   withCAString key $ \ckey ->
  251     maybePeek (peekCAString <=< #{peek AVDictionaryEntry, value}) =<< avDictGet dict ckey nullPtr 0  
  252 
  253 setAVDictionary :: Ptr (Ptr AVDictionary) -> String -> String -> IO ()
  254 setAVDictionary dict key val =
  255   withCAString key $ \ckey ->
  256   withCAString val $ \cval ->
  257   throwAVErrorIf_ "av_dict_set" NoFile $ avDictSet dict ckey cval 0
  258 
  259 closeAVIODynBuf :: Ptr AVIOContext -> (CStringLen -> IO a) -> IO a
  260 closeAVIODynBuf c g =
  261   with nullPtr $ \p ->
  262     bracket
  263       (do
  264         l <- avioCloseDynBuf c p
  265         b <- peek p
  266         return (b, fromIntegral l))
  267       (avFree . fst)
  268       g
  269 
  270 withAVIODynBuf :: ErrorFile -> Ptr (Ptr AVIOContext) -> IO a -> IO (BS.ByteString, a)
  271 withAVIODynBuf ec pb g = do
  272   throwAVErrorIf_ "avio_open_dyn_buf" ec $
  273     avioOpenDynBuf pb
  274   buf <- peek pb
  275   r <- g `onException`
  276     closeAVIODynBuf buf return
  277   b <- closeAVIODynBuf buf BS.packCStringLen
  278   return (b, r)
  279 
  280 withAVFrame :: (Ptr AVFrame -> IO a) -> IO a
  281 withAVFrame =
  282   bracket
  283     (throwErrnoIfNull "av_frame_alloc" avFrameAlloc)
  284     (`with` avFrameFree)
  285 
  286 withAVInput :: RawFilePath -> Maybe String -> (Ptr AVFormatContext -> IO a) -> IO a
  287 withAVInput f fmt g =
  288   BS.useAsCString f $ \cf ->
  289   with nullPtr $ \a ->
  290   bracket_
  291     (do
  292       avfmt <- maybe (return nullPtr) (`withCAString` avFindInputFormat) fmt
  293       throwAVErrorIf "avformat_open_input" (FileName f) $
  294         avformatOpenInput a cf avfmt nullPtr)
  295     (avformatCloseInput a)
  296     (g =<< peek a)
  297 
  298 findAVStreamInfo :: Ptr AVFormatContext -> IO ()
  299 findAVStreamInfo a = throwAVErrorIf_ "avformat_find_stream_info" (FileContext a) $
  300   avformatFindStreamInfo a nullPtr
  301 
  302 withAVOutput :: Maybe RawFilePath -> String -> (Ptr AVFormatContext -> IO a) -> IO (Maybe BS.ByteString, a)
  303 withAVOutput f fmt g =
  304   maybe ($ nullPtr) BS.useAsCString f $ \cf ->
  305   withCAString fmt $ \cfmt ->
  306   with nullPtr $ \a ->
  307     bracket_
  308       (throwAVErrorIf_ "avformat_alloc_output_context2" (maybe NoFile FileName f) $
  309         avformatAllocOutputContext2 a nullPtr cfmt cf)
  310       (avformatFreeContext =<< peek a)
  311       (do
  312         c <- peek a
  313         case f of
  314           Just _ -> (,) Nothing <$> g c
  315           Nothing -> first Just <$>
  316             withAVIODynBuf (FileContext c) (#{ptr AVFormatContext, pb} c)
  317               (g c))
  318 
  319 withAVCodec :: Ptr AVFormatContext -> Ptr AVStream -> Ptr AVCodec -> Ptr (Ptr AVDictionary) -> IO a -> IO a
  320 withAVCodec a s c o =
  321   bracket_
  322     (do
  323       sc <- #{peek AVStream, codec} s
  324       throwAVErrorIf_ "avcodec_open2" (FileContext a) $
  325         avcodecOpen2 sc c o)
  326     (do
  327       sc <- #{peek AVStream, codec} s
  328       avcodecClose sc)
  329 
  330 withAVPacket :: (Ptr AVPacket -> IO a) -> IO a
  331 withAVPacket f = allocaBytes #{size AVPacket} $ \p -> do
  332   bracket_
  333     (avInitPacket p)
  334     (avFreePacket p)
  335     (do
  336       #{poke AVPacket, data} p nullPtr
  337       #{poke AVPacket, size} p (0 :: CInt)
  338       f p)
  339 
  340 
  341 avLockmgr :: AVLockmgr ()
  342 avLockmgr p o
  343   | o == #{const AV_LOCK_CREATE} = (<$) 0 $
  344     poke p . castStablePtrToPtr =<< newStablePtr =<< newMVar ()
  345   | o == #{const AV_LOCK_OBTAIN} = (<$) 0 $
  346     takeMVar =<< deRefStablePtr =<< s
  347   | o == #{const AV_LOCK_RELEASE} = (<$) 0 $
  348     (`putMVar` ()) =<< deRefStablePtr =<< s
  349   | o == #{const AV_LOCK_DESTROY} = (<$) 0 $
  350     freeStablePtr =<< s
  351   | otherwise = return (-1)
  352   where
  353   s = castPtrToStablePtr <$> peek p
  354   s :: IO (StablePtr (MVar ()))
  355 
  356 data AV = AV 
  357 
  358 initAV :: IO AV
  359 initAV = do
  360   avRegisterAll
  361   mgr <- mkAVLockmgr avLockmgr
  362   throwAVErrorIf_ "av_lockmgr_register" NoFile $ avLockmgrRegister mgr
  363   -- leak mgr
  364   return AV
  365 
  366 data AVMediaType
  367   = AVMediaTypeUnknown
  368   | AVMediaTypeVideo
  369   | AVMediaTypeAudio
  370   | AVMediaTypeData
  371   | AVMediaTypeSubtitle
  372   | AVMediaTypeAttachment
  373   deriving (Eq, Show, Enum, Bounded)
  374 
  375 instance Storable AVMediaType where
  376   sizeOf _ = sizeOf (undefined :: #type enum AVMediaType)
  377   alignment _ = alignment (undefined :: #type enum AVMediaType)
  378   peek p = do
  379     v <- peek (castPtr p :: Ptr #{type enum AVMediaType})
  380     return $ case v of 
  381       #{const AVMEDIA_TYPE_VIDEO}      -> AVMediaTypeVideo
  382       #{const AVMEDIA_TYPE_AUDIO}      -> AVMediaTypeAudio
  383       #{const AVMEDIA_TYPE_DATA}       -> AVMediaTypeData
  384       #{const AVMEDIA_TYPE_SUBTITLE}   -> AVMediaTypeSubtitle
  385       #{const AVMEDIA_TYPE_ATTACHMENT} -> AVMediaTypeAttachment
  386       _ -> AVMediaTypeUnknown
  387   poke p v = poke (castPtr p :: Ptr #{type enum AVMediaType}) $ case v of
  388     AVMediaTypeUnknown    -> #{const AVMEDIA_TYPE_UNKNOWN}
  389     AVMediaTypeVideo      -> #{const AVMEDIA_TYPE_VIDEO}
  390     AVMediaTypeAudio      -> #{const AVMEDIA_TYPE_AUDIO}
  391     AVMediaTypeData       -> #{const AVMEDIA_TYPE_DATA}
  392     AVMediaTypeSubtitle   -> #{const AVMEDIA_TYPE_SUBTITLE}
  393     AVMediaTypeAttachment -> #{const AVMEDIA_TYPE_ATTACHMENT}
  394 
  395 data AVProbe = AVProbe
  396   { avProbeFormat :: BS.ByteString
  397   , avProbeDuration :: DiffTime
  398   , avProbeStreams :: [(AVMediaType, BS.ByteString)]
  399   , avProbeDate :: Maybe ZonedTime
  400   }
  401 
  402 avProbeHas :: AVMediaType -> AVProbe -> Bool
  403 avProbeHas t = any ((t ==) . fst) . avProbeStreams
  404 
  405 avProbeLength :: AVProbe -> Maybe Offset
  406 avProbeLength AVProbe{ avProbeDuration = o } = (o > 0) `thenUse` (diffTimeOffset o)
  407 
  408 avTime :: Int64 -> DiffTime
  409 avTime t = realToFrac $ t % #{const AV_TIME_BASE}
  410 
  411 avProbe :: RawFilePath -> AV -> IO AVProbe
  412 avProbe f AV = withAVInput f Nothing $ \ic -> do
  413   findAVStreamInfo ic
  414   meta <- #{peek AVFormatContext, metadata} ic
  415   AVProbe
  416     <$> (BS.packCString =<< #{peek AVInputFormat, name} =<< #{peek AVFormatContext, iformat} ic)
  417     <*> (avTime <$> #{peek AVFormatContext, duration} ic)
  418     <*> do
  419       nb :: CUInt <- #{peek AVFormatContext, nb_streams} ic
  420       ss <- #{peek AVFormatContext, streams} ic
  421       forM [0..pred (fromIntegral nb)] $ \i -> do
  422         c <- #{peek AVStream, codec} =<< peekElemOff ss i
  423         t <- #{peek AVCodecContext, codec_type} c
  424         n <- BS.packCString =<< avcodecGetName =<< #{peek AVCodecContext, codec_id} c
  425         return (t, n)
  426     <*> ((=<<) (\t -> parseTimeM True defaultTimeLocale "%F %T%Z" t <|> parseTimeM True defaultTimeLocale "%F %T %Z" t) <$>
  427       ((`orElseM` getAVDictionary meta "creation_time") =<< getAVDictionary meta "date"))
  428 
  429 
  430 avSeekStream :: Ptr AVFormatContext -> Ptr AVStream -> Ptr AVFrame -> Maybe DiffTime -> IO ()
  431 avSeekStream ctx s frame offset = do
  432   off <- forM offset $ \o -> do
  433     den :: CInt <- #{peek AVStream, time_base.den} s
  434     num :: CInt <- #{peek AVStream, time_base.num} s
  435     let off = floor $ o * (fromIntegral den) / (fromIntegral num)
  436     throwAVErrorIf_ "avformat_seek_file" (FileContext ctx) $
  437       avformatSeekFile ctx 0 (#const INT64_MIN) off off 0
  438     return off
  439   si :: CInt <- #{peek AVStream, index} s
  440   codec <- #{peek AVStream, codec} s
  441   let
  442     seek = withAVPacket $ \pkt -> do
  443       avFrameUnref frame
  444       throwAVErrorIf_ "av_read_frame" (FileContext ctx) $
  445         avReadFrame ctx pkt
  446       psi <- #{peek AVPacket, stream_index} pkt
  447       if psi /= si then seek else with 0 $ \gpp -> do
  448         throwAVErrorIf_ "avcodec_decode_video2" (FileContext ctx) $
  449           avcodecDecodeVideo2 codec frame gpp pkt
  450         gp <- peek gpp
  451         if gp == 0 then seek else do
  452           pts <- avFrameGetBestEffortTimestamp frame
  453           if any (pts <) off then seek else
  454             #{poke AVFrame, pts} frame pts -- done
  455   seek
  456 
  457 
  458 foreign import ccall unsafe "av.h avFrame_initialize_stream"
  459   avFrameInitializeStream :: Ptr AVStream -> Ptr AVFormatContext -> Ptr AVStream -> Ptr AVFrame -> CInt -> CInt -> IO ()
  460 
  461 foreign import ccall "av.h avFrame_rescale"
  462   avFrameRescale :: Ptr AVCodecContext -> Ptr AVFrame -> IO CInt
  463 
  464 avFrame :: RawFilePath -> Maybe DiffTime -> Maybe Word16 -> Maybe Word16 -> Maybe RawFilePath -> AV -> IO (Maybe BS.ByteString)
  465 avFrame infile offset width height outfile AV =
  466   withAVInput infile (isimg `thenUse` "image2") $ \inctx ->
  467   with nullPtr $ \icodecp ->
  468   withAVDictionary $ \opts -> do
  469   when isimg $
  470     #{poke AVFormatContext, video_codec_id} inctx (#{const AV_CODEC_ID_MJPEG} :: AVCodecID)
  471   findAVStreamInfo inctx
  472 
  473   si <- throwAVErrorIf "av_find_best_stream" (FileContext inctx) $
  474     avFindBestStream inctx #{const AVMEDIA_TYPE_VIDEO} (-1) (-1) icodecp 0
  475   nb :: CUInt <- #{peek AVFormatContext, nb_streams} inctx
  476   isl <- #{peek AVFormatContext, streams} inctx
  477   forM_ [0..pred (fromIntegral nb)] $ \i ->
  478     when (i /= si) $ do
  479       is <- peekElemOff isl (fromIntegral i)
  480       #{poke AVStream, discard} is (#{const AVDISCARD_ALL} :: #{type enum AVDiscard})
  481   is <- peekElemOff isl (fromIntegral si)
  482 
  483   setAVDictionary opts "threads" "1"
  484   icodec <- peek icodecp
  485   withAVCodec inctx is icodec opts $ withAVFrame $ \frame -> do
  486     avSeekStream inctx is frame offset
  487     ffmt <- #{peek AVFrame, format} frame
  488     fwidth :: CInt <- #{peek AVFrame, width} frame
  489     fheight :: CInt <- #{peek AVFrame, height} frame
  490     fmap fst $ withAVOutput outfile (maybe "image2pipe" (const "image2") outfile) $ \outctx -> do
  491       ocodec <- throwAVErrorIfNull "avcodec_find_encoder(AV_CODEC_ID_MJPEG)" (FileContext outctx) $
  492         avcodecFindEncoder #{const AV_CODEC_ID_MJPEG}
  493       os <- throwAVErrorIfNull "avformat_new_stream" (FileContext outctx) $
  494         avformatNewStream outctx ocodec
  495       oc :: Ptr AVCodecContext <- #{peek AVStream, codec} os
  496       avFrameInitializeStream os inctx is frame (maybe (-1) fromIntegral width) (maybe (-1) fromIntegral height)
  497       owidth <- #{peek AVCodecContext, width} oc
  498       oheight <- #{peek AVCodecContext, height} oc
  499       fmts <- #{peek AVCodec, pix_fmts} ocodec
  500       fmt <- throwAVErrorIf "avcodec_find_best_pix_fmt_of_list" (FileContext outctx) $
  501         avcodecFindBestPixFmtOfList fmts ffmt 0 nullPtr
  502       #{poke AVCodecContext, pix_fmt} oc fmt
  503       when (fmt /= ffmt || owidth /= fwidth || oheight /= fheight) $
  504         throwAVErrorIf_ "av_frame_get_buffer" (FileContext outctx) $
  505           avFrameRescale oc frame
  506 
  507       setAVDictionary opts "threads" "1"
  508       withAVCodec outctx os ocodec opts $
  509         withAVPacket $ \pkt -> with 0 $ \gpp -> do
  510           throwAVErrorIf_ "avformat_write_header" (FileContext outctx) $
  511             avformatWriteHeader outctx nullPtr
  512           throwAVErrorIf_ "avcodec_encode_video2" (FileContext outctx) $
  513             avcodecEncodeVideo2 oc pkt frame gpp
  514           gp <- peek gpp
  515           when (gp == 0) $
  516             throwAVError 0 "avcodec_encode_video2 packet" (FileContext outctx)
  517           throwAVErrorIf_ "av_write_frame" (FileContext outctx) $
  518             avWriteFrame outctx pkt
  519           throwAVErrorIf_ "av_write_trailer" (FileContext outctx) $
  520             avWriteTrailer outctx
  521   where
  522   isimg = isNothing offset