SWScale.hsc

-- -*- haskell -*-
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}

{- | Module 'Media.FFMpeg.Internals.SWScale' implements 
   swscale header (its structures and datatypes) along with 
   getters and setters to work with them
   
   (c) 2009 Vasyl Pasternak
 -}

module Media.FFMpeg.Internals.SWScale
    (
    -- Enumerations
    ScaleAlgorithm (..)

    -- Context
    ,Context
    ,getContext
    ,scale
    ) where

import Foreign
import Foreign.C.String
import Control.Monad (liftM)
import Text.Printf
import Media.FFMpeg.Internals.Types
import Media.FFMpeg.Internals.Utils

#include "libswscale/swscale.h"
#include "macros.hsc2hs.h"


-- |Enumerations
#{begin_enum ScaleAlgorithm, SWS_FAST_BILINEAR}
#{add_enum SWS_BICUBIC}
#{add_enum SWS_X}
#{add_enum SWS_POINT}
#{add_enum SWS_AREA}
#{add_enum SWS_BICUBLIN}
#{add_enum SWS_GAUSS}
#{add_enum SWS_SINC}
#{add_enum SWS_LANCZOS}
#{add_enum SWS_SPLINE}
#{end_enum "Eq,Ord,Show"}

-- |SwsContext

newtype Context = Context (ForeignPtr Context)

withContext :: Context -> (Ptr a -> IO b) -> IO b
withContext (Context ctx) clos = withForeignPtr ctx (clos . castPtr)

foreign import ccall "sws_freeContext" _free_context :: VoidP -> IO ()

foreign import ccall "sws_getContext" _get_context :: 
    SInt -> SInt -> #{type enum PixelFormat} -> 
    SInt -> SInt -> #{type enum PixelFormat} ->
    SInt -> VoidP -> VoidP -> VoidP -> IO VoidP

combineBitMasks :: (Enum a, Bits b) => [a] -> b
combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)

getContext :: (Int, Int, PixelFormat) ->
              (Int, Int, PixelFormat) ->
              [ScaleAlgorithm] -> IO Context
getContext (srcW, srcH, srcPf) (dstW, dstH, dstPf) flags = do
  ret <- throwIf (== nullPtr) 
         (\_ -> "getContext: failed to create SWScale context") $
         _get_context (fromIntegral srcW) (fromIntegral srcH) (fromIntegral $ fromEnum srcPf)
              (fromIntegral dstW) (fromIntegral dstH) (fromIntegral $ fromEnum dstPf) 
              (combineBitMasks flags) nullPtr nullPtr nullPtr 
  finalizer <- mkFinalizerPtr _free_context
  newForeignPtr finalizer ret >>= return . Context . castForeignPtr

foreign import ccall "sws_scale" _sws_scale ::
    VoidP -> VoidP -> VoidP -> SInt -> SInt -> VoidP -> VoidP -> IO SInt

scale :: Context -> PictureSlice -> PictureStride -> Int -> Int -> 
         PictureSlice -> PictureStride -> IO ()
scale ctx srcSlice srcStride srcSliceY srcSliceH dstSlice dstStride = 
    withContext ctx $ \ctx' -> 
        _sws_scale ctx' srcSlice srcStride 
             (fromIntegral srcSliceY) 
             (fromIntegral srcSliceH) 
             dstSlice dstStride >> 
         return ()