{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gst.Objects.ControlSource.ControlSource' is a base class for control value sources that could
-- be used to get timestamp-value pairs. A control source essentially is a
-- function over time.
-- 
-- A t'GI.Gst.Objects.ControlSource.ControlSource' is used by first getting an instance of a specific
-- control-source, creating a binding for the control-source to the target property
-- of the element and then adding the binding to the element. The binding will
-- convert the data types and value range to fit to the bound property.
-- 
-- For implementing a new t'GI.Gst.Objects.ControlSource.ControlSource' one has to implement
-- t'GI.Gst.Callbacks.ControlSourceGetValue' and t'GI.Gst.Callbacks.ControlSourceGetValueArray' functions.
-- These are then used by 'GI.Gst.Objects.ControlSource.controlSourceControlSourceGetValue' and
-- 'GI.Gst.Objects.ControlSource.controlSourceControlSourceGetValueArray' to get values for specific timestamps.

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

module GI.Gst.Objects.ControlSource
    ( 

-- * Exported types
    ControlSource(..)                       ,
    IsControlSource                         ,
    toControlSource                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [controlSourceGetValue]("GI.Gst.Objects.ControlSource#g:method:controlSourceGetValue"), [controlSourceGetValueArray]("GI.Gst.Objects.ControlSource#g:method:controlSourceGetValueArray"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveControlSourceMethod              ,
#endif

-- ** controlSourceGetValue #method:controlSourceGetValue#

#if defined(ENABLE_OVERLOADING)
    ControlSourceControlSourceGetValueMethodInfo,
#endif
    controlSourceControlSourceGetValue      ,


-- ** controlSourceGetValueArray #method:controlSourceGetValueArray#

#if defined(ENABLE_OVERLOADING)
    ControlSourceControlSourceGetValueArrayMethodInfo,
#endif
    controlSourceControlSourceGetValueArray ,




    ) 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.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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object

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

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

foreign import ccall "gst_control_source_get_type"
    c_gst_control_source_get_type :: IO B.Types.GType

instance B.Types.TypedObject ControlSource where
    glibType :: IO GType
glibType = IO GType
c_gst_control_source_get_type

instance B.Types.GObject ControlSource

-- | Type class for types which can be safely cast to `ControlSource`, for instance with `toControlSource`.
class (SP.GObject o, O.IsDescendantOf ControlSource o) => IsControlSource o
instance (SP.GObject o, O.IsDescendantOf ControlSource o) => IsControlSource o

instance O.HasParentTypes ControlSource
type instance O.ParentTypes ControlSource = '[Gst.Object.Object, GObject.Object.Object]

-- | Cast to `ControlSource`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toControlSource :: (MIO.MonadIO m, IsControlSource o) => o -> m ControlSource
toControlSource :: forall (m :: * -> *) o.
(MonadIO m, IsControlSource o) =>
o -> m ControlSource
toControlSource = IO ControlSource -> m ControlSource
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ControlSource -> m ControlSource)
-> (o -> IO ControlSource) -> o -> m ControlSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ControlSource -> ControlSource)
-> o -> IO ControlSource
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ControlSource -> ControlSource
ControlSource

-- | Convert 'ControlSource' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe ControlSource) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_control_source_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ControlSource -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ControlSource
P.Nothing = Ptr GValue -> Ptr ControlSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ControlSource
forall a. Ptr a
FP.nullPtr :: FP.Ptr ControlSource)
    gvalueSet_ Ptr GValue
gv (P.Just ControlSource
obj) = ControlSource -> (Ptr ControlSource -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ControlSource
obj (Ptr GValue -> Ptr ControlSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ControlSource)
gvalueGet_ Ptr GValue
gv = do
        Ptr ControlSource
ptr <- Ptr GValue -> IO (Ptr ControlSource)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ControlSource)
        if Ptr ControlSource
ptr Ptr ControlSource -> Ptr ControlSource -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ControlSource
forall a. Ptr a
FP.nullPtr
        then ControlSource -> Maybe ControlSource
forall a. a -> Maybe a
P.Just (ControlSource -> Maybe ControlSource)
-> IO ControlSource -> IO (Maybe ControlSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ControlSource -> ControlSource)
-> Ptr ControlSource -> IO ControlSource
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ControlSource -> ControlSource
ControlSource Ptr ControlSource
ptr
        else Maybe ControlSource -> IO (Maybe ControlSource)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ControlSource
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveControlSourceMethod (t :: Symbol) (o :: *) :: * where
    ResolveControlSourceMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveControlSourceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveControlSourceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveControlSourceMethod "controlSourceGetValue" o = ControlSourceControlSourceGetValueMethodInfo
    ResolveControlSourceMethod "controlSourceGetValueArray" o = ControlSourceControlSourceGetValueArrayMethodInfo
    ResolveControlSourceMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveControlSourceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveControlSourceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveControlSourceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveControlSourceMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveControlSourceMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveControlSourceMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveControlSourceMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveControlSourceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveControlSourceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveControlSourceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveControlSourceMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveControlSourceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveControlSourceMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveControlSourceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveControlSourceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveControlSourceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveControlSourceMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveControlSourceMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveControlSourceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveControlSourceMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveControlSourceMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveControlSourceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveControlSourceMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveControlSourceMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveControlSourceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveControlSourceMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveControlSourceMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveControlSourceMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveControlSourceMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveControlSourceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveControlSourceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveControlSourceMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveControlSourceMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveControlSourceMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveControlSourceMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveControlSourceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveControlSourceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveControlSourceMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveControlSourceMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveControlSourceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveControlSourceMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveControlSourceMethod t ControlSource, O.OverloadedMethod info ControlSource p) => OL.IsLabel t (ControlSource -> 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 ~ ResolveControlSourceMethod t ControlSource, O.OverloadedMethod info ControlSource p, R.HasField t ControlSource p) => R.HasField t ControlSource p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ControlSource
type instance O.AttributeList ControlSource = ControlSourceAttributeList
type ControlSourceAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ControlSource = ControlSourceSignalList
type ControlSourceSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method ControlSource::control_source_get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ControlSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstControlSource object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the time for which the value should be returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_control_source_get_value" gst_control_source_get_value :: 
    Ptr ControlSource ->                    -- self : TInterface (Name {namespace = "Gst", name = "ControlSource"})
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Gets the value for this t'GI.Gst.Objects.ControlSource.ControlSource' at a given timestamp.
controlSourceControlSourceGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsControlSource a) =>
    a
    -- ^ /@self@/: the t'GI.Gst.Objects.ControlSource.ControlSource' object
    -> Word64
    -- ^ /@timestamp@/: the time for which the value should be returned
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.False' if the value couldn\'t be returned, 'P.True' otherwise.
controlSourceControlSourceGetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsControlSource a) =>
a -> Word64 -> m (Bool, Double)
controlSourceControlSourceGetValue a
self Word64
timestamp = IO (Bool, Double) -> m (Bool, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ControlSource
self' <- a -> IO (Ptr ControlSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr ControlSource -> Word64 -> Ptr CDouble -> IO CInt
gst_control_source_get_value Ptr ControlSource
self' Word64
timestamp Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
value'')

#if defined(ENABLE_OVERLOADING)
data ControlSourceControlSourceGetValueMethodInfo
instance (signature ~ (Word64 -> m ((Bool, Double))), MonadIO m, IsControlSource a) => O.OverloadedMethod ControlSourceControlSourceGetValueMethodInfo a signature where
    overloadedMethod = controlSourceControlSourceGetValue

instance O.OverloadedMethodInfo ControlSourceControlSourceGetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.ControlSource.controlSourceControlSourceGetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-ControlSource.html#v:controlSourceControlSourceGetValue"
        })


#endif

-- method ControlSource::control_source_get_value_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ControlSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstControlSource object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first timestamp"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the time steps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_values"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of values to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 3 (TBasicType TDouble)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array to put control-values in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_values"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of values to fetch"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_control_source_get_value_array" gst_control_source_get_value_array :: 
    Ptr ControlSource ->                    -- self : TInterface (Name {namespace = "Gst", name = "ControlSource"})
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Word64 ->                               -- interval : TBasicType TUInt64
    Word32 ->                               -- n_values : TBasicType TUInt
    Ptr CDouble ->                          -- values : TCArray False (-1) 3 (TBasicType TDouble)
    IO CInt

-- | Gets an array of values for for this t'GI.Gst.Objects.ControlSource.ControlSource'. Values that are
-- undefined contain NANs.
controlSourceControlSourceGetValueArray ::
    (B.CallStack.HasCallStack, MonadIO m, IsControlSource a) =>
    a
    -- ^ /@self@/: the t'GI.Gst.Objects.ControlSource.ControlSource' object
    -> Word64
    -- ^ /@timestamp@/: the first timestamp
    -> Word64
    -- ^ /@interval@/: the time steps
    -> [Double]
    -- ^ /@values@/: array to put control-values in
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the given array could be filled, 'P.False' otherwise
controlSourceControlSourceGetValueArray :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsControlSource a) =>
a -> Word64 -> Word64 -> [Double] -> m Bool
controlSourceControlSourceGetValueArray a
self Word64
timestamp Word64
interval [Double]
values = 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
    let nValues :: Word32
nValues = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Double]
values
    Ptr ControlSource
self' <- a -> IO (Ptr ControlSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CDouble
values' <- ((Double -> CDouble) -> [Double] -> IO (Ptr CDouble)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Double]
values
    CInt
result <- Ptr ControlSource
-> Word64 -> Word64 -> Word32 -> Ptr CDouble -> IO CInt
gst_control_source_get_value_array Ptr ControlSource
self' Word64
timestamp Word64
interval Word32
nValues Ptr CDouble
values'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
values'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ControlSourceControlSourceGetValueArrayMethodInfo
instance (signature ~ (Word64 -> Word64 -> [Double] -> m Bool), MonadIO m, IsControlSource a) => O.OverloadedMethod ControlSourceControlSourceGetValueArrayMethodInfo a signature where
    overloadedMethod = controlSourceControlSourceGetValueArray

instance O.OverloadedMethodInfo ControlSourceControlSourceGetValueArrayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.ControlSource.controlSourceControlSourceGetValueArray",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Objects-ControlSource.html#v:controlSourceControlSourceGetValueArray"
        })


#endif