{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gdk.Structs.FrameTimings.FrameTimings' object holds timing information for a single frame
-- of the application’s displays. To retrieve t'GI.Gdk.Structs.FrameTimings.FrameTimings' objects,
-- use 'GI.Gdk.Objects.FrameClock.frameClockGetTimings' or 'GI.Gdk.Objects.FrameClock.frameClockGetCurrentTimings'.
-- The information in t'GI.Gdk.Structs.FrameTimings.FrameTimings' is useful for precise synchronization
-- of video with the event or audio streams, and for measuring
-- quality metrics for the application’s display, such as latency and jitter.

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

module GI.Gdk.Structs.FrameTimings
    ( 

-- * Exported types
    FrameTimings(..)                        ,
    noFrameTimings                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFrameTimingsMethod               ,
#endif


-- ** getComplete #method:getComplete#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsGetCompleteMethodInfo       ,
#endif
    frameTimingsGetComplete                 ,


-- ** getFrameCounter #method:getFrameCounter#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsGetFrameCounterMethodInfo   ,
#endif
    frameTimingsGetFrameCounter             ,


-- ** getFrameTime #method:getFrameTime#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsGetFrameTimeMethodInfo      ,
#endif
    frameTimingsGetFrameTime                ,


-- ** getPredictedPresentationTime #method:getPredictedPresentationTime#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsGetPredictedPresentationTimeMethodInfo,
#endif
    frameTimingsGetPredictedPresentationTime,


-- ** getPresentationTime #method:getPresentationTime#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsGetPresentationTimeMethodInfo,
#endif
    frameTimingsGetPresentationTime         ,


-- ** getRefreshInterval #method:getRefreshInterval#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsGetRefreshIntervalMethodInfo,
#endif
    frameTimingsGetRefreshInterval          ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsRefMethodInfo               ,
#endif
    frameTimingsRef                         ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    FrameTimingsUnrefMethodInfo             ,
#endif
    frameTimingsUnref                       ,




    ) 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 FrameTimings = FrameTimings (ManagedPtr FrameTimings)
    deriving (FrameTimings -> FrameTimings -> Bool
(FrameTimings -> FrameTimings -> Bool)
-> (FrameTimings -> FrameTimings -> Bool) -> Eq FrameTimings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameTimings -> FrameTimings -> Bool
$c/= :: FrameTimings -> FrameTimings -> Bool
== :: FrameTimings -> FrameTimings -> Bool
$c== :: FrameTimings -> FrameTimings -> Bool
Eq)
foreign import ccall "gdk_frame_timings_get_type" c_gdk_frame_timings_get_type :: 
    IO GType

instance BoxedObject FrameTimings where
    boxedType :: FrameTimings -> IO GType
boxedType _ = IO GType
c_gdk_frame_timings_get_type

-- | Convert 'FrameTimings' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue FrameTimings where
    toGValue :: FrameTimings -> IO GValue
toGValue o :: FrameTimings
o = do
        GType
gtype <- IO GType
c_gdk_frame_timings_get_type
        FrameTimings -> (Ptr FrameTimings -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FrameTimings
o (GType
-> (GValue -> Ptr FrameTimings -> IO ())
-> Ptr FrameTimings
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr FrameTimings -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO FrameTimings
fromGValue gv :: GValue
gv = do
        Ptr FrameTimings
ptr <- GValue -> IO (Ptr FrameTimings)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr FrameTimings)
        (ManagedPtr FrameTimings -> FrameTimings)
-> Ptr FrameTimings -> IO FrameTimings
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr FrameTimings -> FrameTimings
FrameTimings Ptr FrameTimings
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `FrameTimings`.
noFrameTimings :: Maybe FrameTimings
noFrameTimings :: Maybe FrameTimings
noFrameTimings = Maybe FrameTimings
forall a. Maybe a
Nothing


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

-- method FrameTimings::get_complete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "timings"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "FrameTimings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkFrameTimings" , 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 "gdk_frame_timings_get_complete" gdk_frame_timings_get_complete :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO CInt

-- | The timing information in a t'GI.Gdk.Structs.FrameTimings.FrameTimings' is filled in
-- incrementally as the frame as drawn and passed off to the
-- window system for processing and display to the user. The
-- accessor functions for t'GI.Gdk.Structs.FrameTimings.FrameTimings' can return 0 to
-- indicate an unavailable value for two reasons: either because
-- the information is not yet available, or because it isn\'t
-- available at all. Once 'GI.Gdk.Structs.FrameTimings.frameTimingsGetComplete' returns
-- 'P.True' for a frame, you can be certain that no further values
-- will become available and be stored in the t'GI.Gdk.Structs.FrameTimings.FrameTimings'.
frameTimingsGetComplete ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if all information that will be available
    --  for the frame has been filled in.
frameTimingsGetComplete :: FrameTimings -> m Bool
frameTimingsGetComplete timings :: FrameTimings
timings = 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 FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    CInt
result <- Ptr FrameTimings -> IO CInt
gdk_frame_timings_get_complete Ptr FrameTimings
timings'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FrameTimingsGetCompleteMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo FrameTimingsGetCompleteMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsGetComplete

#endif

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

foreign import ccall "gdk_frame_timings_get_frame_counter" gdk_frame_timings_get_frame_counter :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO Int64

-- | Gets the frame counter value of the t'GI.Gdk.Objects.FrameClock.FrameClock' when this
-- this frame was drawn.
frameTimingsGetFrameCounter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m Int64
    -- ^ __Returns:__ the frame counter value for this frame
frameTimingsGetFrameCounter :: FrameTimings -> m Int64
frameTimingsGetFrameCounter timings :: FrameTimings
timings = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Int64
result <- Ptr FrameTimings -> IO Int64
gdk_frame_timings_get_frame_counter Ptr FrameTimings
timings'
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data FrameTimingsGetFrameCounterMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo FrameTimingsGetFrameCounterMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsGetFrameCounter

#endif

-- method FrameTimings::get_frame_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "timings"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "FrameTimings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GdkFrameTimings" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_frame_timings_get_frame_time" gdk_frame_timings_get_frame_time :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO Int64

-- | Returns the frame time for the frame. This is the time value
-- that is typically used to time animations for the frame. See
-- 'GI.Gdk.Objects.FrameClock.frameClockGetFrameTime'.
frameTimingsGetFrameTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: A t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m Int64
    -- ^ __Returns:__ the frame time for the frame, in the timescale
    --  of 'GI.GLib.Functions.getMonotonicTime'
frameTimingsGetFrameTime :: FrameTimings -> m Int64
frameTimingsGetFrameTime timings :: FrameTimings
timings = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Int64
result <- Ptr FrameTimings -> IO Int64
gdk_frame_timings_get_frame_time Ptr FrameTimings
timings'
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data FrameTimingsGetFrameTimeMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo FrameTimingsGetFrameTimeMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsGetFrameTime

#endif

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

foreign import ccall "gdk_frame_timings_get_predicted_presentation_time" gdk_frame_timings_get_predicted_presentation_time :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO Int64

-- | Gets the predicted time at which this frame will be displayed. Although
-- no predicted time may be available, if one is available, it will
-- be available while the frame is being generated, in contrast to
-- 'GI.Gdk.Structs.FrameTimings.frameTimingsGetPresentationTime', which is only available
-- after the frame has been presented. In general, if you are simply
-- animating, you should use 'GI.Gdk.Objects.FrameClock.frameClockGetFrameTime' rather
-- than this function, but this function is useful for applications
-- that want exact control over latency. For example, a movie player
-- may want this information for Audio\/Video synchronization.
frameTimingsGetPredictedPresentationTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m Int64
    -- ^ __Returns:__ The predicted time at which the frame will be presented,
    --  in the timescale of 'GI.GLib.Functions.getMonotonicTime', or 0 if no predicted
    --  presentation time is available.
frameTimingsGetPredictedPresentationTime :: FrameTimings -> m Int64
frameTimingsGetPredictedPresentationTime timings :: FrameTimings
timings = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Int64
result <- Ptr FrameTimings -> IO Int64
gdk_frame_timings_get_predicted_presentation_time Ptr FrameTimings
timings'
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data FrameTimingsGetPredictedPresentationTimeMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo FrameTimingsGetPredictedPresentationTimeMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsGetPredictedPresentationTime

#endif

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

foreign import ccall "gdk_frame_timings_get_presentation_time" gdk_frame_timings_get_presentation_time :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO Int64

-- | Reurns the presentation time. This is the time at which the frame
-- became visible to the user.
frameTimingsGetPresentationTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m Int64
    -- ^ __Returns:__ the time the frame was displayed to the user, in the
    --  timescale of 'GI.GLib.Functions.getMonotonicTime', or 0 if no presentation
    --  time is available. See 'GI.Gdk.Structs.FrameTimings.frameTimingsGetComplete'
frameTimingsGetPresentationTime :: FrameTimings -> m Int64
frameTimingsGetPresentationTime timings :: FrameTimings
timings = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Int64
result <- Ptr FrameTimings -> IO Int64
gdk_frame_timings_get_presentation_time Ptr FrameTimings
timings'
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data FrameTimingsGetPresentationTimeMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo FrameTimingsGetPresentationTimeMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsGetPresentationTime

#endif

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

foreign import ccall "gdk_frame_timings_get_refresh_interval" gdk_frame_timings_get_refresh_interval :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO Int64

-- | Gets the natural interval between presentation times for
-- the display that this frame was displayed on. Frame presentation
-- usually happens during the “vertical blanking interval”.
frameTimingsGetRefreshInterval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m Int64
    -- ^ __Returns:__ the refresh interval of the display, in microseconds,
    --  or 0 if the refresh interval is not available.
    --  See 'GI.Gdk.Structs.FrameTimings.frameTimingsGetComplete'.
frameTimingsGetRefreshInterval :: FrameTimings -> m Int64
frameTimingsGetRefreshInterval timings :: FrameTimings
timings = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Int64
result <- Ptr FrameTimings -> IO Int64
gdk_frame_timings_get_refresh_interval Ptr FrameTimings
timings'
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data FrameTimingsGetRefreshIntervalMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo FrameTimingsGetRefreshIntervalMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsGetRefreshInterval

#endif

-- method FrameTimings::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "timings"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "FrameTimings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkFrameTimings" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "FrameTimings" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_frame_timings_ref" gdk_frame_timings_ref :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO (Ptr FrameTimings)

-- | Increases the reference count of /@timings@/.
frameTimingsRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m FrameTimings
    -- ^ __Returns:__ /@timings@/
frameTimingsRef :: FrameTimings -> m FrameTimings
frameTimingsRef timings :: FrameTimings
timings = IO FrameTimings -> m FrameTimings
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FrameTimings -> m FrameTimings)
-> IO FrameTimings -> m FrameTimings
forall a b. (a -> b) -> a -> b
$ do
    Ptr FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Ptr FrameTimings
result <- Ptr FrameTimings -> IO (Ptr FrameTimings)
gdk_frame_timings_ref Ptr FrameTimings
timings'
    Text -> Ptr FrameTimings -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "frameTimingsRef" Ptr FrameTimings
result
    FrameTimings
result' <- ((ManagedPtr FrameTimings -> FrameTimings)
-> Ptr FrameTimings -> IO FrameTimings
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FrameTimings -> FrameTimings
FrameTimings) Ptr FrameTimings
result
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    FrameTimings -> IO FrameTimings
forall (m :: * -> *) a. Monad m => a -> m a
return FrameTimings
result'

#if defined(ENABLE_OVERLOADING)
data FrameTimingsRefMethodInfo
instance (signature ~ (m FrameTimings), MonadIO m) => O.MethodInfo FrameTimingsRefMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsRef

#endif

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

foreign import ccall "gdk_frame_timings_unref" gdk_frame_timings_unref :: 
    Ptr FrameTimings ->                     -- timings : TInterface (Name {namespace = "Gdk", name = "FrameTimings"})
    IO ()

-- | Decreases the reference count of /@timings@/. If /@timings@/
-- is no longer referenced, it will be freed.
frameTimingsUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FrameTimings
    -- ^ /@timings@/: a t'GI.Gdk.Structs.FrameTimings.FrameTimings'
    -> m ()
frameTimingsUnref :: FrameTimings -> m ()
frameTimingsUnref timings :: FrameTimings
timings = 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 FrameTimings
timings' <- FrameTimings -> IO (Ptr FrameTimings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FrameTimings
timings
    Ptr FrameTimings -> IO ()
gdk_frame_timings_unref Ptr FrameTimings
timings'
    FrameTimings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FrameTimings
timings
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FrameTimingsUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FrameTimingsUnrefMethodInfo FrameTimings signature where
    overloadedMethod = frameTimingsUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFrameTimingsMethod (t :: Symbol) (o :: *) :: * where
    ResolveFrameTimingsMethod "ref" o = FrameTimingsRefMethodInfo
    ResolveFrameTimingsMethod "unref" o = FrameTimingsUnrefMethodInfo
    ResolveFrameTimingsMethod "getComplete" o = FrameTimingsGetCompleteMethodInfo
    ResolveFrameTimingsMethod "getFrameCounter" o = FrameTimingsGetFrameCounterMethodInfo
    ResolveFrameTimingsMethod "getFrameTime" o = FrameTimingsGetFrameTimeMethodInfo
    ResolveFrameTimingsMethod "getPredictedPresentationTime" o = FrameTimingsGetPredictedPresentationTimeMethodInfo
    ResolveFrameTimingsMethod "getPresentationTime" o = FrameTimingsGetPresentationTimeMethodInfo
    ResolveFrameTimingsMethod "getRefreshInterval" o = FrameTimingsGetRefreshIntervalMethodInfo
    ResolveFrameTimingsMethod l o = O.MethodResolutionFailed l o

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

#endif