{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GstVideo.Structs.VideoResampler.VideoResampler' is a structure which holds the information
-- required to perform various kinds of resampling filtering.
-- 
-- /Since: 1.6/

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

module GI.GstVideo.Structs.VideoResampler
    ( 

-- * Exported types
    VideoResampler(..)                      ,
    newZeroVideoResampler                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [clear]("GI.GstVideo.Structs.VideoResampler#g:method:clear"), [init]("GI.GstVideo.Structs.VideoResampler#g:method:init").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoResamplerMethod             ,
#endif

-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    VideoResamplerClearMethodInfo           ,
#endif
    videoResamplerClear                     ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    VideoResamplerInitMethodInfo            ,
#endif
    videoResamplerInit                      ,




 -- * Properties


-- ** inSize #attr:inSize#
-- | the input size

    getVideoResamplerInSize                 ,
    setVideoResamplerInSize                 ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_inSize                   ,
#endif


-- ** maxTaps #attr:maxTaps#
-- | the maximum number of taps

    getVideoResamplerMaxTaps                ,
    setVideoResamplerMaxTaps                ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_maxTaps                  ,
#endif


-- ** nPhases #attr:nPhases#
-- | the number of phases

    getVideoResamplerNPhases                ,
    setVideoResamplerNPhases                ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_nPhases                  ,
#endif


-- ** nTaps #attr:nTaps#
-- | array with new number of taps for each phase

    getVideoResamplerNTaps                  ,
    setVideoResamplerNTaps                  ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_nTaps                    ,
#endif


-- ** offset #attr:offset#
-- | array with the source offset for each output element

    getVideoResamplerOffset                 ,
    setVideoResamplerOffset                 ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_offset                   ,
#endif


-- ** outSize #attr:outSize#
-- | the output size

    getVideoResamplerOutSize                ,
    setVideoResamplerOutSize                ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_outSize                  ,
#endif


-- ** phase #attr:phase#
-- | array with the phase to use for each output element

    getVideoResamplerPhase                  ,
    setVideoResamplerPhase                  ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_phase                    ,
#endif


-- ** taps #attr:taps#
-- | the taps for all phases

    getVideoResamplerTaps                   ,
    setVideoResamplerTaps                   ,
#if defined(ENABLE_OVERLOADING)
    videoResampler_taps                     ,
#endif




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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 Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 qualified GHC.Records as R

import qualified GI.Gst.Structs.Structure as Gst.Structure
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags

-- | Memory-managed wrapper type.
newtype VideoResampler = VideoResampler (SP.ManagedPtr VideoResampler)
    deriving (VideoResampler -> VideoResampler -> Bool
(VideoResampler -> VideoResampler -> Bool)
-> (VideoResampler -> VideoResampler -> Bool) -> Eq VideoResampler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VideoResampler -> VideoResampler -> Bool
== :: VideoResampler -> VideoResampler -> Bool
$c/= :: VideoResampler -> VideoResampler -> Bool
/= :: VideoResampler -> VideoResampler -> Bool
Eq)

instance SP.ManagedPtrNewtype VideoResampler where
    toManagedPtr :: VideoResampler -> ManagedPtr VideoResampler
toManagedPtr (VideoResampler ManagedPtr VideoResampler
p) = ManagedPtr VideoResampler
p

instance BoxedPtr VideoResampler where
    boxedPtrCopy :: VideoResampler -> IO VideoResampler
boxedPtrCopy = \VideoResampler
p -> VideoResampler
-> (Ptr VideoResampler -> IO VideoResampler) -> IO VideoResampler
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoResampler
p (Int -> Ptr VideoResampler -> IO (Ptr VideoResampler)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
80 (Ptr VideoResampler -> IO (Ptr VideoResampler))
-> (Ptr VideoResampler -> IO VideoResampler)
-> Ptr VideoResampler
-> IO VideoResampler
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr VideoResampler -> VideoResampler)
-> Ptr VideoResampler -> IO VideoResampler
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr VideoResampler -> VideoResampler
VideoResampler)
    boxedPtrFree :: VideoResampler -> IO ()
boxedPtrFree = \VideoResampler
x -> VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr VideoResampler
x Ptr VideoResampler -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr VideoResampler where
    boxedPtrCalloc :: IO (Ptr VideoResampler)
boxedPtrCalloc = Int -> IO (Ptr VideoResampler)
forall a. Int -> IO (Ptr a)
callocBytes Int
80


-- | Construct a `VideoResampler` struct initialized to zero.
newZeroVideoResampler :: MonadIO m => m VideoResampler
newZeroVideoResampler :: forall (m :: * -> *). MonadIO m => m VideoResampler
newZeroVideoResampler = IO VideoResampler -> m VideoResampler
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoResampler -> m VideoResampler)
-> IO VideoResampler -> m VideoResampler
forall a b. (a -> b) -> a -> b
$ IO (Ptr VideoResampler)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr VideoResampler)
-> (Ptr VideoResampler -> IO VideoResampler) -> IO VideoResampler
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoResampler -> VideoResampler)
-> Ptr VideoResampler -> IO VideoResampler
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoResampler -> VideoResampler
VideoResampler

instance tag ~ 'AttrSet => Constructible VideoResampler tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr VideoResampler -> VideoResampler)
-> [AttrOp VideoResampler tag] -> m VideoResampler
new ManagedPtr VideoResampler -> VideoResampler
_ [AttrOp VideoResampler tag]
attrs = do
        VideoResampler
o <- m VideoResampler
forall (m :: * -> *). MonadIO m => m VideoResampler
newZeroVideoResampler
        VideoResampler -> [AttrOp VideoResampler 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set VideoResampler
o [AttrOp VideoResampler tag]
[AttrOp VideoResampler 'AttrSet]
attrs
        VideoResampler -> m VideoResampler
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoResampler
o


-- | Get the value of the “@in_size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #inSize
-- @
getVideoResamplerInSize :: MonadIO m => VideoResampler -> m Int32
getVideoResamplerInSize :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Int32
getVideoResamplerInSize VideoResampler
s = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Int32) -> IO Int32)
-> (Ptr VideoResampler -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int32
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@in_size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #inSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerInSize :: MonadIO m => VideoResampler -> Int32 -> m ()
setVideoResamplerInSize :: forall (m :: * -> *). MonadIO m => VideoResampler -> Int32 -> m ()
setVideoResamplerInSize VideoResampler
s Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerInSizeFieldInfo
instance AttrInfo VideoResamplerInSizeFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerInSizeFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerInSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerInSizeFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoResamplerInSizeFieldInfo = (~)Int32
    type AttrTransferType VideoResamplerInSizeFieldInfo = Int32
    type AttrGetType VideoResamplerInSizeFieldInfo = Int32
    type AttrLabel VideoResamplerInSizeFieldInfo = "in_size"
    type AttrOrigin VideoResamplerInSizeFieldInfo = VideoResampler
    attrGet = getVideoResamplerInSize
    attrSet = setVideoResamplerInSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.inSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:inSize"
        })

videoResampler_inSize :: AttrLabelProxy "inSize"
videoResampler_inSize = AttrLabelProxy

#endif


-- | Get the value of the “@out_size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #outSize
-- @
getVideoResamplerOutSize :: MonadIO m => VideoResampler -> m Int32
getVideoResamplerOutSize :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Int32
getVideoResamplerOutSize VideoResampler
s = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Int32) -> IO Int32)
-> (Ptr VideoResampler -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO Int32
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@out_size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #outSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerOutSize :: MonadIO m => VideoResampler -> Int32 -> m ()
setVideoResamplerOutSize :: forall (m :: * -> *). MonadIO m => VideoResampler -> Int32 -> m ()
setVideoResamplerOutSize VideoResampler
s Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerOutSizeFieldInfo
instance AttrInfo VideoResamplerOutSizeFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerOutSizeFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerOutSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerOutSizeFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoResamplerOutSizeFieldInfo = (~)Int32
    type AttrTransferType VideoResamplerOutSizeFieldInfo = Int32
    type AttrGetType VideoResamplerOutSizeFieldInfo = Int32
    type AttrLabel VideoResamplerOutSizeFieldInfo = "out_size"
    type AttrOrigin VideoResamplerOutSizeFieldInfo = VideoResampler
    attrGet = getVideoResamplerOutSize
    attrSet = setVideoResamplerOutSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.outSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:outSize"
        })

videoResampler_outSize :: AttrLabelProxy "outSize"
videoResampler_outSize = AttrLabelProxy

#endif


-- | Get the value of the “@max_taps@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #maxTaps
-- @
getVideoResamplerMaxTaps :: MonadIO m => VideoResampler -> m Word32
getVideoResamplerMaxTaps :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Word32
getVideoResamplerMaxTaps VideoResampler
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ VideoResampler -> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Word32) -> IO Word32)
-> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@max_taps@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #maxTaps 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerMaxTaps :: MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerMaxTaps :: forall (m :: * -> *). MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerMaxTaps VideoResampler
s Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerMaxTapsFieldInfo
instance AttrInfo VideoResamplerMaxTapsFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerMaxTapsFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerMaxTapsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerMaxTapsFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoResamplerMaxTapsFieldInfo = (~)Word32
    type AttrTransferType VideoResamplerMaxTapsFieldInfo = Word32
    type AttrGetType VideoResamplerMaxTapsFieldInfo = Word32
    type AttrLabel VideoResamplerMaxTapsFieldInfo = "max_taps"
    type AttrOrigin VideoResamplerMaxTapsFieldInfo = VideoResampler
    attrGet = getVideoResamplerMaxTaps
    attrSet = setVideoResamplerMaxTaps
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.maxTaps"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:maxTaps"
        })

videoResampler_maxTaps :: AttrLabelProxy "maxTaps"
videoResampler_maxTaps = AttrLabelProxy

#endif


-- | Get the value of the “@n_phases@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #nPhases
-- @
getVideoResamplerNPhases :: MonadIO m => VideoResampler -> m Word32
getVideoResamplerNPhases :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Word32
getVideoResamplerNPhases VideoResampler
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ VideoResampler -> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Word32) -> IO Word32)
-> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@n_phases@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #nPhases 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerNPhases :: MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerNPhases :: forall (m :: * -> *). MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerNPhases VideoResampler
s Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerNPhasesFieldInfo
instance AttrInfo VideoResamplerNPhasesFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerNPhasesFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerNPhasesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerNPhasesFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoResamplerNPhasesFieldInfo = (~)Word32
    type AttrTransferType VideoResamplerNPhasesFieldInfo = Word32
    type AttrGetType VideoResamplerNPhasesFieldInfo = Word32
    type AttrLabel VideoResamplerNPhasesFieldInfo = "n_phases"
    type AttrOrigin VideoResamplerNPhasesFieldInfo = VideoResampler
    attrGet = getVideoResamplerNPhases
    attrSet = setVideoResamplerNPhases
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.nPhases"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:nPhases"
        })

videoResampler_nPhases :: AttrLabelProxy "nPhases"
videoResampler_nPhases = AttrLabelProxy

#endif


-- | Get the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #offset
-- @
getVideoResamplerOffset :: MonadIO m => VideoResampler -> m Word32
getVideoResamplerOffset :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Word32
getVideoResamplerOffset VideoResampler
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ VideoResampler -> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Word32) -> IO Word32)
-> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerOffset :: MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerOffset :: forall (m :: * -> *). MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerOffset VideoResampler
s Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerOffsetFieldInfo
instance AttrInfo VideoResamplerOffsetFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerOffsetFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerOffsetFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoResamplerOffsetFieldInfo = (~)Word32
    type AttrTransferType VideoResamplerOffsetFieldInfo = Word32
    type AttrGetType VideoResamplerOffsetFieldInfo = Word32
    type AttrLabel VideoResamplerOffsetFieldInfo = "offset"
    type AttrOrigin VideoResamplerOffsetFieldInfo = VideoResampler
    attrGet = getVideoResamplerOffset
    attrSet = setVideoResamplerOffset
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.offset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:offset"
        })

videoResampler_offset :: AttrLabelProxy "offset"
videoResampler_offset = AttrLabelProxy

#endif


-- | Get the value of the “@phase@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #phase
-- @
getVideoResamplerPhase :: MonadIO m => VideoResampler -> m Word32
getVideoResamplerPhase :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Word32
getVideoResamplerPhase VideoResampler
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ VideoResampler -> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Word32) -> IO Word32)
-> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@phase@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #phase 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerPhase :: MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerPhase :: forall (m :: * -> *). MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerPhase VideoResampler
s Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerPhaseFieldInfo
instance AttrInfo VideoResamplerPhaseFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerPhaseFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerPhaseFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerPhaseFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoResamplerPhaseFieldInfo = (~)Word32
    type AttrTransferType VideoResamplerPhaseFieldInfo = Word32
    type AttrGetType VideoResamplerPhaseFieldInfo = Word32
    type AttrLabel VideoResamplerPhaseFieldInfo = "phase"
    type AttrOrigin VideoResamplerPhaseFieldInfo = VideoResampler
    attrGet = getVideoResamplerPhase
    attrSet = setVideoResamplerPhase
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.phase"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:phase"
        })

videoResampler_phase :: AttrLabelProxy "phase"
videoResampler_phase = AttrLabelProxy

#endif


-- | Get the value of the “@n_taps@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #nTaps
-- @
getVideoResamplerNTaps :: MonadIO m => VideoResampler -> m Word32
getVideoResamplerNTaps :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Word32
getVideoResamplerNTaps VideoResampler
s = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ VideoResampler -> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Word32) -> IO Word32)
-> (Ptr VideoResampler -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@n_taps@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #nTaps 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerNTaps :: MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerNTaps :: forall (m :: * -> *). MonadIO m => VideoResampler -> Word32 -> m ()
setVideoResamplerNTaps VideoResampler
s Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerNTapsFieldInfo
instance AttrInfo VideoResamplerNTapsFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerNTapsFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerNTapsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerNTapsFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoResamplerNTapsFieldInfo = (~)Word32
    type AttrTransferType VideoResamplerNTapsFieldInfo = Word32
    type AttrGetType VideoResamplerNTapsFieldInfo = Word32
    type AttrLabel VideoResamplerNTapsFieldInfo = "n_taps"
    type AttrOrigin VideoResamplerNTapsFieldInfo = VideoResampler
    attrGet = getVideoResamplerNTaps
    attrSet = setVideoResamplerNTaps
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.nTaps"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:nTaps"
        })

videoResampler_nTaps :: AttrLabelProxy "nTaps"
videoResampler_nTaps = AttrLabelProxy

#endif


-- | Get the value of the “@taps@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoResampler #taps
-- @
getVideoResamplerTaps :: MonadIO m => VideoResampler -> m Double
getVideoResamplerTaps :: forall (m :: * -> *). MonadIO m => VideoResampler -> m Double
getVideoResamplerTaps VideoResampler
s = IO Double -> m Double
forall a. IO a -> m a
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
$ VideoResampler -> (Ptr VideoResampler -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO Double) -> IO Double)
-> (Ptr VideoResampler -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@taps@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoResampler [ #taps 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoResamplerTaps :: MonadIO m => VideoResampler -> Double -> m ()
setVideoResamplerTaps :: forall (m :: * -> *). MonadIO m => VideoResampler -> Double -> m ()
setVideoResamplerTaps VideoResampler
s Double
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoResampler -> (Ptr VideoResampler -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoResampler
s ((Ptr VideoResampler -> IO ()) -> IO ())
-> (Ptr VideoResampler -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoResampler
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoResampler
ptr Ptr VideoResampler -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data VideoResamplerTapsFieldInfo
instance AttrInfo VideoResamplerTapsFieldInfo where
    type AttrBaseTypeConstraint VideoResamplerTapsFieldInfo = (~) VideoResampler
    type AttrAllowedOps VideoResamplerTapsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoResamplerTapsFieldInfo = (~) Double
    type AttrTransferTypeConstraint VideoResamplerTapsFieldInfo = (~)Double
    type AttrTransferType VideoResamplerTapsFieldInfo = Double
    type AttrGetType VideoResamplerTapsFieldInfo = Double
    type AttrLabel VideoResamplerTapsFieldInfo = "taps"
    type AttrOrigin VideoResamplerTapsFieldInfo = VideoResampler
    attrGet = getVideoResamplerTaps
    attrSet = setVideoResamplerTaps
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.taps"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#g:attr:taps"
        })

videoResampler_taps :: AttrLabelProxy "taps"
videoResampler_taps = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoResampler
type instance O.AttributeList VideoResampler = VideoResamplerAttributeList
type VideoResamplerAttributeList = ('[ '("inSize", VideoResamplerInSizeFieldInfo), '("outSize", VideoResamplerOutSizeFieldInfo), '("maxTaps", VideoResamplerMaxTapsFieldInfo), '("nPhases", VideoResamplerNPhasesFieldInfo), '("offset", VideoResamplerOffsetFieldInfo), '("phase", VideoResamplerPhaseFieldInfo), '("nTaps", VideoResamplerNTapsFieldInfo), '("taps", VideoResamplerTapsFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method VideoResampler::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoResampler"
--                 , 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_resampler_clear" gst_video_resampler_clear :: 
    Ptr VideoResampler ->                   -- resampler : TInterface (Name {namespace = "GstVideo", name = "VideoResampler"})
    IO ()

-- | Clear a previously initialized t'GI.GstVideo.Structs.VideoResampler.VideoResampler' /@resampler@/.
-- 
-- /Since: 1.6/
videoResamplerClear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoResampler
    -- ^ /@resampler@/: a t'GI.GstVideo.Structs.VideoResampler.VideoResampler'
    -> m ()
videoResamplerClear :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoResampler -> m ()
videoResamplerClear VideoResampler
resampler = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoResampler
resampler' <- VideoResampler -> IO (Ptr VideoResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoResampler
resampler
    Ptr VideoResampler -> IO ()
gst_video_resampler_clear Ptr VideoResampler
resampler'
    VideoResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoResampler
resampler
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoResamplerClearMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoResamplerClearMethodInfo VideoResampler signature where
    overloadedMethod = videoResamplerClear

instance O.OverloadedMethodInfo VideoResamplerClearMethodInfo VideoResampler where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.videoResamplerClear",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#v:videoResamplerClear"
        })


#endif

-- method VideoResampler::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "method"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoResamplerMethod" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoResamplerFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_phases"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shift"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_resampler_init" gst_video_resampler_init :: 
    Ptr VideoResampler ->                   -- resampler : TInterface (Name {namespace = "GstVideo", name = "VideoResampler"})
    CUInt ->                                -- method : TInterface (Name {namespace = "GstVideo", name = "VideoResamplerMethod"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoResamplerFlags"})
    Word32 ->                               -- n_phases : TBasicType TUInt
    Word32 ->                               -- n_taps : TBasicType TUInt
    CDouble ->                              -- shift : TBasicType TDouble
    Word32 ->                               -- in_size : TBasicType TUInt
    Word32 ->                               -- out_size : TBasicType TUInt
    Ptr Gst.Structure.Structure ->          -- options : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | /No description available in the introspection data./
videoResamplerInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoResampler
    -> GstVideo.Enums.VideoResamplerMethod
    -> [GstVideo.Flags.VideoResamplerFlags]
    -> Word32
    -> Word32
    -> Double
    -> Word32
    -> Word32
    -> Gst.Structure.Structure
    -> m Bool
videoResamplerInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoResampler
-> VideoResamplerMethod
-> [VideoResamplerFlags]
-> Word32
-> Word32
-> Double
-> Word32
-> Word32
-> Structure
-> m Bool
videoResamplerInit VideoResampler
resampler VideoResamplerMethod
method [VideoResamplerFlags]
flags Word32
nPhases Word32
nTaps Double
shift Word32
inSize Word32
outSize Structure
options = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoResampler
resampler' <- VideoResampler -> IO (Ptr VideoResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoResampler
resampler
    let method' :: CUInt
method' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (VideoResamplerMethod -> Int) -> VideoResamplerMethod -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoResamplerMethod -> Int
forall a. Enum a => a -> Int
fromEnum) VideoResamplerMethod
method
    let flags' :: CUInt
flags' = [VideoResamplerFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoResamplerFlags]
flags
    let shift' :: CDouble
shift' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
shift
    Ptr Structure
options' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
options
    CInt
result <- Ptr VideoResampler
-> CUInt
-> CUInt
-> Word32
-> Word32
-> CDouble
-> Word32
-> Word32
-> Ptr Structure
-> IO CInt
gst_video_resampler_init Ptr VideoResampler
resampler' CUInt
method' CUInt
flags' Word32
nPhases Word32
nTaps CDouble
shift' Word32
inSize Word32
outSize Ptr Structure
options'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoResampler
resampler
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
options
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoResamplerInitMethodInfo
instance (signature ~ (GstVideo.Enums.VideoResamplerMethod -> [GstVideo.Flags.VideoResamplerFlags] -> Word32 -> Word32 -> Double -> Word32 -> Word32 -> Gst.Structure.Structure -> m Bool), MonadIO m) => O.OverloadedMethod VideoResamplerInitMethodInfo VideoResampler signature where
    overloadedMethod = videoResamplerInit

instance O.OverloadedMethodInfo VideoResamplerInitMethodInfo VideoResampler where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoResampler.videoResamplerInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoResampler.html#v:videoResamplerInit"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoResamplerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVideoResamplerMethod "clear" o = VideoResamplerClearMethodInfo
    ResolveVideoResamplerMethod "init" o = VideoResamplerInitMethodInfo
    ResolveVideoResamplerMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveVideoResamplerMethod t VideoResampler, O.OverloadedMethod info VideoResampler p, R.HasField t VideoResampler p) => R.HasField t VideoResampler p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveVideoResamplerMethod t VideoResampler, O.OverloadedMethodInfo info VideoResampler) => OL.IsLabel t (O.MethodProxy info VideoResampler) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif