{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.GstAudio.Structs.AudioChannelMixer
    ( 

-- * Exported types
    AudioChannelMixer(..)                   ,
    noAudioChannelMixer                     ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioChannelMixerMethod          ,
#endif


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    AudioChannelMixerFreeMethodInfo         ,
#endif
    audioChannelMixerFree                   ,


-- ** isPassthrough #method:isPassthrough#

#if defined(ENABLE_OVERLOADING)
    AudioChannelMixerIsPassthroughMethodInfo,
#endif
    audioChannelMixerIsPassthrough          ,


-- ** samples #method:samples#

#if defined(ENABLE_OVERLOADING)
    AudioChannelMixerSamplesMethodInfo      ,
#endif
    audioChannelMixerSamples                ,




    ) 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


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

-- | A convenience alias for `Nothing` :: `Maybe` `AudioChannelMixer`.
noAudioChannelMixer :: Maybe AudioChannelMixer
noAudioChannelMixer :: Maybe AudioChannelMixer
noAudioChannelMixer = Maybe AudioChannelMixer
forall a. Maybe a
Nothing


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

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

foreign import ccall "gst_audio_channel_mixer_free" gst_audio_channel_mixer_free :: 
    Ptr AudioChannelMixer ->                -- mix : TInterface (Name {namespace = "GstAudio", name = "AudioChannelMixer"})
    IO ()

-- | Free memory allocated by /@mix@/.
audioChannelMixerFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioChannelMixer
    -- ^ /@mix@/: a t'GI.GstAudio.Structs.AudioChannelMixer.AudioChannelMixer'
    -> m ()
audioChannelMixerFree :: AudioChannelMixer -> m ()
audioChannelMixerFree mix :: AudioChannelMixer
mix = 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 AudioChannelMixer
mix' <- AudioChannelMixer -> IO (Ptr AudioChannelMixer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioChannelMixer
mix
    Ptr AudioChannelMixer -> IO ()
gst_audio_channel_mixer_free Ptr AudioChannelMixer
mix'
    AudioChannelMixer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioChannelMixer
mix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioChannelMixerFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AudioChannelMixerFreeMethodInfo AudioChannelMixer signature where
    overloadedMethod = audioChannelMixerFree

#endif

-- method AudioChannelMixer::is_passthrough
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mix"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioChannelMixer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioChannelMixer"
--                 , 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_audio_channel_mixer_is_passthrough" gst_audio_channel_mixer_is_passthrough :: 
    Ptr AudioChannelMixer ->                -- mix : TInterface (Name {namespace = "GstAudio", name = "AudioChannelMixer"})
    IO CInt

-- | Check if /@mix@/ is in passthrough.
-- 
-- Only N x N mix identity matrices are considered passthrough,
-- this is determined by comparing the contents of the matrix
-- with 0.0 and 1.0.
-- 
-- As this is floating point comparisons, if the values have been
-- generated, they should be rounded up or down by explicit
-- assignment of 0.0 or 1.0 to values within a user-defined
-- epsilon, this code doesn\'t make assumptions as to what may
-- constitute an appropriate epsilon.
audioChannelMixerIsPassthrough ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioChannelMixer
    -- ^ /@mix@/: a t'GI.GstAudio.Structs.AudioChannelMixer.AudioChannelMixer'
    -> m Bool
    -- ^ __Returns:__ 'P.True' is /@mix@/ is passthrough.
audioChannelMixerIsPassthrough :: AudioChannelMixer -> m Bool
audioChannelMixerIsPassthrough mix :: AudioChannelMixer
mix = IO Bool -> m Bool
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 AudioChannelMixer
mix' <- AudioChannelMixer -> IO (Ptr AudioChannelMixer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioChannelMixer
mix
    CInt
result <- Ptr AudioChannelMixer -> IO CInt
gst_audio_channel_mixer_is_passthrough Ptr AudioChannelMixer
mix'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    AudioChannelMixer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioChannelMixer
mix
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioChannelMixerIsPassthroughMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo AudioChannelMixerIsPassthroughMethodInfo AudioChannelMixer signature where
    overloadedMethod = audioChannelMixerIsPassthrough

#endif

-- method AudioChannelMixer::samples
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mix"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioChannelMixer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioChannelMixer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input samples" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output samples" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "samples"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of samples" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_channel_mixer_samples" gst_audio_channel_mixer_samples :: 
    Ptr AudioChannelMixer ->                -- mix : TInterface (Name {namespace = "GstAudio", name = "AudioChannelMixer"})
    Ptr () ->                               -- in : TBasicType TPtr
    Ptr () ->                               -- out : TBasicType TPtr
    Int32 ->                                -- samples : TBasicType TInt
    IO ()

-- | In case the samples are interleaved, /@in@/ and /@out@/ must point to an
-- array with a single element pointing to a block of interleaved samples.
-- 
-- If non-interleaved samples are used, /@in@/ and /@out@/ must point to an
-- array with pointers to memory blocks, one for each channel.
-- 
-- Perform channel mixing on /@inData@/ and write the result to /@outData@/.
-- /@inData@/ and /@outData@/ need to be in /@format@/ and /@layout@/.
audioChannelMixerSamples ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioChannelMixer
    -- ^ /@mix@/: a t'GI.GstAudio.Structs.AudioChannelMixer.AudioChannelMixer'
    -> Ptr ()
    -- ^ /@in@/: input samples
    -> Ptr ()
    -- ^ /@out@/: output samples
    -> Int32
    -- ^ /@samples@/: number of samples
    -> m ()
audioChannelMixerSamples :: AudioChannelMixer -> Ptr () -> Ptr () -> Int32 -> m ()
audioChannelMixerSamples mix :: AudioChannelMixer
mix in_ :: Ptr ()
in_ out :: Ptr ()
out samples :: Int32
samples = 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 AudioChannelMixer
mix' <- AudioChannelMixer -> IO (Ptr AudioChannelMixer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioChannelMixer
mix
    Ptr AudioChannelMixer -> Ptr () -> Ptr () -> Int32 -> IO ()
gst_audio_channel_mixer_samples Ptr AudioChannelMixer
mix' Ptr ()
in_ Ptr ()
out Int32
samples
    AudioChannelMixer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioChannelMixer
mix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioChannelMixerSamplesMethodInfo
instance (signature ~ (Ptr () -> Ptr () -> Int32 -> m ()), MonadIO m) => O.MethodInfo AudioChannelMixerSamplesMethodInfo AudioChannelMixer signature where
    overloadedMethod = audioChannelMixerSamples

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioChannelMixerMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioChannelMixerMethod "free" o = AudioChannelMixerFreeMethodInfo
    ResolveAudioChannelMixerMethod "isPassthrough" o = AudioChannelMixerIsPassthroughMethodInfo
    ResolveAudioChannelMixerMethod "samples" o = AudioChannelMixerSamplesMethodInfo
    ResolveAudioChannelMixerMethod l o = O.MethodResolutionFailed l o

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

#endif