{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This helper structure holds the relevant values for tracking the region of
-- interest in a media file, called a segment.
-- 
-- The structure can be used for two purposes:
-- 
--   * performing seeks (handling seek events)
--   * tracking playback regions (handling newsegment events)
-- 
-- The segment is usually configured by the application with a seek event which
-- is propagated upstream and eventually handled by an element that performs the seek.
-- 
-- The configured segment is then propagated back downstream with a newsegment event.
-- This information is then used to clip media to the segment boundaries.
-- 
-- A segment structure is initialized with 'GI.Gst.Structs.Segment.segmentInit', which takes a t'GI.Gst.Enums.Format'
-- that will be used as the format of the segment values. The segment will be configured
-- with a start value of 0 and a stop\/duration of -1, which is undefined. The default
-- rate and applied_rate is 1.0.
-- 
-- The public duration field contains the duration of the segment. When using
-- the segment for seeking, the start and time members should normally be left
-- to their default 0 value. The stop position is left to -1 unless explicitly
-- configured to a different value after a seek event.
-- 
-- The current position in the segment should be set by changing the position
-- member in the structure.
-- 
-- For elements that perform seeks, the current segment should be updated with the
-- 'GI.Gst.Structs.Segment.segmentDoSeek' and the values from the seek event. This method will update
-- all the segment fields. The position field will contain the new playback position.
-- If the start_type was different from GST_SEEK_TYPE_NONE, playback continues from
-- the position position, possibly with updated flags or rate.
-- 
-- For elements that want to use t'GI.Gst.Structs.Segment.Segment' to track the playback region,
-- update the segment fields with the information from the newsegment event.
-- The 'GI.Gst.Structs.Segment.segmentClip' method can be used to check and clip
-- the media data to the segment boundaries.
-- 
-- For elements that want to synchronize to the pipeline clock, 'GI.Gst.Structs.Segment.segmentToRunningTime'
-- can be used to convert a timestamp to a value that can be used to synchronize
-- to the clock. This function takes into account the base as well as
-- any rate or applied_rate conversions.
-- 
-- For elements that need to perform operations on media data in stream_time,
-- 'GI.Gst.Structs.Segment.segmentToStreamTime' can be used to convert a timestamp and the segment
-- info to stream time (which is always between 0 and the duration of the stream).

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

module GI.Gst.Structs.Segment
    ( 

-- * Exported types
    Segment(..)                             ,
    newZeroSegment                          ,
    noSegment                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSegmentMethod                    ,
#endif


-- ** clip #method:clip#

#if defined(ENABLE_OVERLOADING)
    SegmentClipMethodInfo                   ,
#endif
    segmentClip                             ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    SegmentCopyMethodInfo                   ,
#endif
    segmentCopy                             ,


-- ** copyInto #method:copyInto#

#if defined(ENABLE_OVERLOADING)
    SegmentCopyIntoMethodInfo               ,
#endif
    segmentCopyInto                         ,


-- ** doSeek #method:doSeek#

#if defined(ENABLE_OVERLOADING)
    SegmentDoSeekMethodInfo                 ,
#endif
    segmentDoSeek                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    SegmentFreeMethodInfo                   ,
#endif
    segmentFree                             ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    SegmentInitMethodInfo                   ,
#endif
    segmentInit                             ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    SegmentIsEqualMethodInfo                ,
#endif
    segmentIsEqual                          ,


-- ** new #method:new#

    segmentNew                              ,


-- ** offsetRunningTime #method:offsetRunningTime#

#if defined(ENABLE_OVERLOADING)
    SegmentOffsetRunningTimeMethodInfo      ,
#endif
    segmentOffsetRunningTime                ,


-- ** positionFromRunningTime #method:positionFromRunningTime#

#if defined(ENABLE_OVERLOADING)
    SegmentPositionFromRunningTimeMethodInfo,
#endif
    segmentPositionFromRunningTime          ,


-- ** positionFromRunningTimeFull #method:positionFromRunningTimeFull#

#if defined(ENABLE_OVERLOADING)
    SegmentPositionFromRunningTimeFullMethodInfo,
#endif
    segmentPositionFromRunningTimeFull      ,


-- ** positionFromStreamTime #method:positionFromStreamTime#

#if defined(ENABLE_OVERLOADING)
    SegmentPositionFromStreamTimeMethodInfo ,
#endif
    segmentPositionFromStreamTime           ,


-- ** positionFromStreamTimeFull #method:positionFromStreamTimeFull#

#if defined(ENABLE_OVERLOADING)
    SegmentPositionFromStreamTimeFullMethodInfo,
#endif
    segmentPositionFromStreamTimeFull       ,


-- ** setRunningTime #method:setRunningTime#

#if defined(ENABLE_OVERLOADING)
    SegmentSetRunningTimeMethodInfo         ,
#endif
    segmentSetRunningTime                   ,


-- ** toPosition #method:toPosition#

#if defined(ENABLE_OVERLOADING)
    SegmentToPositionMethodInfo             ,
#endif
    segmentToPosition                       ,


-- ** toRunningTime #method:toRunningTime#

#if defined(ENABLE_OVERLOADING)
    SegmentToRunningTimeMethodInfo          ,
#endif
    segmentToRunningTime                    ,


-- ** toRunningTimeFull #method:toRunningTimeFull#

#if defined(ENABLE_OVERLOADING)
    SegmentToRunningTimeFullMethodInfo      ,
#endif
    segmentToRunningTimeFull                ,


-- ** toStreamTime #method:toStreamTime#

#if defined(ENABLE_OVERLOADING)
    SegmentToStreamTimeMethodInfo           ,
#endif
    segmentToStreamTime                     ,


-- ** toStreamTimeFull #method:toStreamTimeFull#

#if defined(ENABLE_OVERLOADING)
    SegmentToStreamTimeFullMethodInfo       ,
#endif
    segmentToStreamTimeFull                 ,




 -- * Properties
-- ** appliedRate #attr:appliedRate#
-- | the already applied rate to the segment

    getSegmentAppliedRate                   ,
#if defined(ENABLE_OVERLOADING)
    segment_appliedRate                     ,
#endif
    setSegmentAppliedRate                   ,


-- ** base #attr:base#
-- | the running time (plus elapsed time, see offset) of the segment start

    getSegmentBase                          ,
#if defined(ENABLE_OVERLOADING)
    segment_base                            ,
#endif
    setSegmentBase                          ,


-- ** duration #attr:duration#
-- | the duration of the stream

    getSegmentDuration                      ,
#if defined(ENABLE_OVERLOADING)
    segment_duration                        ,
#endif
    setSegmentDuration                      ,


-- ** flags #attr:flags#
-- | flags for this segment

    getSegmentFlags                         ,
#if defined(ENABLE_OVERLOADING)
    segment_flags                           ,
#endif
    setSegmentFlags                         ,


-- ** format #attr:format#
-- | the format of the segment values

    getSegmentFormat                        ,
#if defined(ENABLE_OVERLOADING)
    segment_format                          ,
#endif
    setSegmentFormat                        ,


-- ** offset #attr:offset#
-- | the amount (in buffer timestamps) that has already been elapsed in
--     the segment

    getSegmentOffset                        ,
#if defined(ENABLE_OVERLOADING)
    segment_offset                          ,
#endif
    setSegmentOffset                        ,


-- ** position #attr:position#
-- | the buffer timestamp position in the segment (used internally by
--     elements such as sources, demuxers or parsers to track progress)

    getSegmentPosition                      ,
#if defined(ENABLE_OVERLOADING)
    segment_position                        ,
#endif
    setSegmentPosition                      ,


-- ** rate #attr:rate#
-- | the playback rate of the segment

    getSegmentRate                          ,
#if defined(ENABLE_OVERLOADING)
    segment_rate                            ,
#endif
    setSegmentRate                          ,


-- ** start #attr:start#
-- | the start of the segment in buffer timestamp time (PTS)

    getSegmentStart                         ,
#if defined(ENABLE_OVERLOADING)
    segment_start                           ,
#endif
    setSegmentStart                         ,


-- ** stop #attr:stop#
-- | the stop of the segment in buffer timestamp time (PTS)

    getSegmentStop                          ,
#if defined(ENABLE_OVERLOADING)
    segment_stop                            ,
#endif
    setSegmentStop                          ,


-- ** time #attr:time#
-- | the stream time of the segment start

    getSegmentTime                          ,
#if defined(ENABLE_OVERLOADING)
    segment_time                            ,
#endif
    setSegmentTime                          ,




    ) where

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

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

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

-- | Memory-managed wrapper type.
newtype Segment = Segment (ManagedPtr Segment)
    deriving (Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c== :: Segment -> Segment -> Bool
Eq)
foreign import ccall "gst_segment_get_type" c_gst_segment_get_type :: 
    IO GType

instance BoxedObject Segment where
    boxedType :: Segment -> IO GType
boxedType _ = IO GType
c_gst_segment_get_type

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

-- | Construct a `Segment` struct initialized to zero.
newZeroSegment :: MonadIO m => m Segment
newZeroSegment :: m Segment
newZeroSegment = IO Segment -> m Segment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Segment -> m Segment) -> IO Segment -> m Segment
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Segment)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 120 IO (Ptr Segment) -> (Ptr Segment -> IO Segment) -> IO Segment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Segment -> Segment) -> Ptr Segment -> IO Segment
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Segment -> Segment
Segment

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


-- | A convenience alias for `Nothing` :: `Maybe` `Segment`.
noSegment :: Maybe Segment
noSegment :: Maybe Segment
noSegment = Maybe Segment
forall a. Maybe a
Nothing

-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' segment #flags
-- @
getSegmentFlags :: MonadIO m => Segment -> m [Gst.Flags.SegmentFlags]
getSegmentFlags :: Segment -> m [SegmentFlags]
getSegmentFlags s :: Segment
s = IO [SegmentFlags] -> m [SegmentFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SegmentFlags] -> m [SegmentFlags])
-> IO [SegmentFlags] -> m [SegmentFlags]
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO [SegmentFlags]) -> IO [SegmentFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO [SegmentFlags]) -> IO [SegmentFlags])
-> (Ptr Segment -> IO [SegmentFlags]) -> IO [SegmentFlags]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Segment
ptr Ptr Segment -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CUInt
    let val' :: [SegmentFlags]
val' = CUInt -> [SegmentFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [SegmentFlags] -> IO [SegmentFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [SegmentFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' segment [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setSegmentFlags :: MonadIO m => Segment -> [Gst.Flags.SegmentFlags] -> m ()
setSegmentFlags :: Segment -> [SegmentFlags] -> m ()
setSegmentFlags s :: Segment
s val :: [SegmentFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO ()) -> IO ())
-> (Ptr Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
ptr -> do
    let val' :: CUInt
val' = [SegmentFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SegmentFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Segment
ptr Ptr Segment -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data SegmentFlagsFieldInfo
instance AttrInfo SegmentFlagsFieldInfo where
    type AttrBaseTypeConstraint SegmentFlagsFieldInfo = (~) Segment
    type AttrAllowedOps SegmentFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentFlagsFieldInfo = (~) [Gst.Flags.SegmentFlags]
    type AttrTransferTypeConstraint SegmentFlagsFieldInfo = (~)[Gst.Flags.SegmentFlags]
    type AttrTransferType SegmentFlagsFieldInfo = [Gst.Flags.SegmentFlags]
    type AttrGetType SegmentFlagsFieldInfo = [Gst.Flags.SegmentFlags]
    type AttrLabel SegmentFlagsFieldInfo = "flags"
    type AttrOrigin SegmentFlagsFieldInfo = Segment
    attrGet = getSegmentFlags
    attrSet = setSegmentFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_flags :: AttrLabelProxy "flags"
segment_flags = AttrLabelProxy

#endif


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

-- | Set the value of the “@rate@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' segment [ #rate 'Data.GI.Base.Attributes.:=' value ]
-- @
setSegmentRate :: MonadIO m => Segment -> Double -> m ()
setSegmentRate :: Segment -> Double -> m ()
setSegmentRate s :: Segment
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO ()) -> IO ())
-> (Ptr Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
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 Segment
ptr Ptr Segment -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data SegmentRateFieldInfo
instance AttrInfo SegmentRateFieldInfo where
    type AttrBaseTypeConstraint SegmentRateFieldInfo = (~) Segment
    type AttrAllowedOps SegmentRateFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentRateFieldInfo = (~) Double
    type AttrTransferTypeConstraint SegmentRateFieldInfo = (~)Double
    type AttrTransferType SegmentRateFieldInfo = Double
    type AttrGetType SegmentRateFieldInfo = Double
    type AttrLabel SegmentRateFieldInfo = "rate"
    type AttrOrigin SegmentRateFieldInfo = Segment
    attrGet = getSegmentRate
    attrSet = setSegmentRate
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_rate :: AttrLabelProxy "rate"
segment_rate = AttrLabelProxy

#endif


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

-- | Set the value of the “@applied_rate@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' segment [ #appliedRate 'Data.GI.Base.Attributes.:=' value ]
-- @
setSegmentAppliedRate :: MonadIO m => Segment -> Double -> m ()
setSegmentAppliedRate :: Segment -> Double -> m ()
setSegmentAppliedRate s :: Segment
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO ()) -> IO ())
-> (Ptr Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
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 Segment
ptr Ptr Segment -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data SegmentAppliedRateFieldInfo
instance AttrInfo SegmentAppliedRateFieldInfo where
    type AttrBaseTypeConstraint SegmentAppliedRateFieldInfo = (~) Segment
    type AttrAllowedOps SegmentAppliedRateFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentAppliedRateFieldInfo = (~) Double
    type AttrTransferTypeConstraint SegmentAppliedRateFieldInfo = (~)Double
    type AttrTransferType SegmentAppliedRateFieldInfo = Double
    type AttrGetType SegmentAppliedRateFieldInfo = Double
    type AttrLabel SegmentAppliedRateFieldInfo = "applied_rate"
    type AttrOrigin SegmentAppliedRateFieldInfo = Segment
    attrGet = getSegmentAppliedRate
    attrSet = setSegmentAppliedRate
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_appliedRate :: AttrLabelProxy "appliedRate"
segment_appliedRate = AttrLabelProxy

#endif


-- | Get the value of the “@format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' segment #format
-- @
getSegmentFormat :: MonadIO m => Segment -> m Gst.Enums.Format
getSegmentFormat :: Segment -> m Format
getSegmentFormat s :: Segment
s = IO Format -> m Format
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Format -> m Format) -> IO Format -> m Format
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO Format) -> IO Format
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO Format) -> IO Format)
-> (Ptr Segment -> IO Format) -> IO Format
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Segment
ptr Ptr Segment -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) :: IO CUInt
    let val' :: Format
val' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    Format -> IO Format
forall (m :: * -> *) a. Monad m => a -> m a
return Format
val'

-- | Set the value of the “@format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' segment [ #format 'Data.GI.Base.Attributes.:=' value ]
-- @
setSegmentFormat :: MonadIO m => Segment -> Gst.Enums.Format -> m ()
setSegmentFormat :: Segment -> Format -> m ()
setSegmentFormat s :: Segment
s val :: Format
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO ()) -> IO ())
-> (Ptr Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Segment
ptr Ptr Segment -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data SegmentFormatFieldInfo
instance AttrInfo SegmentFormatFieldInfo where
    type AttrBaseTypeConstraint SegmentFormatFieldInfo = (~) Segment
    type AttrAllowedOps SegmentFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentFormatFieldInfo = (~) Gst.Enums.Format
    type AttrTransferTypeConstraint SegmentFormatFieldInfo = (~)Gst.Enums.Format
    type AttrTransferType SegmentFormatFieldInfo = Gst.Enums.Format
    type AttrGetType SegmentFormatFieldInfo = Gst.Enums.Format
    type AttrLabel SegmentFormatFieldInfo = "format"
    type AttrOrigin SegmentFormatFieldInfo = Segment
    attrGet = getSegmentFormat
    attrSet = setSegmentFormat
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_format :: AttrLabelProxy "format"
segment_format = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data SegmentBaseFieldInfo
instance AttrInfo SegmentBaseFieldInfo where
    type AttrBaseTypeConstraint SegmentBaseFieldInfo = (~) Segment
    type AttrAllowedOps SegmentBaseFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentBaseFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentBaseFieldInfo = (~)Word64
    type AttrTransferType SegmentBaseFieldInfo = Word64
    type AttrGetType SegmentBaseFieldInfo = Word64
    type AttrLabel SegmentBaseFieldInfo = "base"
    type AttrOrigin SegmentBaseFieldInfo = Segment
    attrGet = getSegmentBase
    attrSet = setSegmentBase
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_base :: AttrLabelProxy "base"
segment_base = 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' segment #offset
-- @
getSegmentOffset :: MonadIO m => Segment -> m Word64
getSegmentOffset :: Segment -> m Word64
getSegmentOffset s :: Segment
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO Word64) -> IO Word64)
-> (Ptr Segment -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Segment
ptr Ptr Segment -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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' segment [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setSegmentOffset :: MonadIO m => Segment -> Word64 -> m ()
setSegmentOffset :: Segment -> Word64 -> m ()
setSegmentOffset s :: Segment
s val :: Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Segment -> (Ptr Segment -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Segment
s ((Ptr Segment -> IO ()) -> IO ())
-> (Ptr Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Segment
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Segment
ptr Ptr Segment -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data SegmentOffsetFieldInfo
instance AttrInfo SegmentOffsetFieldInfo where
    type AttrBaseTypeConstraint SegmentOffsetFieldInfo = (~) Segment
    type AttrAllowedOps SegmentOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentOffsetFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentOffsetFieldInfo = (~)Word64
    type AttrTransferType SegmentOffsetFieldInfo = Word64
    type AttrGetType SegmentOffsetFieldInfo = Word64
    type AttrLabel SegmentOffsetFieldInfo = "offset"
    type AttrOrigin SegmentOffsetFieldInfo = Segment
    attrGet = getSegmentOffset
    attrSet = setSegmentOffset
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_offset :: AttrLabelProxy "offset"
segment_offset = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data SegmentStartFieldInfo
instance AttrInfo SegmentStartFieldInfo where
    type AttrBaseTypeConstraint SegmentStartFieldInfo = (~) Segment
    type AttrAllowedOps SegmentStartFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentStartFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentStartFieldInfo = (~)Word64
    type AttrTransferType SegmentStartFieldInfo = Word64
    type AttrGetType SegmentStartFieldInfo = Word64
    type AttrLabel SegmentStartFieldInfo = "start"
    type AttrOrigin SegmentStartFieldInfo = Segment
    attrGet = getSegmentStart
    attrSet = setSegmentStart
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_start :: AttrLabelProxy "start"
segment_start = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data SegmentStopFieldInfo
instance AttrInfo SegmentStopFieldInfo where
    type AttrBaseTypeConstraint SegmentStopFieldInfo = (~) Segment
    type AttrAllowedOps SegmentStopFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentStopFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentStopFieldInfo = (~)Word64
    type AttrTransferType SegmentStopFieldInfo = Word64
    type AttrGetType SegmentStopFieldInfo = Word64
    type AttrLabel SegmentStopFieldInfo = "stop"
    type AttrOrigin SegmentStopFieldInfo = Segment
    attrGet = getSegmentStop
    attrSet = setSegmentStop
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_stop :: AttrLabelProxy "stop"
segment_stop = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data SegmentTimeFieldInfo
instance AttrInfo SegmentTimeFieldInfo where
    type AttrBaseTypeConstraint SegmentTimeFieldInfo = (~) Segment
    type AttrAllowedOps SegmentTimeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentTimeFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentTimeFieldInfo = (~)Word64
    type AttrTransferType SegmentTimeFieldInfo = Word64
    type AttrGetType SegmentTimeFieldInfo = Word64
    type AttrLabel SegmentTimeFieldInfo = "time"
    type AttrOrigin SegmentTimeFieldInfo = Segment
    attrGet = getSegmentTime
    attrSet = setSegmentTime
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_time :: AttrLabelProxy "time"
segment_time = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data SegmentPositionFieldInfo
instance AttrInfo SegmentPositionFieldInfo where
    type AttrBaseTypeConstraint SegmentPositionFieldInfo = (~) Segment
    type AttrAllowedOps SegmentPositionFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentPositionFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentPositionFieldInfo = (~)Word64
    type AttrTransferType SegmentPositionFieldInfo = Word64
    type AttrGetType SegmentPositionFieldInfo = Word64
    type AttrLabel SegmentPositionFieldInfo = "position"
    type AttrOrigin SegmentPositionFieldInfo = Segment
    attrGet = getSegmentPosition
    attrSet = setSegmentPosition
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_position :: AttrLabelProxy "position"
segment_position = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data SegmentDurationFieldInfo
instance AttrInfo SegmentDurationFieldInfo where
    type AttrBaseTypeConstraint SegmentDurationFieldInfo = (~) Segment
    type AttrAllowedOps SegmentDurationFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SegmentDurationFieldInfo = (~) Word64
    type AttrTransferTypeConstraint SegmentDurationFieldInfo = (~)Word64
    type AttrTransferType SegmentDurationFieldInfo = Word64
    type AttrGetType SegmentDurationFieldInfo = Word64
    type AttrLabel SegmentDurationFieldInfo = "duration"
    type AttrOrigin SegmentDurationFieldInfo = Segment
    attrGet = getSegmentDuration
    attrSet = setSegmentDuration
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

segment_duration :: AttrLabelProxy "duration"
segment_duration = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Segment
type instance O.AttributeList Segment = SegmentAttributeList
type SegmentAttributeList = ('[ '("flags", SegmentFlagsFieldInfo), '("rate", SegmentRateFieldInfo), '("appliedRate", SegmentAppliedRateFieldInfo), '("format", SegmentFormatFieldInfo), '("base", SegmentBaseFieldInfo), '("offset", SegmentOffsetFieldInfo), '("start", SegmentStartFieldInfo), '("stop", SegmentStopFieldInfo), '("time", SegmentTimeFieldInfo), '("position", SegmentPositionFieldInfo), '("duration", SegmentDurationFieldInfo)] :: [(Symbol, *)])
#endif

-- method Segment::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Segment" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_new" gst_segment_new :: 
    IO (Ptr Segment)

-- | Allocate a new t'GI.Gst.Structs.Segment.Segment' structure and initialize it using
-- 'GI.Gst.Structs.Segment.segmentInit'.
-- 
-- Free-function: gst_segment_free
segmentNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Segment
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Segment.Segment', free with 'GI.Gst.Structs.Segment.segmentFree'.
segmentNew :: m Segment
segmentNew  = IO Segment -> m Segment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Segment -> m Segment) -> IO Segment -> m Segment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
result <- IO (Ptr Segment)
gst_segment_new
    Text -> Ptr Segment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "segmentNew" Ptr Segment
result
    Segment
result' <- ((ManagedPtr Segment -> Segment) -> Ptr Segment -> IO Segment
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Segment -> Segment
Segment) Ptr Segment
result
    Segment -> IO Segment
forall (m :: * -> *) a. Monad m => a -> m a
return Segment
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Segment::clip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the start position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stop position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clip_start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the clipped start position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "clip_stop"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the clipped stop position in the segment"
--                 , 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_segment_clip" gst_segment_clip :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- start : TBasicType TUInt64
    Word64 ->                               -- stop : TBasicType TUInt64
    Ptr Word64 ->                           -- clip_start : TBasicType TUInt64
    Ptr Word64 ->                           -- clip_stop : TBasicType TUInt64
    IO CInt

-- | Clip the given /@start@/ and /@stop@/ values to the segment boundaries given
-- in /@segment@/. /@start@/ and /@stop@/ are compared and clipped to /@segment@/
-- start and stop values.
-- 
-- If the function returns 'P.False', /@start@/ and /@stop@/ are known to fall
-- outside of /@segment@/ and /@clipStart@/ and /@clipStop@/ are not updated.
-- 
-- When the function returns 'P.True', /@clipStart@/ and /@clipStop@/ will be
-- updated. If /@clipStart@/ or /@clipStop@/ are different from /@start@/ or /@stop@/
-- respectively, the region fell partially in the segment.
-- 
-- Note that when /@stop@/ is -1, /@clipStop@/ will be set to the end of the
-- segment. Depending on the use case, this may or may not be what you want.
segmentClip ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@start@/: the start position in the segment
    -> Word64
    -- ^ /@stop@/: the stop position in the segment
    -> m ((Bool, Word64, Word64))
    -- ^ __Returns:__ 'P.True' if the given /@start@/ and /@stop@/ times fall partially or
    --     completely in /@segment@/, 'P.False' if the values are completely outside
    --     of the segment.
segmentClip :: Segment -> Format -> Word64 -> Word64 -> m (Bool, Word64, Word64)
segmentClip segment :: Segment
segment format :: Format
format start :: Word64
start stop :: Word64
stop = IO (Bool, Word64, Word64) -> m (Bool, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64, Word64) -> m (Bool, Word64, Word64))
-> IO (Bool, Word64, Word64) -> m (Bool, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Word64
clipStart <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
clipStop <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr Segment
-> CUInt -> Word64 -> Word64 -> Ptr Word64 -> Ptr Word64 -> IO CInt
gst_segment_clip Ptr Segment
segment' CUInt
format' Word64
start Word64
stop Ptr Word64
clipStart Ptr Word64
clipStop
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word64
clipStart' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
clipStart
    Word64
clipStop' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
clipStop
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
clipStart
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
clipStop
    (Bool, Word64, Word64) -> IO (Bool, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
clipStart', Word64
clipStop')

#if defined(ENABLE_OVERLOADING)
data SegmentClipMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> Word64 -> m ((Bool, Word64, Word64))), MonadIO m) => O.MethodInfo SegmentClipMethodInfo Segment signature where
    overloadedMethod = segmentClip

#endif

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

foreign import ccall "gst_segment_copy" gst_segment_copy :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO (Ptr Segment)

-- | Create a copy of given /@segment@/.
-- 
-- Free-function: gst_segment_free
segmentCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment'
    -> m Segment
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Segment.Segment', free with 'GI.Gst.Structs.Segment.segmentFree'.
segmentCopy :: Segment -> m Segment
segmentCopy segment :: Segment
segment = IO Segment -> m Segment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Segment -> m Segment) -> IO Segment -> m Segment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    Ptr Segment
result <- Ptr Segment -> IO (Ptr Segment)
gst_segment_copy Ptr Segment
segment'
    Text -> Ptr Segment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "segmentCopy" Ptr Segment
result
    Segment
result' <- ((ManagedPtr Segment -> Segment) -> Ptr Segment -> IO Segment
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Segment -> Segment
Segment) Ptr Segment
result
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Segment -> IO Segment
forall (m :: * -> *) a. Monad m => a -> m a
return Segment
result'

#if defined(ENABLE_OVERLOADING)
data SegmentCopyMethodInfo
instance (signature ~ (m Segment), MonadIO m) => O.MethodInfo SegmentCopyMethodInfo Segment signature where
    overloadedMethod = segmentCopy

#endif

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

foreign import ccall "gst_segment_copy_into" gst_segment_copy_into :: 
    Ptr Segment ->                          -- src : TInterface (Name {namespace = "Gst", name = "Segment"})
    Ptr Segment ->                          -- dest : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO ()

-- | Copy the contents of /@src@/ into /@dest@/.
segmentCopyInto ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@src@/: a t'GI.Gst.Structs.Segment.Segment'
    -> Segment
    -- ^ /@dest@/: a t'GI.Gst.Structs.Segment.Segment'
    -> m ()
segmentCopyInto :: Segment -> Segment -> m ()
segmentCopyInto src :: Segment
src dest :: Segment
dest = 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 Segment
src' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
src
    Ptr Segment
dest' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
dest
    Ptr Segment -> Ptr Segment -> IO ()
gst_segment_copy_into Ptr Segment
src' Ptr Segment
dest'
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
src
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
dest
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SegmentCopyIntoMethodInfo
instance (signature ~ (Segment -> m ()), MonadIO m) => O.MethodInfo SegmentCopyIntoMethodInfo Segment signature where
    overloadedMethod = segmentCopyInto

#endif

-- method Segment::do_seek
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rate of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment flags for the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seek method" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seek start value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SeekType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seek method" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seek stop value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "update"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "boolean holding whether position was updated."
--                 , 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_segment_do_seek" gst_segment_do_seek :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CDouble ->                              -- rate : TBasicType TDouble
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "SeekFlags"})
    CUInt ->                                -- start_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Word64 ->                               -- start : TBasicType TUInt64
    CUInt ->                                -- stop_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Word64 ->                               -- stop : TBasicType TUInt64
    Ptr CInt ->                             -- update : TBasicType TBoolean
    IO CInt

-- | Update the segment structure with the field values of a seek event (see
-- 'GI.Gst.Structs.Event.eventNewSeek').
-- 
-- After calling this method, the segment field position and time will
-- contain the requested new position in the segment. The new requested
-- position in the segment depends on /@rate@/ and /@startType@/ and /@stopType@/.
-- 
-- For positive /@rate@/, the new position in the segment is the new /@segment@/
-- start field when it was updated with a /@startType@/ different from
-- @/GST_SEEK_TYPE_NONE/@. If no update was performed on /@segment@/ start position
-- (@/GST_SEEK_TYPE_NONE/@), /@start@/ is ignored and /@segment@/ position is
-- unmodified.
-- 
-- For negative /@rate@/, the new position in the segment is the new /@segment@/
-- stop field when it was updated with a /@stopType@/ different from
-- @/GST_SEEK_TYPE_NONE/@. If no stop was previously configured in the segment, the
-- duration of the segment will be used to update the stop position.
-- If no update was performed on /@segment@/ stop position (@/GST_SEEK_TYPE_NONE/@),
-- /@stop@/ is ignored and /@segment@/ position is unmodified.
-- 
-- The applied rate of the segment will be set to 1.0 by default.
-- If the caller can apply a rate change, it should update /@segment@/
-- rate and applied_rate after calling this function.
-- 
-- /@update@/ will be set to 'P.True' if a seek should be performed to the segment
-- position field. This field can be 'P.False' if, for example, only the /@rate@/
-- has been changed but not the playback position.
segmentDoSeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Double
    -- ^ /@rate@/: the rate of the segment.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> [Gst.Flags.SeekFlags]
    -- ^ /@flags@/: the segment flags for the segment
    -> Gst.Enums.SeekType
    -- ^ /@startType@/: the seek method
    -> Word64
    -- ^ /@start@/: the seek start value
    -> Gst.Enums.SeekType
    -- ^ /@stopType@/: the seek method
    -> Word64
    -- ^ /@stop@/: the seek stop value
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' if the seek could be performed.
segmentDoSeek :: Segment
-> Double
-> Format
-> [SeekFlags]
-> SeekType
-> Word64
-> SeekType
-> Word64
-> m (Bool, Bool)
segmentDoSeek segment :: Segment
segment rate :: Double
rate format :: Format
format flags :: [SeekFlags]
flags startType :: SeekType
startType start :: Word64
start stopType :: SeekType
stopType stop :: Word64
stop = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let rate' :: CDouble
rate' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rate
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let flags' :: CUInt
flags' = [SeekFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SeekFlags]
flags
    let startType' :: CUInt
startType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
startType
    let stopType' :: CUInt
stopType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
stopType
    Ptr CInt
update <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr Segment
-> CDouble
-> CUInt
-> CUInt
-> CUInt
-> Word64
-> CUInt
-> Word64
-> Ptr CInt
-> IO CInt
gst_segment_do_seek Ptr Segment
segment' CDouble
rate' CUInt
format' CUInt
flags' CUInt
startType' Word64
start CUInt
stopType' Word64
stop Ptr CInt
update
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CInt
update' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
update
    let update'' :: Bool
update'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
update'
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
update
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
update'')

#if defined(ENABLE_OVERLOADING)
data SegmentDoSeekMethodInfo
instance (signature ~ (Double -> Gst.Enums.Format -> [Gst.Flags.SeekFlags] -> Gst.Enums.SeekType -> Word64 -> Gst.Enums.SeekType -> Word64 -> m ((Bool, Bool))), MonadIO m) => O.MethodInfo SegmentDoSeekMethodInfo Segment signature where
    overloadedMethod = segmentDoSeek

#endif

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

foreign import ccall "gst_segment_free" gst_segment_free :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO ()

-- | Free the allocated segment /@segment@/.
segmentFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment'
    -> m ()
segmentFree :: Segment -> m ()
segmentFree segment :: Segment
segment = 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 Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Segment
segment
    Ptr Segment -> IO ()
gst_segment_free Ptr Segment
segment'
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SegmentFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo SegmentFreeMethodInfo Segment signature where
    overloadedMethod = segmentFree

#endif

-- method Segment::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_init" gst_segment_init :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO ()

-- | The start\/position fields are set to 0 and the stop\/duration
-- fields are set to -1 (unknown). The default rate of 1.0 and no
-- flags are set.
-- 
-- Initialize /@segment@/ to its default values.
segmentInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> m ()
segmentInit :: Segment -> Format -> m ()
segmentInit segment :: Segment
segment format :: Format
format = 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 Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Segment -> CUInt -> IO ()
gst_segment_init Ptr Segment
segment' CUInt
format'
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SegmentInitMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ()), MonadIO m) => O.MethodInfo SegmentInitMethodInfo Segment signature where
    overloadedMethod = segmentInit

#endif

-- method Segment::is_equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "s0"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "s1"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , 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_segment_is_equal" gst_segment_is_equal :: 
    Ptr Segment ->                          -- s0 : TInterface (Name {namespace = "Gst", name = "Segment"})
    Ptr Segment ->                          -- s1 : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO CInt

-- | Checks for two segments being equal. Equality here is defined
-- as perfect equality, including floating point values.
-- 
-- /Since: 1.6/
segmentIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@s0@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Segment
    -- ^ /@s1@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the segments are equal, 'P.False' otherwise.
segmentIsEqual :: Segment -> Segment -> m Bool
segmentIsEqual s0 :: Segment
s0 s1 :: Segment
s1 = 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 Segment
s0' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
s0
    Ptr Segment
s1' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
s1
    CInt
result <- Ptr Segment -> Ptr Segment -> IO CInt
gst_segment_is_equal Ptr Segment
s0' Ptr Segment
s1'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
s0
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
s1
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SegmentIsEqualMethodInfo
instance (signature ~ (Segment -> m Bool), MonadIO m) => O.MethodInfo SegmentIsEqualMethodInfo Segment signature where
    overloadedMethod = segmentIsEqual

#endif

-- method Segment::offset_running_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to apply in the segment"
--                 , 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_segment_offset_running_time" gst_segment_offset_running_time :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- offset : TBasicType TInt64
    IO CInt

-- | Adjust the values in /@segment@/ so that /@offset@/ is applied to all
-- future running-time calculations.
-- 
-- /Since: 1.2.3/
segmentOffsetRunningTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Int64
    -- ^ /@offset@/: the offset to apply in the segment
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the segment could be updated successfully. If 'P.False' is
    -- returned, /@offset@/ is not in /@segment@/.
segmentOffsetRunningTime :: Segment -> Format -> Int64 -> m Bool
segmentOffsetRunningTime segment :: Segment
segment format :: Format
format offset :: Int64
offset = 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 Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    CInt
result <- Ptr Segment -> CUInt -> Int64 -> IO CInt
gst_segment_offset_running_time Ptr Segment
segment' CUInt
format' Int64
offset
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SegmentOffsetRunningTimeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> m Bool), MonadIO m) => O.MethodInfo SegmentOffsetRunningTimeMethodInfo Segment signature where
    overloadedMethod = segmentOffsetRunningTime

#endif

-- method Segment::position_from_running_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the running_time in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_position_from_running_time" gst_segment_position_from_running_time :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- running_time : TBasicType TUInt64
    IO Word64

-- | Convert /@runningTime@/ into a position in the segment so that
-- 'GI.Gst.Structs.Segment.segmentToRunningTime' with that position returns /@runningTime@/.
-- 
-- /Since: 1.8/
segmentPositionFromRunningTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@runningTime@/: the running_time in the segment
    -> m Word64
    -- ^ __Returns:__ the position in the segment for /@runningTime@/. This function returns
    -- -1 when /@runningTime@/ is -1 or when it is not inside /@segment@/.
segmentPositionFromRunningTime :: Segment -> Format -> Word64 -> m Word64
segmentPositionFromRunningTime segment :: Segment
segment format :: Format
format runningTime :: Word64
runningTime = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Word64
result <- Ptr Segment -> CUInt -> Word64 -> IO Word64
gst_segment_position_from_running_time Ptr Segment
segment' CUInt
format' Word64
runningTime
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data SegmentPositionFromRunningTimeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m Word64), MonadIO m) => O.MethodInfo SegmentPositionFromRunningTimeMethodInfo Segment signature where
    overloadedMethod = segmentPositionFromRunningTime

#endif

-- method Segment::position_from_running_time_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the running-time" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the resulting position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_position_from_running_time_full" gst_segment_position_from_running_time_full :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- running_time : TBasicType TUInt64
    Ptr Word64 ->                           -- position : TBasicType TUInt64
    IO Int32

-- | Translate /@runningTime@/ to the segment position using the currently configured
-- segment. Compared to 'GI.Gst.Structs.Segment.segmentPositionFromRunningTime' this function can
-- return negative segment position.
-- 
-- This function is typically used by elements that need to synchronize buffers
-- against the clock or each other.
-- 
-- /@runningTime@/ can be any value and the result of this function for values
-- outside of the segment is extrapolated.
-- 
-- When 1 is returned, /@runningTime@/ resulted in a positive position returned
-- in /@position@/.
-- 
-- When this function returns -1, the returned /@position@/ was \< 0, and the value
-- in the position variable should be negated to get the real negative segment
-- position.
-- 
-- /Since: 1.8/
segmentPositionFromRunningTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@runningTime@/: the running-time
    -> m ((Int32, Word64))
    -- ^ __Returns:__ a 1 or -1 on success, 0 on failure.
segmentPositionFromRunningTimeFull :: Segment -> Format -> Word64 -> m (Int32, Word64)
segmentPositionFromRunningTimeFull segment :: Segment
segment format :: Format
format runningTime :: Word64
runningTime = IO (Int32, Word64) -> m (Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Word64) -> m (Int32, Word64))
-> IO (Int32, Word64) -> m (Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Word64
position <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Int32
result <- Ptr Segment -> CUInt -> Word64 -> Ptr Word64 -> IO Int32
gst_segment_position_from_running_time_full Ptr Segment
segment' CUInt
format' Word64
runningTime Ptr Word64
position
    Word64
position' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
position
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
position
    (Int32, Word64) -> IO (Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Word64
position')

#if defined(ENABLE_OVERLOADING)
data SegmentPositionFromRunningTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m ((Int32, Word64))), MonadIO m) => O.MethodInfo SegmentPositionFromRunningTimeFullMethodInfo Segment signature where
    overloadedMethod = segmentPositionFromRunningTimeFull

#endif

-- method Segment::position_from_stream_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stream_time in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_position_from_stream_time" gst_segment_position_from_stream_time :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- stream_time : TBasicType TUInt64
    IO Word64

-- | Convert /@streamTime@/ into a position in the segment so that
-- 'GI.Gst.Structs.Segment.segmentToStreamTime' with that position returns /@streamTime@/.
-- 
-- /Since: 1.8/
segmentPositionFromStreamTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@streamTime@/: the stream_time in the segment
    -> m Word64
    -- ^ __Returns:__ the position in the segment for /@streamTime@/. This function returns
    -- -1 when /@streamTime@/ is -1 or when it is not inside /@segment@/.
segmentPositionFromStreamTime :: Segment -> Format -> Word64 -> m Word64
segmentPositionFromStreamTime segment :: Segment
segment format :: Format
format streamTime :: Word64
streamTime = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Word64
result <- Ptr Segment -> CUInt -> Word64 -> IO Word64
gst_segment_position_from_stream_time Ptr Segment
segment' CUInt
format' Word64
streamTime
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data SegmentPositionFromStreamTimeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m Word64), MonadIO m) => O.MethodInfo SegmentPositionFromStreamTimeMethodInfo Segment signature where
    overloadedMethod = segmentPositionFromStreamTime

#endif

-- method Segment::position_from_stream_time_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stream-time" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the resulting position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_position_from_stream_time_full" gst_segment_position_from_stream_time_full :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- stream_time : TBasicType TUInt64
    Ptr Word64 ->                           -- position : TBasicType TUInt64
    IO Int32

-- | Translate /@streamTime@/ to the segment position using the currently configured
-- segment. Compared to 'GI.Gst.Structs.Segment.segmentPositionFromStreamTime' this function can
-- return negative segment position.
-- 
-- This function is typically used by elements that need to synchronize buffers
-- against the clock or each other.
-- 
-- /@streamTime@/ can be any value and the result of this function for values outside
-- of the segment is extrapolated.
-- 
-- When 1 is returned, /@streamTime@/ resulted in a positive position returned
-- in /@position@/.
-- 
-- When this function returns -1, the returned /@position@/ should be negated
-- to get the real negative segment position.
-- 
-- /Since: 1.8/
segmentPositionFromStreamTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@streamTime@/: the stream-time
    -> m ((Int32, Word64))
    -- ^ __Returns:__ a 1 or -1 on success, 0 on failure.
segmentPositionFromStreamTimeFull :: Segment -> Format -> Word64 -> m (Int32, Word64)
segmentPositionFromStreamTimeFull segment :: Segment
segment format :: Format
format streamTime :: Word64
streamTime = IO (Int32, Word64) -> m (Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Word64) -> m (Int32, Word64))
-> IO (Int32, Word64) -> m (Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Word64
position <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Int32
result <- Ptr Segment -> CUInt -> Word64 -> Ptr Word64 -> IO Int32
gst_segment_position_from_stream_time_full Ptr Segment
segment' CUInt
format' Word64
streamTime Ptr Word64
position
    Word64
position' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
position
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
position
    (Int32, Word64) -> IO (Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Word64
position')

#if defined(ENABLE_OVERLOADING)
data SegmentPositionFromStreamTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m ((Int32, Word64))), MonadIO m) => O.MethodInfo SegmentPositionFromStreamTimeFullMethodInfo Segment signature where
    overloadedMethod = segmentPositionFromStreamTimeFull

#endif

-- method Segment::set_running_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the running_time in the segment"
--                 , 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_segment_set_running_time" gst_segment_set_running_time :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- running_time : TBasicType TUInt64
    IO CInt

-- | Adjust the start\/stop and base values of /@segment@/ such that the next valid
-- buffer will be one with /@runningTime@/.
segmentSetRunningTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@runningTime@/: the running_time in the segment
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the segment could be updated successfully. If 'P.False' is
    -- returned, /@runningTime@/ is -1 or not in /@segment@/.
segmentSetRunningTime :: Segment -> Format -> Word64 -> m Bool
segmentSetRunningTime segment :: Segment
segment format :: Format
format runningTime :: Word64
runningTime = 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 Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    CInt
result <- Ptr Segment -> CUInt -> Word64 -> IO CInt
gst_segment_set_running_time Ptr Segment
segment' CUInt
format' Word64
runningTime
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SegmentSetRunningTimeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m Bool), MonadIO m) => O.MethodInfo SegmentSetRunningTimeMethodInfo Segment signature where
    overloadedMethod = segmentSetRunningTime

#endif

-- method Segment::to_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the running_time in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_to_position" gst_segment_to_position :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- running_time : TBasicType TUInt64
    IO Word64

{-# DEPRECATED segmentToPosition ["Use 'GI.Gst.Structs.Segment.segmentPositionFromRunningTime' instead."] #-}
-- | Convert /@runningTime@/ into a position in the segment so that
-- 'GI.Gst.Structs.Segment.segmentToRunningTime' with that position returns /@runningTime@/.
segmentToPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@runningTime@/: the running_time in the segment
    -> m Word64
    -- ^ __Returns:__ the position in the segment for /@runningTime@/. This function returns
    -- -1 when /@runningTime@/ is -1 or when it is not inside /@segment@/.
segmentToPosition :: Segment -> Format -> Word64 -> m Word64
segmentToPosition segment :: Segment
segment format :: Format
format runningTime :: Word64
runningTime = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Word64
result <- Ptr Segment -> CUInt -> Word64 -> IO Word64
gst_segment_to_position Ptr Segment
segment' CUInt
format' Word64
runningTime
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data SegmentToPositionMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m Word64), MonadIO m) => O.MethodInfo SegmentToPositionMethodInfo Segment signature where
    overloadedMethod = segmentToPosition

#endif

-- method Segment::to_running_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_to_running_time" gst_segment_to_running_time :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- position : TBasicType TUInt64
    IO Word64

-- | Translate /@position@/ to the total running time using the currently configured
-- segment. Position is a value between /@segment@/ start and stop time.
-- 
-- This function is typically used by elements that need to synchronize to the
-- global clock in a pipeline. The running time is a constantly increasing value
-- starting from 0. When 'GI.Gst.Structs.Segment.segmentInit' is called, this value will reset to
-- 0.
-- 
-- This function returns -1 if the position is outside of /@segment@/ start and stop.
segmentToRunningTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@position@/: the position in the segment
    -> m Word64
    -- ^ __Returns:__ the position as the total running time or -1 when an invalid position
    -- was given.
segmentToRunningTime :: Segment -> Format -> Word64 -> m Word64
segmentToRunningTime segment :: Segment
segment format :: Format
format position :: Word64
position = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Word64
result <- Ptr Segment -> CUInt -> Word64 -> IO Word64
gst_segment_to_running_time Ptr Segment
segment' CUInt
format' Word64
position
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data SegmentToRunningTimeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m Word64), MonadIO m) => O.MethodInfo SegmentToRunningTimeMethodInfo Segment signature where
    overloadedMethod = segmentToRunningTime

#endif

-- method Segment::to_running_time_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result running-time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_to_running_time_full" gst_segment_to_running_time_full :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- position : TBasicType TUInt64
    Ptr Word64 ->                           -- running_time : TBasicType TUInt64
    IO Int32

-- | Translate /@position@/ to the total running time using the currently configured
-- segment. Compared to 'GI.Gst.Structs.Segment.segmentToRunningTime' this function can return
-- negative running-time.
-- 
-- This function is typically used by elements that need to synchronize buffers
-- against the clock or each other.
-- 
-- /@position@/ can be any value and the result of this function for values outside
-- of the segment is extrapolated.
-- 
-- When 1 is returned, /@position@/ resulted in a positive running-time returned
-- in /@runningTime@/.
-- 
-- When this function returns -1, the returned /@runningTime@/ should be negated
-- to get the real negative running time.
-- 
-- /Since: 1.6/
segmentToRunningTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@position@/: the position in the segment
    -> m ((Int32, Word64))
    -- ^ __Returns:__ a 1 or -1 on success, 0 on failure.
segmentToRunningTimeFull :: Segment -> Format -> Word64 -> m (Int32, Word64)
segmentToRunningTimeFull segment :: Segment
segment format :: Format
format position :: Word64
position = IO (Int32, Word64) -> m (Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Word64) -> m (Int32, Word64))
-> IO (Int32, Word64) -> m (Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Word64
runningTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Int32
result <- Ptr Segment -> CUInt -> Word64 -> Ptr Word64 -> IO Int32
gst_segment_to_running_time_full Ptr Segment
segment' CUInt
format' Word64
position Ptr Word64
runningTime
    Word64
runningTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
runningTime
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
runningTime
    (Int32, Word64) -> IO (Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Word64
runningTime')

#if defined(ENABLE_OVERLOADING)
data SegmentToRunningTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m ((Int32, Word64))), MonadIO m) => O.MethodInfo SegmentToRunningTimeFullMethodInfo Segment signature where
    overloadedMethod = segmentToRunningTimeFull

#endif

-- method Segment::to_stream_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_to_stream_time" gst_segment_to_stream_time :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- position : TBasicType TUInt64
    IO Word64

-- | Translate /@position@/ to stream time using the currently configured
-- segment. The /@position@/ value must be between /@segment@/ start and
-- stop value.
-- 
-- This function is typically used by elements that need to operate on
-- the stream time of the buffers it receives, such as effect plugins.
-- In those use cases, /@position@/ is typically the buffer timestamp or
-- clock time that one wants to convert to the stream time.
-- The stream time is always between 0 and the total duration of the
-- media stream.
-- 
-- /Since: 1.8/
segmentToStreamTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@position@/: the position in the segment
    -> m Word64
    -- ^ __Returns:__ the position in stream_time or -1 when an invalid position
    -- was given.
segmentToStreamTime :: Segment -> Format -> Word64 -> m Word64
segmentToStreamTime segment :: Segment
segment format :: Format
format position :: Word64
position = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Word64
result <- Ptr Segment -> CUInt -> Word64 -> IO Word64
gst_segment_to_stream_time Ptr Segment
segment' CUInt
format' Word64
position
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data SegmentToStreamTimeMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m Word64), MonadIO m) => O.MethodInfo SegmentToStreamTimeMethodInfo Segment signature where
    overloadedMethod = segmentToStreamTime

#endif

-- method Segment::to_stream_time_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment structure."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format of the segment."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position in the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result stream-time" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_segment_to_stream_time_full" gst_segment_to_stream_time_full :: 
    Ptr Segment ->                          -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- position : TBasicType TUInt64
    Ptr Word64 ->                           -- stream_time : TBasicType TUInt64
    IO Int32

-- | Translate /@position@/ to the total stream time using the currently configured
-- segment. Compared to 'GI.Gst.Structs.Segment.segmentToStreamTime' this function can return
-- negative stream-time.
-- 
-- This function is typically used by elements that need to synchronize buffers
-- against the clock or each other.
-- 
-- /@position@/ can be any value and the result of this function for values outside
-- of the segment is extrapolated.
-- 
-- When 1 is returned, /@position@/ resulted in a positive stream-time returned
-- in /@streamTime@/.
-- 
-- When this function returns -1, the returned /@streamTime@/ should be negated
-- to get the real negative stream time.
-- 
-- /Since: 1.8/
segmentToStreamTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment' structure.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of the segment.
    -> Word64
    -- ^ /@position@/: the position in the segment
    -> m ((Int32, Word64))
    -- ^ __Returns:__ a 1 or -1 on success, 0 on failure.
segmentToStreamTimeFull :: Segment -> Format -> Word64 -> m (Int32, Word64)
segmentToStreamTimeFull segment :: Segment
segment format :: Format
format position :: Word64
position = IO (Int32, Word64) -> m (Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Word64) -> m (Int32, Word64))
-> IO (Int32, Word64) -> m (Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Word64
streamTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Int32
result <- Ptr Segment -> CUInt -> Word64 -> Ptr Word64 -> IO Int32
gst_segment_to_stream_time_full Ptr Segment
segment' CUInt
format' Word64
position Ptr Word64
streamTime
    Word64
streamTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
streamTime
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
streamTime
    (Int32, Word64) -> IO (Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Word64
streamTime')

#if defined(ENABLE_OVERLOADING)
data SegmentToStreamTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> m ((Int32, Word64))), MonadIO m) => O.MethodInfo SegmentToStreamTimeFullMethodInfo Segment signature where
    overloadedMethod = segmentToStreamTimeFull

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSegmentMethod (t :: Symbol) (o :: *) :: * where
    ResolveSegmentMethod "clip" o = SegmentClipMethodInfo
    ResolveSegmentMethod "copy" o = SegmentCopyMethodInfo
    ResolveSegmentMethod "copyInto" o = SegmentCopyIntoMethodInfo
    ResolveSegmentMethod "doSeek" o = SegmentDoSeekMethodInfo
    ResolveSegmentMethod "free" o = SegmentFreeMethodInfo
    ResolveSegmentMethod "init" o = SegmentInitMethodInfo
    ResolveSegmentMethod "isEqual" o = SegmentIsEqualMethodInfo
    ResolveSegmentMethod "offsetRunningTime" o = SegmentOffsetRunningTimeMethodInfo
    ResolveSegmentMethod "positionFromRunningTime" o = SegmentPositionFromRunningTimeMethodInfo
    ResolveSegmentMethod "positionFromRunningTimeFull" o = SegmentPositionFromRunningTimeFullMethodInfo
    ResolveSegmentMethod "positionFromStreamTime" o = SegmentPositionFromStreamTimeMethodInfo
    ResolveSegmentMethod "positionFromStreamTimeFull" o = SegmentPositionFromStreamTimeFullMethodInfo
    ResolveSegmentMethod "toPosition" o = SegmentToPositionMethodInfo
    ResolveSegmentMethod "toRunningTime" o = SegmentToRunningTimeMethodInfo
    ResolveSegmentMethod "toRunningTimeFull" o = SegmentToRunningTimeFullMethodInfo
    ResolveSegmentMethod "toStreamTime" o = SegmentToStreamTimeMethodInfo
    ResolveSegmentMethod "toStreamTimeFull" o = SegmentToStreamTimeFullMethodInfo
    ResolveSegmentMethod "setRunningTime" o = SegmentSetRunningTimeMethodInfo
    ResolveSegmentMethod l o = O.MethodResolutionFailed l o

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

#endif