module Codec.FFmpeg.Juicy where
import Codec.Picture
import Codec.FFmpeg.Enums
import Codec.FFmpeg.Types
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Monad (when, (>=>))
import Control.Monad.Trans.Maybe
import Data.Foldable (traverse_)
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable.Mutable as VM
import Foreign.C.Types
import Foreign.Marshal.Array (advancePtr, copyArray)
import Foreign.Ptr (castPtr, Ptr)
toJuicyT :: AVFrame -> MaybeT IO DynamicImage
toJuicyT = MaybeT . toJuicy
toJuicy :: AVFrame -> IO (Maybe DynamicImage)
toJuicy frame = do
fmt <- getPixelFormat frame
when (fmt /= avPixFmtRgb24)
(putStrLn "Not RGB24?!")
w <- fromIntegral <$> getWidth frame
h <- fromIntegral <$> getHeight frame
pixels <- castPtr <$> getData frame :: IO (Ptr CUChar)
srcStride <- fromIntegral <$> getLineSize frame
let dstStride = w * 3
v <- VM.new (w*h*3)
VM.unsafeWith v $ \vptr ->
mapM_ (\(i,o) -> copyArray (advancePtr vptr o)
(advancePtr pixels i)
(w * 3))
(map ((srcStride *) &&& (dstStride*)) [0 .. h 1])
v' <- V.unsafeFreeze v
let mkImage :: V.Storable (PixelBaseComponent a)
=> (Image a -> DynamicImage) -> Maybe DynamicImage
mkImage c = Just $ c (Image w h (V.unsafeCast v'))
return $
case () of
_ | fmt == avPixFmtRgb24 -> mkImage ImageRGB8
| fmt == avPixFmtGray8 -> mkImage ImageY8
| fmt == avPixFmtGray16 -> mkImage ImageY16
| otherwise -> Nothing
saveJuicy :: FilePath -> AVFrame -> IO ()
saveJuicy name = toJuicy >=> traverse_ (savePngImage name)
class JuicyPixelFormat a where
juicyPixelFormat :: proxy a -> AVPixelFormat
instance JuicyPixelFormat Pixel8 where
juicyPixelFormat _ = avPixFmtGray8
instance JuicyPixelFormat PixelRGB8 where
juicyPixelFormat _ = avPixFmtRgb24
instance JuicyPixelFormat PixelRGBA8 where
juicyPixelFormat _ = avPixFmtRgba