{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GstVideo.Structs.VideoScaler.VideoScaler' is a utility object for rescaling and resampling
-- video frames using various interpolation \/ sampling methods.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.GstVideo.Structs.VideoScaler
    ( 

-- * Exported types
    VideoScaler(..)                         ,
    noVideoScaler                           ,


 -- * Methods
-- ** 2d #method:2d#

#if defined(ENABLE_OVERLOADING)
    VideoScaler2dMethodInfo                 ,
#endif
    videoScaler2d                           ,


-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveVideoScalerMethod                ,
#endif


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    VideoScalerFreeMethodInfo               ,
#endif
    videoScalerFree                         ,


-- ** getCoeff #method:getCoeff#

#if defined(ENABLE_OVERLOADING)
    VideoScalerGetCoeffMethodInfo           ,
#endif
    videoScalerGetCoeff                     ,


-- ** getMaxTaps #method:getMaxTaps#

#if defined(ENABLE_OVERLOADING)
    VideoScalerGetMaxTapsMethodInfo         ,
#endif
    videoScalerGetMaxTaps                   ,


-- ** horizontal #method:horizontal#

#if defined(ENABLE_OVERLOADING)
    VideoScalerHorizontalMethodInfo         ,
#endif
    videoScalerHorizontal                   ,


-- ** vertical #method:vertical#

#if defined(ENABLE_OVERLOADING)
    VideoScalerVerticalMethodInfo           ,
#endif
    videoScalerVertical                     ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums

-- | Memory-managed wrapper type.
newtype VideoScaler = VideoScaler (ManagedPtr VideoScaler)
    deriving (VideoScaler -> VideoScaler -> Bool
(VideoScaler -> VideoScaler -> Bool)
-> (VideoScaler -> VideoScaler -> Bool) -> Eq VideoScaler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoScaler -> VideoScaler -> Bool
$c/= :: VideoScaler -> VideoScaler -> Bool
== :: VideoScaler -> VideoScaler -> Bool
$c== :: VideoScaler -> VideoScaler -> Bool
Eq)
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance WrappedPtr VideoScaler where
    wrappedPtrCalloc :: IO (Ptr VideoScaler)
wrappedPtrCalloc = Ptr VideoScaler -> IO (Ptr VideoScaler)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VideoScaler
forall a. Ptr a
nullPtr
    wrappedPtrCopy :: VideoScaler -> IO VideoScaler
wrappedPtrCopy = VideoScaler -> IO VideoScaler
forall (m :: * -> *) a. Monad m => a -> m a
return
    wrappedPtrFree :: Maybe (GDestroyNotify VideoScaler)
wrappedPtrFree = Maybe (GDestroyNotify VideoScaler)
forall a. Maybe a
Nothing

-- | A convenience alias for `Nothing` :: `Maybe` `VideoScaler`.
noVideoScaler :: Maybe VideoScaler
noVideoScaler :: Maybe VideoScaler
noVideoScaler = Maybe VideoScaler
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoScaler
type instance O.AttributeList VideoScaler = VideoScalerAttributeList
type VideoScalerAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method VideoScaler::2d
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hscale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a horzontal #GstVideoScaler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vscale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vertical #GstVideoScaler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormat for @srcs and @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_stride"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source pixels stride"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_stride"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination pixels stride"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the horizontal destination offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vertical destination offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of output pixels to scale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of output lines to scale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_scaler_2d" gst_video_scaler_2d :: 
    Ptr VideoScaler ->                      -- hscale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    Ptr VideoScaler ->                      -- vscale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Ptr () ->                               -- src : TBasicType TPtr
    Int32 ->                                -- src_stride : TBasicType TInt
    Ptr () ->                               -- dest : TBasicType TPtr
    Int32 ->                                -- dest_stride : TBasicType TInt
    Word32 ->                               -- x : TBasicType TUInt
    Word32 ->                               -- y : TBasicType TUInt
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    IO ()

-- | Scale a rectangle of pixels in /@src@/ with /@srcStride@/ to /@dest@/ with
-- /@destStride@/ using the horizontal scaler /@hscaler@/ and the vertical
-- scaler /@vscale@/.
-- 
-- One or both of /@hscale@/ and /@vscale@/ can be NULL to only perform scaling in
-- one dimension or do a copy without scaling.
-- 
-- /@x@/ and /@y@/ are the coordinates in the destination image to process.
videoScaler2d ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoScaler
    -- ^ /@hscale@/: a horzontal t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> VideoScaler
    -- ^ /@vscale@/: a vertical t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@format@/: a t'GI.GstVideo.Enums.VideoFormat' for /@srcs@/ and /@dest@/
    -> Ptr ()
    -- ^ /@src@/: source pixels
    -> Int32
    -- ^ /@srcStride@/: source pixels stride
    -> Ptr ()
    -- ^ /@dest@/: destination pixels
    -> Int32
    -- ^ /@destStride@/: destination pixels stride
    -> Word32
    -- ^ /@x@/: the horizontal destination offset
    -> Word32
    -- ^ /@y@/: the vertical destination offset
    -> Word32
    -- ^ /@width@/: the number of output pixels to scale
    -> Word32
    -- ^ /@height@/: the number of output lines to scale
    -> m ()
videoScaler2d :: VideoScaler
-> VideoScaler
-> VideoFormat
-> Ptr ()
-> Int32
-> Ptr ()
-> Int32
-> Word32
-> Word32
-> Word32
-> Word32
-> m ()
videoScaler2d hscale :: VideoScaler
hscale vscale :: VideoScaler
vscale format :: VideoFormat
format src :: Ptr ()
src srcStride :: Int32
srcStride dest :: Ptr ()
dest destStride :: Int32
destStride x :: Word32
x y :: Word32
y width :: Word32
width height :: Word32
height = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoScaler
hscale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
hscale
    Ptr VideoScaler
vscale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
vscale
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
format
    Ptr VideoScaler
-> Ptr VideoScaler
-> CUInt
-> Ptr ()
-> Int32
-> Ptr ()
-> Int32
-> Word32
-> Word32
-> Word32
-> Word32
-> IO ()
gst_video_scaler_2d Ptr VideoScaler
hscale' Ptr VideoScaler
vscale' CUInt
format' Ptr ()
src Int32
srcStride Ptr ()
dest Int32
destStride Word32
x Word32
y Word32
width Word32
height
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
hscale
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
vscale
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoScaler2dMethodInfo
instance (signature ~ (VideoScaler -> GstVideo.Enums.VideoFormat -> Ptr () -> Int32 -> Ptr () -> Int32 -> Word32 -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m) => O.MethodInfo VideoScaler2dMethodInfo VideoScaler signature where
    overloadedMethod = videoScaler2d

#endif

-- method VideoScaler::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoScaler" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_scaler_free" gst_video_scaler_free :: 
    Ptr VideoScaler ->                      -- scale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    IO ()

-- | Free a previously allocated t'GI.GstVideo.Structs.VideoScaler.VideoScaler' /@scale@/.
videoScalerFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoScaler
    -- ^ /@scale@/: a t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> m ()
videoScalerFree :: VideoScaler -> m ()
videoScalerFree scale :: VideoScaler
scale = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoScaler
scale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
scale
    Ptr VideoScaler -> IO ()
gst_video_scaler_free Ptr VideoScaler
scale'
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
scale
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoScalerFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo VideoScalerFreeMethodInfo VideoScaler signature where
    overloadedMethod = videoScalerFree

#endif

-- method VideoScaler::get_coeff
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoScaler" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an output offset" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result input offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_taps"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result n_taps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_scaler_get_coeff" gst_video_scaler_get_coeff :: 
    Ptr VideoScaler ->                      -- scale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    Word32 ->                               -- out_offset : TBasicType TUInt
    Word32 ->                               -- in_offset : TBasicType TUInt
    Word32 ->                               -- n_taps : TBasicType TUInt
    IO CDouble

-- | For a given pixel at /@outOffset@/, get the first required input pixel at
-- /@inOffset@/ and the /@nTaps@/ filter coefficients.
-- 
-- Note that for interlaced content, /@inOffset@/ needs to be incremented with
-- 2 to get the next input line.
videoScalerGetCoeff ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoScaler
    -- ^ /@scale@/: a t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> Word32
    -- ^ /@outOffset@/: an output offset
    -> Word32
    -- ^ /@inOffset@/: result input offset
    -> Word32
    -- ^ /@nTaps@/: result n_taps
    -> m Double
    -- ^ __Returns:__ an array of /@nTap@/ gdouble values with filter coefficients.
videoScalerGetCoeff :: VideoScaler -> Word32 -> Word32 -> Word32 -> m Double
videoScalerGetCoeff scale :: VideoScaler
scale outOffset :: Word32
outOffset inOffset :: Word32
inOffset nTaps :: Word32
nTaps = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoScaler
scale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
scale
    CDouble
result <- Ptr VideoScaler -> Word32 -> Word32 -> Word32 -> IO CDouble
gst_video_scaler_get_coeff Ptr VideoScaler
scale' Word32
outOffset Word32
inOffset Word32
nTaps
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
scale
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data VideoScalerGetCoeffMethodInfo
instance (signature ~ (Word32 -> Word32 -> Word32 -> m Double), MonadIO m) => O.MethodInfo VideoScalerGetCoeffMethodInfo VideoScaler signature where
    overloadedMethod = videoScalerGetCoeff

#endif

-- method VideoScaler::get_max_taps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoScaler" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_scaler_get_max_taps" gst_video_scaler_get_max_taps :: 
    Ptr VideoScaler ->                      -- scale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    IO Word32

-- | Get the maximum number of taps for /@scale@/.
videoScalerGetMaxTaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoScaler
    -- ^ /@scale@/: a t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> m Word32
    -- ^ __Returns:__ the maximum number of taps
videoScalerGetMaxTaps :: VideoScaler -> m Word32
videoScalerGetMaxTaps scale :: VideoScaler
scale = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoScaler
scale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
scale
    Word32
result <- Ptr VideoScaler -> IO Word32
gst_video_scaler_get_max_taps Ptr VideoScaler
scale'
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
scale
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data VideoScalerGetMaxTapsMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo VideoScalerGetMaxTapsMethodInfo VideoScaler signature where
    overloadedMethod = videoScalerGetMaxTaps

#endif

-- method VideoScaler::horizontal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoScaler" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormat for @src and @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the horizontal destination offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of pixels to scale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_scaler_horizontal" gst_video_scaler_horizontal :: 
    Ptr VideoScaler ->                      -- scale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Ptr () ->                               -- src : TBasicType TPtr
    Ptr () ->                               -- dest : TBasicType TPtr
    Word32 ->                               -- dest_offset : TBasicType TUInt
    Word32 ->                               -- width : TBasicType TUInt
    IO ()

-- | Horizontally scale the pixels in /@src@/ to /@dest@/, starting from /@destOffset@/
-- for /@width@/ samples.
videoScalerHorizontal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoScaler
    -- ^ /@scale@/: a t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@format@/: a t'GI.GstVideo.Enums.VideoFormat' for /@src@/ and /@dest@/
    -> Ptr ()
    -- ^ /@src@/: source pixels
    -> Ptr ()
    -- ^ /@dest@/: destination pixels
    -> Word32
    -- ^ /@destOffset@/: the horizontal destination offset
    -> Word32
    -- ^ /@width@/: the number of pixels to scale
    -> m ()
videoScalerHorizontal :: VideoScaler
-> VideoFormat -> Ptr () -> Ptr () -> Word32 -> Word32 -> m ()
videoScalerHorizontal scale :: VideoScaler
scale format :: VideoFormat
format src :: Ptr ()
src dest :: Ptr ()
dest destOffset :: Word32
destOffset width :: Word32
width = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoScaler
scale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
scale
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
format
    Ptr VideoScaler
-> CUInt -> Ptr () -> Ptr () -> Word32 -> Word32 -> IO ()
gst_video_scaler_horizontal Ptr VideoScaler
scale' CUInt
format' Ptr ()
src Ptr ()
dest Word32
destOffset Word32
width
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
scale
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoScalerHorizontalMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> Ptr () -> Ptr () -> Word32 -> Word32 -> m ()), MonadIO m) => O.MethodInfo VideoScalerHorizontalMethodInfo VideoScaler signature where
    overloadedMethod = videoScalerHorizontal

#endif

-- method VideoScaler::vertical
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scale"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoScaler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoScaler" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormat for @srcs and @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_lines"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source pixels lines"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vertical destination offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of pixels to scale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_scaler_vertical" gst_video_scaler_vertical :: 
    Ptr VideoScaler ->                      -- scale : TInterface (Name {namespace = "GstVideo", name = "VideoScaler"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Ptr () ->                               -- src_lines : TBasicType TPtr
    Ptr () ->                               -- dest : TBasicType TPtr
    Word32 ->                               -- dest_offset : TBasicType TUInt
    Word32 ->                               -- width : TBasicType TUInt
    IO ()

-- | Vertically combine /@width@/ pixels in the lines in /@srcLines@/ to /@dest@/.
-- /@dest@/ is the location of the target line at /@destOffset@/ and
-- /@srcs@/ are the input lines for /@destOffset@/, as obtained with
-- @/gst_video_scaler_get_info()/@.
videoScalerVertical ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoScaler
    -- ^ /@scale@/: a t'GI.GstVideo.Structs.VideoScaler.VideoScaler'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@format@/: a t'GI.GstVideo.Enums.VideoFormat' for /@srcs@/ and /@dest@/
    -> Ptr ()
    -- ^ /@srcLines@/: source pixels lines
    -> Ptr ()
    -- ^ /@dest@/: destination pixels
    -> Word32
    -- ^ /@destOffset@/: the vertical destination offset
    -> Word32
    -- ^ /@width@/: the number of pixels to scale
    -> m ()
videoScalerVertical :: VideoScaler
-> VideoFormat -> Ptr () -> Ptr () -> Word32 -> Word32 -> m ()
videoScalerVertical scale :: VideoScaler
scale format :: VideoFormat
format srcLines :: Ptr ()
srcLines dest :: Ptr ()
dest destOffset :: Word32
destOffset width :: Word32
width = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoScaler
scale' <- VideoScaler -> IO (Ptr VideoScaler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoScaler
scale
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
format
    Ptr VideoScaler
-> CUInt -> Ptr () -> Ptr () -> Word32 -> Word32 -> IO ()
gst_video_scaler_vertical Ptr VideoScaler
scale' CUInt
format' Ptr ()
srcLines Ptr ()
dest Word32
destOffset Word32
width
    VideoScaler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoScaler
scale
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoScalerVerticalMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> Ptr () -> Ptr () -> Word32 -> Word32 -> m ()), MonadIO m) => O.MethodInfo VideoScalerVerticalMethodInfo VideoScaler signature where
    overloadedMethod = videoScalerVertical

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoScalerMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoScalerMethod "2d" o = VideoScaler2dMethodInfo
    ResolveVideoScalerMethod "free" o = VideoScalerFreeMethodInfo
    ResolveVideoScalerMethod "horizontal" o = VideoScalerHorizontalMethodInfo
    ResolveVideoScalerMethod "vertical" o = VideoScalerVerticalMethodInfo
    ResolveVideoScalerMethod "getCoeff" o = VideoScalerGetCoeffMethodInfo
    ResolveVideoScalerMethod "getMaxTaps" o = VideoScalerGetMaxTapsMethodInfo
    ResolveVideoScalerMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveVideoScalerMethod t VideoScaler, O.MethodInfo info VideoScaler p) => OL.IsLabel t (VideoScaler -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif