{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

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 '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 '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).
-}

module GI.Gst.Structs.Segment
    ( 

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


 -- * Methods
-- ** clip #method:clip#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentClipMethodInfo                   ,
#endif
    segmentClip                             ,


-- ** copy #method:copy#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentCopyMethodInfo                   ,
#endif
    segmentCopy                             ,


-- ** copyInto #method:copyInto#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentCopyIntoMethodInfo               ,
#endif
    segmentCopyInto                         ,


-- ** doSeek #method:doSeek#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentDoSeekMethodInfo                 ,
#endif
    segmentDoSeek                           ,


-- ** free #method:free#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentFreeMethodInfo                   ,
#endif
    segmentFree                             ,


-- ** init #method:init#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentInitMethodInfo                   ,
#endif
    segmentInit                             ,


-- ** isEqual #method:isEqual#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentIsEqualMethodInfo                ,
#endif
    segmentIsEqual                          ,


-- ** new #method:new#
    segmentNew                              ,


-- ** offsetRunningTime #method:offsetRunningTime#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentOffsetRunningTimeMethodInfo      ,
#endif
    segmentOffsetRunningTime                ,


-- ** positionFromRunningTime #method:positionFromRunningTime#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentPositionFromRunningTimeMethodInfo,
#endif
    segmentPositionFromRunningTime          ,


-- ** positionFromRunningTimeFull #method:positionFromRunningTimeFull#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentPositionFromRunningTimeFullMethodInfo,
#endif
    segmentPositionFromRunningTimeFull      ,


-- ** positionFromStreamTime #method:positionFromStreamTime#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentPositionFromStreamTimeMethodInfo ,
#endif
    segmentPositionFromStreamTime           ,


-- ** positionFromStreamTimeFull #method:positionFromStreamTimeFull#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentPositionFromStreamTimeFullMethodInfo,
#endif
    segmentPositionFromStreamTimeFull       ,


-- ** setRunningTime #method:setRunningTime#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentSetRunningTimeMethodInfo         ,
#endif
    segmentSetRunningTime                   ,


-- ** toPosition #method:toPosition#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentToPositionMethodInfo             ,
#endif
    segmentToPosition                       ,


-- ** toRunningTime #method:toRunningTime#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentToRunningTimeMethodInfo          ,
#endif
    segmentToRunningTime                    ,


-- ** toRunningTimeFull #method:toRunningTimeFull#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentToRunningTimeFullMethodInfo      ,
#endif
    segmentToRunningTimeFull                ,


-- ** toStreamTime #method:toStreamTime#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentToStreamTimeMethodInfo           ,
#endif
    segmentToStreamTime                     ,


-- ** toStreamTimeFull #method:toStreamTimeFull#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    SegmentToStreamTimeFullMethodInfo       ,
#endif
    segmentToStreamTimeFull                 ,




 -- * Properties
-- ** appliedRate #attr:appliedRate#
    getSegmentAppliedRate                   ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_appliedRate                     ,
#endif
    setSegmentAppliedRate                   ,


-- ** base #attr:base#
    getSegmentBase                          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_base                            ,
#endif
    setSegmentBase                          ,


-- ** duration #attr:duration#
    getSegmentDuration                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_duration                        ,
#endif
    setSegmentDuration                      ,


-- ** flags #attr:flags#
    getSegmentFlags                         ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_flags                           ,
#endif
    setSegmentFlags                         ,


-- ** format #attr:format#
    getSegmentFormat                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_format                          ,
#endif
    setSegmentFormat                        ,


-- ** offset #attr:offset#
    getSegmentOffset                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_offset                          ,
#endif
    setSegmentOffset                        ,


-- ** position #attr:position#
    getSegmentPosition                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_position                        ,
#endif
    setSegmentPosition                      ,


-- ** rate #attr:rate#
    getSegmentRate                          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_rate                            ,
#endif
    setSegmentRate                          ,


-- ** start #attr:start#
    getSegmentStart                         ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_start                           ,
#endif
    setSegmentStart                         ,


-- ** stop #attr:stop#
    getSegmentStop                          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    segment_stop                            ,
#endif
    setSegmentStop                          ,


-- ** time #attr:time#
    getSegmentTime                          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags

newtype Segment = Segment (ManagedPtr Segment)
foreign import ccall "gst_segment_get_type" c_gst_segment_get_type :: 
    IO GType

instance BoxedObject Segment where
    boxedType _ = c_gst_segment_get_type

-- | Construct a `Segment` struct initialized to zero.
newZeroSegment :: MonadIO m => m Segment
newZeroSegment = liftIO $ callocBoxedBytes 120 >>= wrapBoxed Segment

instance tag ~ 'AttrSet => Constructible Segment tag where
    new _ attrs = do
        o <- newZeroSegment
        GI.Attributes.set o attrs
        return o


noSegment :: Maybe Segment
noSegment = Nothing

getSegmentFlags :: MonadIO m => Segment -> m [Gst.Flags.SegmentFlags]
getSegmentFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setSegmentFlags :: MonadIO m => Segment -> [Gst.Flags.SegmentFlags] -> m ()
setSegmentFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

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

segment_flags :: AttrLabelProxy "flags"
segment_flags = AttrLabelProxy

#endif


getSegmentRate :: MonadIO m => Segment -> m Double
getSegmentRate s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CDouble
    let val' = realToFrac val
    return val'

setSegmentRate :: MonadIO m => Segment -> Double -> m ()
setSegmentRate s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 8) (val' :: CDouble)

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

segment_rate :: AttrLabelProxy "rate"
segment_rate = AttrLabelProxy

#endif


getSegmentAppliedRate :: MonadIO m => Segment -> m Double
getSegmentAppliedRate s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CDouble
    let val' = realToFrac val
    return val'

setSegmentAppliedRate :: MonadIO m => Segment -> Double -> m ()
setSegmentAppliedRate s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 16) (val' :: CDouble)

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

segment_appliedRate :: AttrLabelProxy "appliedRate"
segment_appliedRate = AttrLabelProxy

#endif


getSegmentFormat :: MonadIO m => Segment -> m Gst.Enums.Format
getSegmentFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setSegmentFormat :: MonadIO m => Segment -> Gst.Enums.Format -> m ()
setSegmentFormat s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 24) (val' :: CUInt)

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

segment_format :: AttrLabelProxy "format"
segment_format = AttrLabelProxy

#endif


getSegmentBase :: MonadIO m => Segment -> m Word64
getSegmentBase s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO Word64
    return val

setSegmentBase :: MonadIO m => Segment -> Word64 -> m ()
setSegmentBase s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: Word64)

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

segment_base :: AttrLabelProxy "base"
segment_base = AttrLabelProxy

#endif


getSegmentOffset :: MonadIO m => Segment -> m Word64
getSegmentOffset s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO Word64
    return val

setSegmentOffset :: MonadIO m => Segment -> Word64 -> m ()
setSegmentOffset s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (val :: Word64)

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

segment_offset :: AttrLabelProxy "offset"
segment_offset = AttrLabelProxy

#endif


getSegmentStart :: MonadIO m => Segment -> m Word64
getSegmentStart s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO Word64
    return val

setSegmentStart :: MonadIO m => Segment -> Word64 -> m ()
setSegmentStart s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (val :: Word64)

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

segment_start :: AttrLabelProxy "start"
segment_start = AttrLabelProxy

#endif


getSegmentStop :: MonadIO m => Segment -> m Word64
getSegmentStop s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO Word64
    return val

setSegmentStop :: MonadIO m => Segment -> Word64 -> m ()
setSegmentStop s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: Word64)

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

segment_stop :: AttrLabelProxy "stop"
segment_stop = AttrLabelProxy

#endif


getSegmentTime :: MonadIO m => Segment -> m Word64
getSegmentTime s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO Word64
    return val

setSegmentTime :: MonadIO m => Segment -> Word64 -> m ()
setSegmentTime s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (val :: Word64)

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

segment_time :: AttrLabelProxy "time"
segment_time = AttrLabelProxy

#endif


getSegmentPosition :: MonadIO m => Segment -> m Word64
getSegmentPosition s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 72) :: IO Word64
    return val

setSegmentPosition :: MonadIO m => Segment -> Word64 -> m ()
setSegmentPosition s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 72) (val :: Word64)

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

segment_position :: AttrLabelProxy "position"
segment_position = AttrLabelProxy

#endif


getSegmentDuration :: MonadIO m => Segment -> m Word64
getSegmentDuration s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 80) :: IO Word64
    return val

setSegmentDuration :: MonadIO m => Segment -> Word64 -> m ()
setSegmentDuration s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 80) (val :: Word64)

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

segment_duration :: AttrLabelProxy "duration"
segment_duration = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 '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 'GI.Gst.Structs.Segment.Segment', free with 'GI.Gst.Structs.Segment.segmentFree'. -}
segmentNew  = liftIO $ do
    result <- gst_segment_new
    checkUnexpectedReturnNULL "segmentNew" result
    result' <- (wrapBoxed Segment) result
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#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 'False', /@start@/ and /@stop@/ are known to fall
outside of /@segment@/ and /@clipStart@/ and /@clipStop@/ are not updated.

When the function returns '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 '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:__ 'True' if the given /@start@/ and /@stop@/ times fall partially or
    completely in /@segment@/, 'False' if the values are completely outside
    of the segment. -}
segmentClip segment format start stop = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    clipStart <- allocMem :: IO (Ptr Word64)
    clipStop <- allocMem :: IO (Ptr Word64)
    result <- gst_segment_clip segment' format' start stop clipStart clipStop
    let result' = (/= 0) result
    clipStart' <- peek clipStart
    clipStop' <- peek clipStop
    touchManagedPtr segment
    freeMem clipStart
    freeMem clipStop
    return (result', clipStart', clipStop')

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 'GI.Gst.Structs.Segment.Segment' -}
    -> m Segment
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Segment.Segment', free with 'GI.Gst.Structs.Segment.segmentFree'. -}
segmentCopy segment = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    result <- gst_segment_copy segment'
    checkUnexpectedReturnNULL "segmentCopy" result
    result' <- (wrapBoxed Segment) result
    touchManagedPtr segment
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 'GI.Gst.Structs.Segment.Segment' -}
    -> Segment
    {- ^ /@dest@/: a 'GI.Gst.Structs.Segment.Segment' -}
    -> m ()
segmentCopyInto src dest = liftIO $ do
    src' <- unsafeManagedPtrGetPtr src
    dest' <- unsafeManagedPtrGetPtr dest
    gst_segment_copy_into src' dest'
    touchManagedPtr src
    touchManagedPtr dest
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "boolean holding whether position was updated.", 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_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
    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 'True' if a seek should be performed to the segment
position field. This field can be 'False' if, for example, only the /@rate@/
has been changed but not the playback position.
-}
segmentDoSeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    {- ^ /@segment@/: a '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 -}
    -> Bool
    {- ^ /@update@/: boolean holding whether position was updated. -}
    -> m Bool
    {- ^ __Returns:__ 'True' if the seek could be performed. -}
segmentDoSeek segment rate format flags startType start stopType stop update = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let rate' = realToFrac rate
    let format' = (fromIntegral . fromEnum) format
    let flags' = gflagsToWord flags
    let startType' = (fromIntegral . fromEnum) startType
    let stopType' = (fromIntegral . fromEnum) stopType
    let update' = (fromIntegral . fromEnum) update
    result <- gst_segment_do_seek segment' rate' format' flags' startType' start stopType' stop update'
    let result' = (/= 0) result
    touchManagedPtr segment
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data SegmentDoSeekMethodInfo
instance (signature ~ (Double -> Gst.Enums.Format -> [Gst.Flags.SeekFlags] -> Gst.Enums.SeekType -> Word64 -> Gst.Enums.SeekType -> Word64 -> Bool -> m 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 'GI.Gst.Structs.Segment.Segment' -}
    -> m ()
segmentFree segment = liftIO $ do
    segment' <- B.ManagedPtr.disownBoxed segment
    gst_segment_free segment'
    touchManagedPtr segment
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> Gst.Enums.Format
    {- ^ /@format@/: the format of the segment. -}
    -> m ()
segmentInit segment format = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    gst_segment_init segment' format'
    touchManagedPtr segment
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> Segment
    {- ^ /@s1@/: a 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> m Bool
    {- ^ __Returns:__ 'True' if the segments are equal, 'False' otherwise. -}
segmentIsEqual s0 s1 = liftIO $ do
    s0' <- unsafeManagedPtrGetPtr s0
    s1' <- unsafeManagedPtrGetPtr s1
    result <- gst_segment_is_equal s0' s1'
    let result' = (/= 0) result
    touchManagedPtr s0
    touchManagedPtr s1
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 '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:__ 'True' if the segment could be updated successfully. If 'False' is
returned, /@offset@/ is not in /@segment@/. -}
segmentOffsetRunningTime segment format offset = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_offset_running_time segment' format' offset
    let result' = (/= 0) result
    touchManagedPtr segment
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 '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 runningTime = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_position_from_running_time segment' format' runningTime
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the resulting position in the segment", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- 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
    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@/ should be negated
to get the real negative segment position.

@since 1.8
-}
segmentPositionFromRunningTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Segment
    {- ^ /@segment@/: a 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> Gst.Enums.Format
    {- ^ /@format@/: the format of the segment. -}
    -> Word64
    {- ^ /@runningTime@/: the running-time -}
    -> Word64
    {- ^ /@position@/: the resulting position in the segment -}
    -> m Int32
    {- ^ __Returns:__ a 1 or -1 on success, 0 on failure. -}
segmentPositionFromRunningTimeFull segment format runningTime position = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_position_from_running_time_full segment' format' runningTime position
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data SegmentPositionFromRunningTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> Word64 -> m Int32), 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 '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 streamTime = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_position_from_stream_time segment' format' streamTime
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the resulting position in the segment", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- 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
    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 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> Gst.Enums.Format
    {- ^ /@format@/: the format of the segment. -}
    -> Word64
    {- ^ /@streamTime@/: the stream-time -}
    -> Word64
    {- ^ /@position@/: the resulting position in the segment -}
    -> m Int32
    {- ^ __Returns:__ a 1 or -1 on success, 0 on failure. -}
segmentPositionFromStreamTimeFull segment format streamTime position = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_position_from_stream_time_full segment' format' streamTime position
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data SegmentPositionFromStreamTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> Word64 -> m Int32), 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 '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:__ 'True' if the segment could be updated successfully. If 'False' is
returned, /@runningTime@/ is -1 or not in /@segment@/. -}
segmentSetRunningTime segment format runningTime = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_set_running_time segment' format' runningTime
    let result' = (/= 0) result
    touchManagedPtr segment
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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

{- |
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 '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@/.

Deprecated. Use 'GI.Gst.Structs.Segment.segmentPositionFromRunningTime' instead. -}
segmentToPosition segment format runningTime = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_to_position segment' format' runningTime
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 '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 position = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_to_running_time segment' format' position
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result running-time", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- 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
    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 eachother.

/@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 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> Gst.Enums.Format
    {- ^ /@format@/: the format of the segment. -}
    -> Word64
    {- ^ /@position@/: the position in the segment -}
    -> Word64
    {- ^ /@runningTime@/: result running-time -}
    -> m Int32
    {- ^ __Returns:__ a 1 or -1 on success, 0 on failure. -}
segmentToRunningTimeFull segment format position runningTime = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_to_running_time_full segment' format' position runningTime
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data SegmentToRunningTimeFullMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> Word64 -> m Int32), 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 '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 position = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_to_stream_time segment' format' position
    touchManagedPtr segment
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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 = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result stream-time", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- 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
    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 eachother.

/@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 'GI.Gst.Structs.Segment.Segment' structure. -}
    -> Gst.Enums.Format
    {- ^ /@format@/: the format of the segment. -}
    -> Word64
    {- ^ /@position@/: the position in the segment -}
    -> Word64
    {- ^ /@streamTime@/: result stream-time -}
    -> m Int32
    {- ^ __Returns:__ a 1 or -1 on success, 0 on failure. -}
segmentToStreamTimeFull segment format position streamTime = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    let format' = (fromIntegral . fromEnum) format
    result <- gst_segment_to_stream_time_full segment' format' position streamTime
    touchManagedPtr segment
    return result

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

#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
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) => O.IsLabelProxy t (Segment -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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

#endif