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