-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.GstVideo.Flags
    ( 

 -- * Flags
-- ** VideoBufferFlags #flag:VideoBufferFlags#

    VideoBufferFlags(..)                    ,


-- ** VideoChromaFlags #flag:VideoChromaFlags#

    VideoChromaFlags(..)                    ,


-- ** VideoChromaSite #flag:VideoChromaSite#

    VideoChromaSite(..)                     ,


-- ** VideoCodecFrameFlags #flag:VideoCodecFrameFlags#

    VideoCodecFrameFlags(..)                ,


-- ** VideoDitherFlags #flag:VideoDitherFlags#

    VideoDitherFlags(..)                    ,


-- ** VideoFlags #flag:VideoFlags#

    VideoFlags(..)                          ,


-- ** VideoFormatFlags #flag:VideoFormatFlags#

    VideoFormatFlags(..)                    ,


-- ** VideoFrameFlags #flag:VideoFrameFlags#

    VideoFrameFlags(..)                     ,


-- ** VideoFrameMapFlags #flag:VideoFrameMapFlags#

    VideoFrameMapFlags(..)                  ,


-- ** VideoMultiviewFlags #flag:VideoMultiviewFlags#

    VideoMultiviewFlags(..)                 ,


-- ** VideoOverlayFormatFlags #flag:VideoOverlayFormatFlags#

    VideoOverlayFormatFlags(..)             ,


-- ** VideoPackFlags #flag:VideoPackFlags#

    VideoPackFlags(..)                      ,


-- ** VideoResamplerFlags #flag:VideoResamplerFlags#

    VideoResamplerFlags(..)                 ,


-- ** VideoScalerFlags #flag:VideoScalerFlags#

    VideoScalerFlags(..)                    ,


-- ** VideoTimeCodeFlags #flag:VideoTimeCodeFlags#

    VideoTimeCodeFlags(..)                  ,




    ) 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


-- Flags VideoTimeCodeFlags
-- | Flags related to the time code information.
-- For drop frame, only 30000\/1001 and 60000\/1001 frame rates are supported.
-- 
-- /Since: 1.10/
data VideoTimeCodeFlags = 
      VideoTimeCodeFlagsNone
    -- ^ No flags
    | VideoTimeCodeFlagsDropFrame
    -- ^ Whether we have drop frame rate
    | VideoTimeCodeFlagsInterlaced
    -- ^ Whether we have interlaced video
    | AnotherVideoTimeCodeFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoTimeCodeFlags -> ShowS
[VideoTimeCodeFlags] -> ShowS
VideoTimeCodeFlags -> String
(Int -> VideoTimeCodeFlags -> ShowS)
-> (VideoTimeCodeFlags -> String)
-> ([VideoTimeCodeFlags] -> ShowS)
-> Show VideoTimeCodeFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoTimeCodeFlags] -> ShowS
$cshowList :: [VideoTimeCodeFlags] -> ShowS
show :: VideoTimeCodeFlags -> String
$cshow :: VideoTimeCodeFlags -> String
showsPrec :: Int -> VideoTimeCodeFlags -> ShowS
$cshowsPrec :: Int -> VideoTimeCodeFlags -> ShowS
Show, VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool
(VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool)
-> (VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool)
-> Eq VideoTimeCodeFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool
$c/= :: VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool
== :: VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool
$c== :: VideoTimeCodeFlags -> VideoTimeCodeFlags -> Bool
Eq)

instance P.Enum VideoTimeCodeFlags where
    fromEnum :: VideoTimeCodeFlags -> Int
fromEnum VideoTimeCodeFlagsNone = 0
    fromEnum VideoTimeCodeFlagsDropFrame = 1
    fromEnum VideoTimeCodeFlagsInterlaced = 2
    fromEnum (AnotherVideoTimeCodeFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoTimeCodeFlags
toEnum 0 = VideoTimeCodeFlags
VideoTimeCodeFlagsNone
    toEnum 1 = VideoTimeCodeFlags
VideoTimeCodeFlagsDropFrame
    toEnum 2 = VideoTimeCodeFlags
VideoTimeCodeFlagsInterlaced
    toEnum k :: Int
k = Int -> VideoTimeCodeFlags
AnotherVideoTimeCodeFlags Int
k

instance P.Ord VideoTimeCodeFlags where
    compare :: VideoTimeCodeFlags -> VideoTimeCodeFlags -> Ordering
compare a :: VideoTimeCodeFlags
a b :: VideoTimeCodeFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoTimeCodeFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoTimeCodeFlags
a) (VideoTimeCodeFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoTimeCodeFlags
b)

instance IsGFlag VideoTimeCodeFlags

-- Flags VideoScalerFlags
-- | Different scale flags.
data VideoScalerFlags = 
      VideoScalerFlagsNone
    -- ^ no flags
    | VideoScalerFlagsInterlaced
    -- ^ Set up a scaler for interlaced content
    | AnotherVideoScalerFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoScalerFlags -> ShowS
[VideoScalerFlags] -> ShowS
VideoScalerFlags -> String
(Int -> VideoScalerFlags -> ShowS)
-> (VideoScalerFlags -> String)
-> ([VideoScalerFlags] -> ShowS)
-> Show VideoScalerFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoScalerFlags] -> ShowS
$cshowList :: [VideoScalerFlags] -> ShowS
show :: VideoScalerFlags -> String
$cshow :: VideoScalerFlags -> String
showsPrec :: Int -> VideoScalerFlags -> ShowS
$cshowsPrec :: Int -> VideoScalerFlags -> ShowS
Show, VideoScalerFlags -> VideoScalerFlags -> Bool
(VideoScalerFlags -> VideoScalerFlags -> Bool)
-> (VideoScalerFlags -> VideoScalerFlags -> Bool)
-> Eq VideoScalerFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoScalerFlags -> VideoScalerFlags -> Bool
$c/= :: VideoScalerFlags -> VideoScalerFlags -> Bool
== :: VideoScalerFlags -> VideoScalerFlags -> Bool
$c== :: VideoScalerFlags -> VideoScalerFlags -> Bool
Eq)

instance P.Enum VideoScalerFlags where
    fromEnum :: VideoScalerFlags -> Int
fromEnum VideoScalerFlagsNone = 0
    fromEnum VideoScalerFlagsInterlaced = 1
    fromEnum (AnotherVideoScalerFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoScalerFlags
toEnum 0 = VideoScalerFlags
VideoScalerFlagsNone
    toEnum 1 = VideoScalerFlags
VideoScalerFlagsInterlaced
    toEnum k :: Int
k = Int -> VideoScalerFlags
AnotherVideoScalerFlags Int
k

instance P.Ord VideoScalerFlags where
    compare :: VideoScalerFlags -> VideoScalerFlags -> Ordering
compare a :: VideoScalerFlags
a b :: VideoScalerFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoScalerFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoScalerFlags
a) (VideoScalerFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoScalerFlags
b)

foreign import ccall "gst_video_scaler_flags_get_type" c_gst_video_scaler_flags_get_type :: 
    IO GType

instance BoxedFlags VideoScalerFlags where
    boxedFlagsType :: Proxy VideoScalerFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_scaler_flags_get_type

instance IsGFlag VideoScalerFlags

-- Flags VideoResamplerFlags
-- | Different resampler flags.
-- 
-- /Since: 1.6/
data VideoResamplerFlags = 
      VideoResamplerFlagsNone
    -- ^ no flags
    | VideoResamplerFlagsHalfTaps
    -- ^ when no taps are given, half the
    --              number of calculated taps. This can be used when making scalers
    --              for the different fields of an interlaced picture. Since 1.10
    | AnotherVideoResamplerFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoResamplerFlags -> ShowS
[VideoResamplerFlags] -> ShowS
VideoResamplerFlags -> String
(Int -> VideoResamplerFlags -> ShowS)
-> (VideoResamplerFlags -> String)
-> ([VideoResamplerFlags] -> ShowS)
-> Show VideoResamplerFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoResamplerFlags] -> ShowS
$cshowList :: [VideoResamplerFlags] -> ShowS
show :: VideoResamplerFlags -> String
$cshow :: VideoResamplerFlags -> String
showsPrec :: Int -> VideoResamplerFlags -> ShowS
$cshowsPrec :: Int -> VideoResamplerFlags -> ShowS
Show, VideoResamplerFlags -> VideoResamplerFlags -> Bool
(VideoResamplerFlags -> VideoResamplerFlags -> Bool)
-> (VideoResamplerFlags -> VideoResamplerFlags -> Bool)
-> Eq VideoResamplerFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoResamplerFlags -> VideoResamplerFlags -> Bool
$c/= :: VideoResamplerFlags -> VideoResamplerFlags -> Bool
== :: VideoResamplerFlags -> VideoResamplerFlags -> Bool
$c== :: VideoResamplerFlags -> VideoResamplerFlags -> Bool
Eq)

instance P.Enum VideoResamplerFlags where
    fromEnum :: VideoResamplerFlags -> Int
fromEnum VideoResamplerFlagsNone = 0
    fromEnum VideoResamplerFlagsHalfTaps = 1
    fromEnum (AnotherVideoResamplerFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoResamplerFlags
toEnum 0 = VideoResamplerFlags
VideoResamplerFlagsNone
    toEnum 1 = VideoResamplerFlags
VideoResamplerFlagsHalfTaps
    toEnum k :: Int
k = Int -> VideoResamplerFlags
AnotherVideoResamplerFlags Int
k

instance P.Ord VideoResamplerFlags where
    compare :: VideoResamplerFlags -> VideoResamplerFlags -> Ordering
compare a :: VideoResamplerFlags
a b :: VideoResamplerFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoResamplerFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoResamplerFlags
a) (VideoResamplerFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoResamplerFlags
b)

foreign import ccall "gst_video_resampler_flags_get_type" c_gst_video_resampler_flags_get_type :: 
    IO GType

instance BoxedFlags VideoResamplerFlags where
    boxedFlagsType :: Proxy VideoResamplerFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_resampler_flags_get_type

instance IsGFlag VideoResamplerFlags

-- Flags VideoPackFlags
-- | The different flags that can be used when packing and unpacking.
data VideoPackFlags = 
      VideoPackFlagsNone
    -- ^ No flag
    | VideoPackFlagsTruncateRange
    -- ^ When the source has a smaller depth
    --   than the target format, set the least significant bits of the target
    --   to 0. This is likely sightly faster but less accurate. When this flag
    --   is not specified, the most significant bits of the source are duplicated
    --   in the least significant bits of the destination.
    | VideoPackFlagsInterlaced
    -- ^ The source is interlaced. The unpacked
    --   format will be interlaced as well with each line containing
    --   information from alternating fields. (Since 1.2)
    | AnotherVideoPackFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoPackFlags -> ShowS
[VideoPackFlags] -> ShowS
VideoPackFlags -> String
(Int -> VideoPackFlags -> ShowS)
-> (VideoPackFlags -> String)
-> ([VideoPackFlags] -> ShowS)
-> Show VideoPackFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoPackFlags] -> ShowS
$cshowList :: [VideoPackFlags] -> ShowS
show :: VideoPackFlags -> String
$cshow :: VideoPackFlags -> String
showsPrec :: Int -> VideoPackFlags -> ShowS
$cshowsPrec :: Int -> VideoPackFlags -> ShowS
Show, VideoPackFlags -> VideoPackFlags -> Bool
(VideoPackFlags -> VideoPackFlags -> Bool)
-> (VideoPackFlags -> VideoPackFlags -> Bool) -> Eq VideoPackFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoPackFlags -> VideoPackFlags -> Bool
$c/= :: VideoPackFlags -> VideoPackFlags -> Bool
== :: VideoPackFlags -> VideoPackFlags -> Bool
$c== :: VideoPackFlags -> VideoPackFlags -> Bool
Eq)

instance P.Enum VideoPackFlags where
    fromEnum :: VideoPackFlags -> Int
fromEnum VideoPackFlagsNone = 0
    fromEnum VideoPackFlagsTruncateRange = 1
    fromEnum VideoPackFlagsInterlaced = 2
    fromEnum (AnotherVideoPackFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoPackFlags
toEnum 0 = VideoPackFlags
VideoPackFlagsNone
    toEnum 1 = VideoPackFlags
VideoPackFlagsTruncateRange
    toEnum 2 = VideoPackFlags
VideoPackFlagsInterlaced
    toEnum k :: Int
k = Int -> VideoPackFlags
AnotherVideoPackFlags Int
k

instance P.Ord VideoPackFlags where
    compare :: VideoPackFlags -> VideoPackFlags -> Ordering
compare a :: VideoPackFlags
a b :: VideoPackFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoPackFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoPackFlags
a) (VideoPackFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoPackFlags
b)

foreign import ccall "gst_video_pack_flags_get_type" c_gst_video_pack_flags_get_type :: 
    IO GType

instance BoxedFlags VideoPackFlags where
    boxedFlagsType :: Proxy VideoPackFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_pack_flags_get_type

instance IsGFlag VideoPackFlags

-- Flags VideoOverlayFormatFlags
-- | Overlay format flags.
data VideoOverlayFormatFlags = 
      VideoOverlayFormatFlagsNone
    -- ^ no flags
    | VideoOverlayFormatFlagsPremultipliedAlpha
    -- ^ RGB are premultiplied by A\/255.
    | VideoOverlayFormatFlagsGlobalAlpha
    -- ^ a global-alpha value != 1 is set.
    | AnotherVideoOverlayFormatFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoOverlayFormatFlags -> ShowS
[VideoOverlayFormatFlags] -> ShowS
VideoOverlayFormatFlags -> String
(Int -> VideoOverlayFormatFlags -> ShowS)
-> (VideoOverlayFormatFlags -> String)
-> ([VideoOverlayFormatFlags] -> ShowS)
-> Show VideoOverlayFormatFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoOverlayFormatFlags] -> ShowS
$cshowList :: [VideoOverlayFormatFlags] -> ShowS
show :: VideoOverlayFormatFlags -> String
$cshow :: VideoOverlayFormatFlags -> String
showsPrec :: Int -> VideoOverlayFormatFlags -> ShowS
$cshowsPrec :: Int -> VideoOverlayFormatFlags -> ShowS
Show, VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool
(VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool)
-> (VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool)
-> Eq VideoOverlayFormatFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool
$c/= :: VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool
== :: VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool
$c== :: VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Bool
Eq)

instance P.Enum VideoOverlayFormatFlags where
    fromEnum :: VideoOverlayFormatFlags -> Int
fromEnum VideoOverlayFormatFlagsNone = 0
    fromEnum VideoOverlayFormatFlagsPremultipliedAlpha = 1
    fromEnum VideoOverlayFormatFlagsGlobalAlpha = 2
    fromEnum (AnotherVideoOverlayFormatFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoOverlayFormatFlags
toEnum 0 = VideoOverlayFormatFlags
VideoOverlayFormatFlagsNone
    toEnum 1 = VideoOverlayFormatFlags
VideoOverlayFormatFlagsPremultipliedAlpha
    toEnum 2 = VideoOverlayFormatFlags
VideoOverlayFormatFlagsGlobalAlpha
    toEnum k :: Int
k = Int -> VideoOverlayFormatFlags
AnotherVideoOverlayFormatFlags Int
k

instance P.Ord VideoOverlayFormatFlags where
    compare :: VideoOverlayFormatFlags -> VideoOverlayFormatFlags -> Ordering
compare a :: VideoOverlayFormatFlags
a b :: VideoOverlayFormatFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoOverlayFormatFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoOverlayFormatFlags
a) (VideoOverlayFormatFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoOverlayFormatFlags
b)

foreign import ccall "gst_video_overlay_format_flags_get_type" c_gst_video_overlay_format_flags_get_type :: 
    IO GType

instance BoxedFlags VideoOverlayFormatFlags where
    boxedFlagsType :: Proxy VideoOverlayFormatFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_overlay_format_flags_get_type

instance IsGFlag VideoOverlayFormatFlags

-- Flags VideoMultiviewFlags
-- | GstVideoMultiviewFlags are used to indicate extra properties of a
-- stereo\/multiview stream beyond the frame layout and buffer mapping
-- that is conveyed in the t'GI.GstVideo.Enums.VideoMultiviewMode'.
data VideoMultiviewFlags = 
      VideoMultiviewFlagsNone
    -- ^ No flags
    | VideoMultiviewFlagsRightViewFirst
    -- ^ For stereo streams, the
    --     normal arrangement of left and right views is reversed.
    | VideoMultiviewFlagsLeftFlipped
    -- ^ The left view is vertically
    --     mirrored.
    | VideoMultiviewFlagsLeftFlopped
    -- ^ The left view is horizontally
    --     mirrored.
    | VideoMultiviewFlagsRightFlipped
    -- ^ The right view is
    --     vertically mirrored.
    | VideoMultiviewFlagsRightFlopped
    -- ^ The right view is
    --     horizontally mirrored.
    | VideoMultiviewFlagsHalfAspect
    -- ^ For frame-packed
    --     multiview modes, indicates that the individual
    --     views have been encoded with half the true width or height
    --     and should be scaled back up for display. This flag
    --     is used for overriding input layout interpretation
    --     by adjusting pixel-aspect-ratio.
    --     For side-by-side, column interleaved or checkerboard packings, the
    --     pixel width will be doubled. For row interleaved and top-bottom
    --     encodings, pixel height will be doubled.
    | VideoMultiviewFlagsMixedMono
    -- ^ The video stream contains both
    --     mono and multiview portions, signalled on each buffer by the
    --     absence or presence of the /@gSTVIDEOBUFFERFLAGMULTIPLEVIEW@/
    --     buffer flag.
    | AnotherVideoMultiviewFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoMultiviewFlags -> ShowS
[VideoMultiviewFlags] -> ShowS
VideoMultiviewFlags -> String
(Int -> VideoMultiviewFlags -> ShowS)
-> (VideoMultiviewFlags -> String)
-> ([VideoMultiviewFlags] -> ShowS)
-> Show VideoMultiviewFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoMultiviewFlags] -> ShowS
$cshowList :: [VideoMultiviewFlags] -> ShowS
show :: VideoMultiviewFlags -> String
$cshow :: VideoMultiviewFlags -> String
showsPrec :: Int -> VideoMultiviewFlags -> ShowS
$cshowsPrec :: Int -> VideoMultiviewFlags -> ShowS
Show, VideoMultiviewFlags -> VideoMultiviewFlags -> Bool
(VideoMultiviewFlags -> VideoMultiviewFlags -> Bool)
-> (VideoMultiviewFlags -> VideoMultiviewFlags -> Bool)
-> Eq VideoMultiviewFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoMultiviewFlags -> VideoMultiviewFlags -> Bool
$c/= :: VideoMultiviewFlags -> VideoMultiviewFlags -> Bool
== :: VideoMultiviewFlags -> VideoMultiviewFlags -> Bool
$c== :: VideoMultiviewFlags -> VideoMultiviewFlags -> Bool
Eq)

instance P.Enum VideoMultiviewFlags where
    fromEnum :: VideoMultiviewFlags -> Int
fromEnum VideoMultiviewFlagsNone = 0
    fromEnum VideoMultiviewFlagsRightViewFirst = 1
    fromEnum VideoMultiviewFlagsLeftFlipped = 2
    fromEnum VideoMultiviewFlagsLeftFlopped = 4
    fromEnum VideoMultiviewFlagsRightFlipped = 8
    fromEnum VideoMultiviewFlagsRightFlopped = 16
    fromEnum VideoMultiviewFlagsHalfAspect = 16384
    fromEnum VideoMultiviewFlagsMixedMono = 32768
    fromEnum (AnotherVideoMultiviewFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoMultiviewFlags
toEnum 0 = VideoMultiviewFlags
VideoMultiviewFlagsNone
    toEnum 1 = VideoMultiviewFlags
VideoMultiviewFlagsRightViewFirst
    toEnum 2 = VideoMultiviewFlags
VideoMultiviewFlagsLeftFlipped
    toEnum 4 = VideoMultiviewFlags
VideoMultiviewFlagsLeftFlopped
    toEnum 8 = VideoMultiviewFlags
VideoMultiviewFlagsRightFlipped
    toEnum 16 = VideoMultiviewFlags
VideoMultiviewFlagsRightFlopped
    toEnum 16384 = VideoMultiviewFlags
VideoMultiviewFlagsHalfAspect
    toEnum 32768 = VideoMultiviewFlags
VideoMultiviewFlagsMixedMono
    toEnum k :: Int
k = Int -> VideoMultiviewFlags
AnotherVideoMultiviewFlags Int
k

instance P.Ord VideoMultiviewFlags where
    compare :: VideoMultiviewFlags -> VideoMultiviewFlags -> Ordering
compare a :: VideoMultiviewFlags
a b :: VideoMultiviewFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoMultiviewFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoMultiviewFlags
a) (VideoMultiviewFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoMultiviewFlags
b)

foreign import ccall "gst_video_multiview_flags_get_type" c_gst_video_multiview_flags_get_type :: 
    IO GType

instance BoxedFlags VideoMultiviewFlags where
    boxedFlagsType :: Proxy VideoMultiviewFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_multiview_flags_get_type

instance IsGFlag VideoMultiviewFlags

-- Flags VideoFrameMapFlags
-- | Additional mapping flags for 'GI.GstVideo.Structs.VideoFrame.videoFrameMap'.
-- 
-- /Since: 1.6/
data VideoFrameMapFlags = 
      VideoFrameMapFlagsNoRef
    -- ^ Don\'t take another reference of the buffer and store it in
    --                                    the GstVideoFrame. This makes sure that the buffer stays
    --                                    writable while the frame is mapped, but requires that the
    --                                    buffer reference stays valid until the frame is unmapped again.
    | VideoFrameMapFlagsLast
    -- ^ Offset to define more flags
    | AnotherVideoFrameMapFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoFrameMapFlags -> ShowS
[VideoFrameMapFlags] -> ShowS
VideoFrameMapFlags -> String
(Int -> VideoFrameMapFlags -> ShowS)
-> (VideoFrameMapFlags -> String)
-> ([VideoFrameMapFlags] -> ShowS)
-> Show VideoFrameMapFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoFrameMapFlags] -> ShowS
$cshowList :: [VideoFrameMapFlags] -> ShowS
show :: VideoFrameMapFlags -> String
$cshow :: VideoFrameMapFlags -> String
showsPrec :: Int -> VideoFrameMapFlags -> ShowS
$cshowsPrec :: Int -> VideoFrameMapFlags -> ShowS
Show, VideoFrameMapFlags -> VideoFrameMapFlags -> Bool
(VideoFrameMapFlags -> VideoFrameMapFlags -> Bool)
-> (VideoFrameMapFlags -> VideoFrameMapFlags -> Bool)
-> Eq VideoFrameMapFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoFrameMapFlags -> VideoFrameMapFlags -> Bool
$c/= :: VideoFrameMapFlags -> VideoFrameMapFlags -> Bool
== :: VideoFrameMapFlags -> VideoFrameMapFlags -> Bool
$c== :: VideoFrameMapFlags -> VideoFrameMapFlags -> Bool
Eq)

instance P.Enum VideoFrameMapFlags where
    fromEnum :: VideoFrameMapFlags -> Int
fromEnum VideoFrameMapFlagsNoRef = 65536
    fromEnum VideoFrameMapFlagsLast = 16777216
    fromEnum (AnotherVideoFrameMapFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoFrameMapFlags
toEnum 65536 = VideoFrameMapFlags
VideoFrameMapFlagsNoRef
    toEnum 16777216 = VideoFrameMapFlags
VideoFrameMapFlagsLast
    toEnum k :: Int
k = Int -> VideoFrameMapFlags
AnotherVideoFrameMapFlags Int
k

instance P.Ord VideoFrameMapFlags where
    compare :: VideoFrameMapFlags -> VideoFrameMapFlags -> Ordering
compare a :: VideoFrameMapFlags
a b :: VideoFrameMapFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoFrameMapFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFrameMapFlags
a) (VideoFrameMapFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFrameMapFlags
b)

foreign import ccall "gst_video_frame_map_flags_get_type" c_gst_video_frame_map_flags_get_type :: 
    IO GType

instance BoxedFlags VideoFrameMapFlags where
    boxedFlagsType :: Proxy VideoFrameMapFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_frame_map_flags_get_type

instance IsGFlag VideoFrameMapFlags

-- Flags VideoFrameFlags
-- | Extra video frame flags
data VideoFrameFlags = 
      VideoFrameFlagsNone
    -- ^ no flags
    | VideoFrameFlagsInterlaced
    -- ^ The video frame is interlaced. In mixed
    --           interlace-mode, this flag specifies if the frame is interlaced or
    --           progressive.
    | VideoFrameFlagsTff
    -- ^ The video frame has the top field first
    | VideoFrameFlagsRff
    -- ^ The video frame has the repeat flag
    | VideoFrameFlagsOnefield
    -- ^ The video frame has one field
    | VideoFrameFlagsMultipleView
    -- ^ The video contains one or
    --     more non-mono views
    | VideoFrameFlagsFirstInBundle
    -- ^ The video frame is the first
    --     in a set of corresponding views provided as sequential frames.
    | VideoFrameFlagsTopField
    -- ^ The video frame has the top field only. This
    --     is the same as GST_VIDEO_FRAME_FLAG_TFF | GST_VIDEO_FRAME_FLAG_ONEFIELD
    --     (Since: 1.16).
    | VideoFrameFlagsBottomField
    -- ^ The video frame has the bottom field
    --     only. This is the same as GST_VIDEO_FRAME_FLAG_ONEFIELD
    --     (GST_VIDEO_FRAME_FLAG_TFF flag unset) (Since: 1.16).
    | AnotherVideoFrameFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoFrameFlags -> ShowS
[VideoFrameFlags] -> ShowS
VideoFrameFlags -> String
(Int -> VideoFrameFlags -> ShowS)
-> (VideoFrameFlags -> String)
-> ([VideoFrameFlags] -> ShowS)
-> Show VideoFrameFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoFrameFlags] -> ShowS
$cshowList :: [VideoFrameFlags] -> ShowS
show :: VideoFrameFlags -> String
$cshow :: VideoFrameFlags -> String
showsPrec :: Int -> VideoFrameFlags -> ShowS
$cshowsPrec :: Int -> VideoFrameFlags -> ShowS
Show, VideoFrameFlags -> VideoFrameFlags -> Bool
(VideoFrameFlags -> VideoFrameFlags -> Bool)
-> (VideoFrameFlags -> VideoFrameFlags -> Bool)
-> Eq VideoFrameFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoFrameFlags -> VideoFrameFlags -> Bool
$c/= :: VideoFrameFlags -> VideoFrameFlags -> Bool
== :: VideoFrameFlags -> VideoFrameFlags -> Bool
$c== :: VideoFrameFlags -> VideoFrameFlags -> Bool
Eq)

instance P.Enum VideoFrameFlags where
    fromEnum :: VideoFrameFlags -> Int
fromEnum VideoFrameFlagsNone = 0
    fromEnum VideoFrameFlagsInterlaced = 1
    fromEnum VideoFrameFlagsTff = 2
    fromEnum VideoFrameFlagsRff = 4
    fromEnum VideoFrameFlagsOnefield = 8
    fromEnum VideoFrameFlagsMultipleView = 16
    fromEnum VideoFrameFlagsFirstInBundle = 32
    fromEnum VideoFrameFlagsTopField = 10
    fromEnum VideoFrameFlagsBottomField = 8
    fromEnum (AnotherVideoFrameFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoFrameFlags
toEnum 0 = VideoFrameFlags
VideoFrameFlagsNone
    toEnum 1 = VideoFrameFlags
VideoFrameFlagsInterlaced
    toEnum 2 = VideoFrameFlags
VideoFrameFlagsTff
    toEnum 4 = VideoFrameFlags
VideoFrameFlagsRff
    toEnum 8 = VideoFrameFlags
VideoFrameFlagsOnefield
    toEnum 16 = VideoFrameFlags
VideoFrameFlagsMultipleView
    toEnum 32 = VideoFrameFlags
VideoFrameFlagsFirstInBundle
    toEnum 10 = VideoFrameFlags
VideoFrameFlagsTopField
    toEnum k :: Int
k = Int -> VideoFrameFlags
AnotherVideoFrameFlags Int
k

instance P.Ord VideoFrameFlags where
    compare :: VideoFrameFlags -> VideoFrameFlags -> Ordering
compare a :: VideoFrameFlags
a b :: VideoFrameFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoFrameFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFrameFlags
a) (VideoFrameFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFrameFlags
b)

foreign import ccall "gst_video_frame_flags_get_type" c_gst_video_frame_flags_get_type :: 
    IO GType

instance BoxedFlags VideoFrameFlags where
    boxedFlagsType :: Proxy VideoFrameFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_frame_flags_get_type

instance IsGFlag VideoFrameFlags

-- Flags VideoFormatFlags
-- | The different video flags that a format info can have.
data VideoFormatFlags = 
      VideoFormatFlagsYuv
    -- ^ The video format is YUV, components are numbered
    --   0=Y, 1=U, 2=V.
    | VideoFormatFlagsRgb
    -- ^ The video format is RGB, components are numbered
    --   0=R, 1=G, 2=B.
    | VideoFormatFlagsGray
    -- ^ The video is gray, there is one gray component
    --   with index 0.
    | VideoFormatFlagsAlpha
    -- ^ The video format has an alpha components with
    --   the number 3.
    | VideoFormatFlagsLe
    -- ^ The video format has data stored in little
    --   endianness.
    | VideoFormatFlagsPalette
    -- ^ The video format has a palette. The palette
    --   is stored in the second plane and indexes are stored in the first plane.
    | VideoFormatFlagsComplex
    -- ^ The video format has a complex layout that
    --   can\'t be described with the usual information in the t'GI.GstVideo.Structs.VideoFormatInfo.VideoFormatInfo'.
    | VideoFormatFlagsUnpack
    -- ^ This format can be used in a
    --   t'GI.GstVideo.Callbacks.VideoFormatUnpack' and t'GI.GstVideo.Callbacks.VideoFormatPack' function.
    | VideoFormatFlagsTiled
    -- ^ The format is tiled, there is tiling information
    --   in the last plane.
    | AnotherVideoFormatFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoFormatFlags -> ShowS
[VideoFormatFlags] -> ShowS
VideoFormatFlags -> String
(Int -> VideoFormatFlags -> ShowS)
-> (VideoFormatFlags -> String)
-> ([VideoFormatFlags] -> ShowS)
-> Show VideoFormatFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoFormatFlags] -> ShowS
$cshowList :: [VideoFormatFlags] -> ShowS
show :: VideoFormatFlags -> String
$cshow :: VideoFormatFlags -> String
showsPrec :: Int -> VideoFormatFlags -> ShowS
$cshowsPrec :: Int -> VideoFormatFlags -> ShowS
Show, VideoFormatFlags -> VideoFormatFlags -> Bool
(VideoFormatFlags -> VideoFormatFlags -> Bool)
-> (VideoFormatFlags -> VideoFormatFlags -> Bool)
-> Eq VideoFormatFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoFormatFlags -> VideoFormatFlags -> Bool
$c/= :: VideoFormatFlags -> VideoFormatFlags -> Bool
== :: VideoFormatFlags -> VideoFormatFlags -> Bool
$c== :: VideoFormatFlags -> VideoFormatFlags -> Bool
Eq)

instance P.Enum VideoFormatFlags where
    fromEnum :: VideoFormatFlags -> Int
fromEnum VideoFormatFlagsYuv = 1
    fromEnum VideoFormatFlagsRgb = 2
    fromEnum VideoFormatFlagsGray = 4
    fromEnum VideoFormatFlagsAlpha = 8
    fromEnum VideoFormatFlagsLe = 16
    fromEnum VideoFormatFlagsPalette = 32
    fromEnum VideoFormatFlagsComplex = 64
    fromEnum VideoFormatFlagsUnpack = 128
    fromEnum VideoFormatFlagsTiled = 256
    fromEnum (AnotherVideoFormatFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoFormatFlags
toEnum 1 = VideoFormatFlags
VideoFormatFlagsYuv
    toEnum 2 = VideoFormatFlags
VideoFormatFlagsRgb
    toEnum 4 = VideoFormatFlags
VideoFormatFlagsGray
    toEnum 8 = VideoFormatFlags
VideoFormatFlagsAlpha
    toEnum 16 = VideoFormatFlags
VideoFormatFlagsLe
    toEnum 32 = VideoFormatFlags
VideoFormatFlagsPalette
    toEnum 64 = VideoFormatFlags
VideoFormatFlagsComplex
    toEnum 128 = VideoFormatFlags
VideoFormatFlagsUnpack
    toEnum 256 = VideoFormatFlags
VideoFormatFlagsTiled
    toEnum k :: Int
k = Int -> VideoFormatFlags
AnotherVideoFormatFlags Int
k

instance P.Ord VideoFormatFlags where
    compare :: VideoFormatFlags -> VideoFormatFlags -> Ordering
compare a :: VideoFormatFlags
a b :: VideoFormatFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoFormatFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFormatFlags
a) (VideoFormatFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFormatFlags
b)

foreign import ccall "gst_video_format_flags_get_type" c_gst_video_format_flags_get_type :: 
    IO GType

instance BoxedFlags VideoFormatFlags where
    boxedFlagsType :: Proxy VideoFormatFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_format_flags_get_type

instance IsGFlag VideoFormatFlags

-- Flags VideoFlags
-- | Extra video flags
data VideoFlags = 
      VideoFlagsNone
    -- ^ no flags
    | VideoFlagsVariableFps
    -- ^ a variable fps is selected, fps_n and fps_d
    --     denote the maximum fps of the video
    | VideoFlagsPremultipliedAlpha
    -- ^ Each color has been scaled by the alpha
    --     value.
    | AnotherVideoFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoFlags -> ShowS
[VideoFlags] -> ShowS
VideoFlags -> String
(Int -> VideoFlags -> ShowS)
-> (VideoFlags -> String)
-> ([VideoFlags] -> ShowS)
-> Show VideoFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoFlags] -> ShowS
$cshowList :: [VideoFlags] -> ShowS
show :: VideoFlags -> String
$cshow :: VideoFlags -> String
showsPrec :: Int -> VideoFlags -> ShowS
$cshowsPrec :: Int -> VideoFlags -> ShowS
Show, VideoFlags -> VideoFlags -> Bool
(VideoFlags -> VideoFlags -> Bool)
-> (VideoFlags -> VideoFlags -> Bool) -> Eq VideoFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoFlags -> VideoFlags -> Bool
$c/= :: VideoFlags -> VideoFlags -> Bool
== :: VideoFlags -> VideoFlags -> Bool
$c== :: VideoFlags -> VideoFlags -> Bool
Eq)

instance P.Enum VideoFlags where
    fromEnum :: VideoFlags -> Int
fromEnum VideoFlagsNone = 0
    fromEnum VideoFlagsVariableFps = 1
    fromEnum VideoFlagsPremultipliedAlpha = 2
    fromEnum (AnotherVideoFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoFlags
toEnum 0 = VideoFlags
VideoFlagsNone
    toEnum 1 = VideoFlags
VideoFlagsVariableFps
    toEnum 2 = VideoFlags
VideoFlagsPremultipliedAlpha
    toEnum k :: Int
k = Int -> VideoFlags
AnotherVideoFlags Int
k

instance P.Ord VideoFlags where
    compare :: VideoFlags -> VideoFlags -> Ordering
compare a :: VideoFlags
a b :: VideoFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFlags
a) (VideoFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoFlags
b)

foreign import ccall "gst_video_flags_get_type" c_gst_video_flags_get_type :: 
    IO GType

instance BoxedFlags VideoFlags where
    boxedFlagsType :: Proxy VideoFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_flags_get_type

instance IsGFlag VideoFlags

-- Flags VideoDitherFlags
-- | Extra flags that influence the result from @/gst_video_chroma_resample_new()/@.
data VideoDitherFlags = 
      VideoDitherFlagsNone
    -- ^ no flags
    | VideoDitherFlagsInterlaced
    -- ^ the input is interlaced
    | VideoDitherFlagsQuantize
    -- ^ quantize values in addition to adding dither.
    | AnotherVideoDitherFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoDitherFlags -> ShowS
[VideoDitherFlags] -> ShowS
VideoDitherFlags -> String
(Int -> VideoDitherFlags -> ShowS)
-> (VideoDitherFlags -> String)
-> ([VideoDitherFlags] -> ShowS)
-> Show VideoDitherFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoDitherFlags] -> ShowS
$cshowList :: [VideoDitherFlags] -> ShowS
show :: VideoDitherFlags -> String
$cshow :: VideoDitherFlags -> String
showsPrec :: Int -> VideoDitherFlags -> ShowS
$cshowsPrec :: Int -> VideoDitherFlags -> ShowS
Show, VideoDitherFlags -> VideoDitherFlags -> Bool
(VideoDitherFlags -> VideoDitherFlags -> Bool)
-> (VideoDitherFlags -> VideoDitherFlags -> Bool)
-> Eq VideoDitherFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoDitherFlags -> VideoDitherFlags -> Bool
$c/= :: VideoDitherFlags -> VideoDitherFlags -> Bool
== :: VideoDitherFlags -> VideoDitherFlags -> Bool
$c== :: VideoDitherFlags -> VideoDitherFlags -> Bool
Eq)

instance P.Enum VideoDitherFlags where
    fromEnum :: VideoDitherFlags -> Int
fromEnum VideoDitherFlagsNone = 0
    fromEnum VideoDitherFlagsInterlaced = 1
    fromEnum VideoDitherFlagsQuantize = 2
    fromEnum (AnotherVideoDitherFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoDitherFlags
toEnum 0 = VideoDitherFlags
VideoDitherFlagsNone
    toEnum 1 = VideoDitherFlags
VideoDitherFlagsInterlaced
    toEnum 2 = VideoDitherFlags
VideoDitherFlagsQuantize
    toEnum k :: Int
k = Int -> VideoDitherFlags
AnotherVideoDitherFlags Int
k

instance P.Ord VideoDitherFlags where
    compare :: VideoDitherFlags -> VideoDitherFlags -> Ordering
compare a :: VideoDitherFlags
a b :: VideoDitherFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoDitherFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoDitherFlags
a) (VideoDitherFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoDitherFlags
b)

foreign import ccall "gst_video_dither_flags_get_type" c_gst_video_dither_flags_get_type :: 
    IO GType

instance BoxedFlags VideoDitherFlags where
    boxedFlagsType :: Proxy VideoDitherFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_dither_flags_get_type

instance IsGFlag VideoDitherFlags

-- Flags VideoCodecFrameFlags
-- | Flags for t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
data VideoCodecFrameFlags = 
      VideoCodecFrameFlagsDecodeOnly
    -- ^ is the frame only meant to be decoded
    | VideoCodecFrameFlagsSyncPoint
    -- ^ is the frame a synchronization point (keyframe)
    | VideoCodecFrameFlagsForceKeyframe
    -- ^ should the output frame be made a keyframe
    | VideoCodecFrameFlagsForceKeyframeHeaders
    -- ^ should the encoder output stream headers
    | AnotherVideoCodecFrameFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoCodecFrameFlags -> ShowS
[VideoCodecFrameFlags] -> ShowS
VideoCodecFrameFlags -> String
(Int -> VideoCodecFrameFlags -> ShowS)
-> (VideoCodecFrameFlags -> String)
-> ([VideoCodecFrameFlags] -> ShowS)
-> Show VideoCodecFrameFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoCodecFrameFlags] -> ShowS
$cshowList :: [VideoCodecFrameFlags] -> ShowS
show :: VideoCodecFrameFlags -> String
$cshow :: VideoCodecFrameFlags -> String
showsPrec :: Int -> VideoCodecFrameFlags -> ShowS
$cshowsPrec :: Int -> VideoCodecFrameFlags -> ShowS
Show, VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool
(VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool)
-> (VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool)
-> Eq VideoCodecFrameFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool
$c/= :: VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool
== :: VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool
$c== :: VideoCodecFrameFlags -> VideoCodecFrameFlags -> Bool
Eq)

instance P.Enum VideoCodecFrameFlags where
    fromEnum :: VideoCodecFrameFlags -> Int
fromEnum VideoCodecFrameFlagsDecodeOnly = 1
    fromEnum VideoCodecFrameFlagsSyncPoint = 2
    fromEnum VideoCodecFrameFlagsForceKeyframe = 4
    fromEnum VideoCodecFrameFlagsForceKeyframeHeaders = 8
    fromEnum (AnotherVideoCodecFrameFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoCodecFrameFlags
toEnum 1 = VideoCodecFrameFlags
VideoCodecFrameFlagsDecodeOnly
    toEnum 2 = VideoCodecFrameFlags
VideoCodecFrameFlagsSyncPoint
    toEnum 4 = VideoCodecFrameFlags
VideoCodecFrameFlagsForceKeyframe
    toEnum 8 = VideoCodecFrameFlags
VideoCodecFrameFlagsForceKeyframeHeaders
    toEnum k :: Int
k = Int -> VideoCodecFrameFlags
AnotherVideoCodecFrameFlags Int
k

instance P.Ord VideoCodecFrameFlags where
    compare :: VideoCodecFrameFlags -> VideoCodecFrameFlags -> Ordering
compare a :: VideoCodecFrameFlags
a b :: VideoCodecFrameFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoCodecFrameFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoCodecFrameFlags
a) (VideoCodecFrameFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoCodecFrameFlags
b)

instance IsGFlag VideoCodecFrameFlags

-- Flags VideoChromaSite
-- | Various Chroma sitings.
data VideoChromaSite = 
      VideoChromaSiteUnknown
    -- ^ unknown cositing
    | VideoChromaSiteNone
    -- ^ no cositing
    | VideoChromaSiteHCosited
    -- ^ chroma is horizontally cosited
    | VideoChromaSiteVCosited
    -- ^ chroma is vertically cosited
    | VideoChromaSiteAltLine
    -- ^ choma samples are sited on alternate lines
    | VideoChromaSiteCosited
    -- ^ chroma samples cosited with luma samples
    | VideoChromaSiteJpeg
    -- ^ jpeg style cositing, also for mpeg1 and mjpeg
    | VideoChromaSiteMpeg2
    -- ^ mpeg2 style cositing
    | VideoChromaSiteDv
    -- ^ DV style cositing
    | AnotherVideoChromaSite Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoChromaSite -> ShowS
[VideoChromaSite] -> ShowS
VideoChromaSite -> String
(Int -> VideoChromaSite -> ShowS)
-> (VideoChromaSite -> String)
-> ([VideoChromaSite] -> ShowS)
-> Show VideoChromaSite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoChromaSite] -> ShowS
$cshowList :: [VideoChromaSite] -> ShowS
show :: VideoChromaSite -> String
$cshow :: VideoChromaSite -> String
showsPrec :: Int -> VideoChromaSite -> ShowS
$cshowsPrec :: Int -> VideoChromaSite -> ShowS
Show, VideoChromaSite -> VideoChromaSite -> Bool
(VideoChromaSite -> VideoChromaSite -> Bool)
-> (VideoChromaSite -> VideoChromaSite -> Bool)
-> Eq VideoChromaSite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoChromaSite -> VideoChromaSite -> Bool
$c/= :: VideoChromaSite -> VideoChromaSite -> Bool
== :: VideoChromaSite -> VideoChromaSite -> Bool
$c== :: VideoChromaSite -> VideoChromaSite -> Bool
Eq)

instance P.Enum VideoChromaSite where
    fromEnum :: VideoChromaSite -> Int
fromEnum VideoChromaSiteUnknown = 0
    fromEnum VideoChromaSiteNone = 1
    fromEnum VideoChromaSiteHCosited = 2
    fromEnum VideoChromaSiteVCosited = 4
    fromEnum VideoChromaSiteAltLine = 8
    fromEnum VideoChromaSiteCosited = 6
    fromEnum VideoChromaSiteJpeg = 1
    fromEnum VideoChromaSiteMpeg2 = 2
    fromEnum VideoChromaSiteDv = 14
    fromEnum (AnotherVideoChromaSite k :: Int
k) = Int
k

    toEnum :: Int -> VideoChromaSite
toEnum 0 = VideoChromaSite
VideoChromaSiteUnknown
    toEnum 1 = VideoChromaSite
VideoChromaSiteNone
    toEnum 2 = VideoChromaSite
VideoChromaSiteHCosited
    toEnum 4 = VideoChromaSite
VideoChromaSiteVCosited
    toEnum 8 = VideoChromaSite
VideoChromaSiteAltLine
    toEnum 6 = VideoChromaSite
VideoChromaSiteCosited
    toEnum 14 = VideoChromaSite
VideoChromaSiteDv
    toEnum k :: Int
k = Int -> VideoChromaSite
AnotherVideoChromaSite Int
k

instance P.Ord VideoChromaSite where
    compare :: VideoChromaSite -> VideoChromaSite -> Ordering
compare a :: VideoChromaSite
a b :: VideoChromaSite
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoChromaSite -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoChromaSite
a) (VideoChromaSite -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoChromaSite
b)

foreign import ccall "gst_video_chroma_site_get_type" c_gst_video_chroma_site_get_type :: 
    IO GType

instance BoxedFlags VideoChromaSite where
    boxedFlagsType :: Proxy VideoChromaSite -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_chroma_site_get_type

instance IsGFlag VideoChromaSite

-- Flags VideoChromaFlags
-- | Extra flags that influence the result from @/gst_video_chroma_resample_new()/@.
data VideoChromaFlags = 
      VideoChromaFlagsNone
    -- ^ no flags
    | VideoChromaFlagsInterlaced
    -- ^ the input is interlaced
    | AnotherVideoChromaFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoChromaFlags -> ShowS
[VideoChromaFlags] -> ShowS
VideoChromaFlags -> String
(Int -> VideoChromaFlags -> ShowS)
-> (VideoChromaFlags -> String)
-> ([VideoChromaFlags] -> ShowS)
-> Show VideoChromaFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoChromaFlags] -> ShowS
$cshowList :: [VideoChromaFlags] -> ShowS
show :: VideoChromaFlags -> String
$cshow :: VideoChromaFlags -> String
showsPrec :: Int -> VideoChromaFlags -> ShowS
$cshowsPrec :: Int -> VideoChromaFlags -> ShowS
Show, VideoChromaFlags -> VideoChromaFlags -> Bool
(VideoChromaFlags -> VideoChromaFlags -> Bool)
-> (VideoChromaFlags -> VideoChromaFlags -> Bool)
-> Eq VideoChromaFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoChromaFlags -> VideoChromaFlags -> Bool
$c/= :: VideoChromaFlags -> VideoChromaFlags -> Bool
== :: VideoChromaFlags -> VideoChromaFlags -> Bool
$c== :: VideoChromaFlags -> VideoChromaFlags -> Bool
Eq)

instance P.Enum VideoChromaFlags where
    fromEnum :: VideoChromaFlags -> Int
fromEnum VideoChromaFlagsNone = 0
    fromEnum VideoChromaFlagsInterlaced = 1
    fromEnum (AnotherVideoChromaFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoChromaFlags
toEnum 0 = VideoChromaFlags
VideoChromaFlagsNone
    toEnum 1 = VideoChromaFlags
VideoChromaFlagsInterlaced
    toEnum k :: Int
k = Int -> VideoChromaFlags
AnotherVideoChromaFlags Int
k

instance P.Ord VideoChromaFlags where
    compare :: VideoChromaFlags -> VideoChromaFlags -> Ordering
compare a :: VideoChromaFlags
a b :: VideoChromaFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoChromaFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoChromaFlags
a) (VideoChromaFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoChromaFlags
b)

foreign import ccall "gst_video_chroma_flags_get_type" c_gst_video_chroma_flags_get_type :: 
    IO GType

instance BoxedFlags VideoChromaFlags where
    boxedFlagsType :: Proxy VideoChromaFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_chroma_flags_get_type

instance IsGFlag VideoChromaFlags

-- Flags VideoBufferFlags
-- | Additional video buffer flags. These flags can potentially be used on any
-- buffers carrying video data - even encoded data.
-- 
-- Note that these are only valid for t'GI.Gst.Structs.Caps.Caps' of type: video\/...
-- They can conflict with other extended buffer flags.
data VideoBufferFlags = 
      VideoBufferFlagsInterlaced
    -- ^ If the t'GI.Gst.Structs.Buffer.Buffer' is interlaced. In mixed
    --                                     interlace-mode, this flags specifies if the frame is
    --                                     interlaced or progressive.
    | VideoBufferFlagsTff
    -- ^ If the t'GI.Gst.Structs.Buffer.Buffer' is interlaced, then the first field
    --                                     in the video frame is the top field.  If unset, the
    --                                     bottom field is first.
    | VideoBufferFlagsRff
    -- ^ If the t'GI.Gst.Structs.Buffer.Buffer' is interlaced, then the first field
    --                                     (as defined by the 'GI.GstVideo.Flags.VideoBufferFlagsTff' flag setting)
    --                                     is repeated.
    | VideoBufferFlagsOnefield
    -- ^ If the t'GI.Gst.Structs.Buffer.Buffer' is interlaced, then only the
    --                                     first field (as defined by the 'GI.GstVideo.Flags.VideoBufferFlagsTff'
    --                                     flag setting) is to be displayed (Since: 1.16).
    | VideoBufferFlagsMultipleView
    -- ^ The t'GI.Gst.Structs.Buffer.Buffer' contains one or more specific views,
    --                                     such as left or right eye view. This flags is set on
    --                                     any buffer that contains non-mono content - even for
    --                                     streams that contain only a single viewpoint. In mixed
    --                                     mono \/ non-mono streams, the absense of the flag marks
    --                                     mono buffers.
    | VideoBufferFlagsFirstInBundle
    -- ^ When conveying stereo\/multiview content with
    --                                     frame-by-frame methods, this flag marks the first buffer
    --                                      in a bundle of frames that belong together.
    | VideoBufferFlagsTopField
    -- ^ The video frame has the top field only. This is the
    --                                     same as GST_VIDEO_BUFFER_FLAG_TFF |
    --                                     GST_VIDEO_BUFFER_FLAG_ONEFIELD (Since: 1.16).
    | VideoBufferFlagsBottomField
    -- ^ The video frame has the bottom field only. This is
    --                                     the same as GST_VIDEO_BUFFER_FLAG_ONEFIELD
    --                                     (GST_VIDEO_BUFFER_FLAG_TFF flag unset) (Since: 1.16).
    | VideoBufferFlagsLast
    -- ^ Offset to define more flags
    | AnotherVideoBufferFlags Int
    -- ^ Catch-all for unknown values
    deriving (Int -> VideoBufferFlags -> ShowS
[VideoBufferFlags] -> ShowS
VideoBufferFlags -> String
(Int -> VideoBufferFlags -> ShowS)
-> (VideoBufferFlags -> String)
-> ([VideoBufferFlags] -> ShowS)
-> Show VideoBufferFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoBufferFlags] -> ShowS
$cshowList :: [VideoBufferFlags] -> ShowS
show :: VideoBufferFlags -> String
$cshow :: VideoBufferFlags -> String
showsPrec :: Int -> VideoBufferFlags -> ShowS
$cshowsPrec :: Int -> VideoBufferFlags -> ShowS
Show, VideoBufferFlags -> VideoBufferFlags -> Bool
(VideoBufferFlags -> VideoBufferFlags -> Bool)
-> (VideoBufferFlags -> VideoBufferFlags -> Bool)
-> Eq VideoBufferFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoBufferFlags -> VideoBufferFlags -> Bool
$c/= :: VideoBufferFlags -> VideoBufferFlags -> Bool
== :: VideoBufferFlags -> VideoBufferFlags -> Bool
$c== :: VideoBufferFlags -> VideoBufferFlags -> Bool
Eq)

instance P.Enum VideoBufferFlags where
    fromEnum :: VideoBufferFlags -> Int
fromEnum VideoBufferFlagsInterlaced = 1048576
    fromEnum VideoBufferFlagsTff = 2097152
    fromEnum VideoBufferFlagsRff = 4194304
    fromEnum VideoBufferFlagsOnefield = 8388608
    fromEnum VideoBufferFlagsMultipleView = 16777216
    fromEnum VideoBufferFlagsFirstInBundle = 33554432
    fromEnum VideoBufferFlagsTopField = 10485760
    fromEnum VideoBufferFlagsBottomField = 8388608
    fromEnum VideoBufferFlagsLast = 268435456
    fromEnum (AnotherVideoBufferFlags k :: Int
k) = Int
k

    toEnum :: Int -> VideoBufferFlags
toEnum 1048576 = VideoBufferFlags
VideoBufferFlagsInterlaced
    toEnum 2097152 = VideoBufferFlags
VideoBufferFlagsTff
    toEnum 4194304 = VideoBufferFlags
VideoBufferFlagsRff
    toEnum 8388608 = VideoBufferFlags
VideoBufferFlagsOnefield
    toEnum 16777216 = VideoBufferFlags
VideoBufferFlagsMultipleView
    toEnum 33554432 = VideoBufferFlags
VideoBufferFlagsFirstInBundle
    toEnum 10485760 = VideoBufferFlags
VideoBufferFlagsTopField
    toEnum 268435456 = VideoBufferFlags
VideoBufferFlagsLast
    toEnum k :: Int
k = Int -> VideoBufferFlags
AnotherVideoBufferFlags Int
k

instance P.Ord VideoBufferFlags where
    compare :: VideoBufferFlags -> VideoBufferFlags -> Ordering
compare a :: VideoBufferFlags
a b :: VideoBufferFlags
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (VideoBufferFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoBufferFlags
a) (VideoBufferFlags -> Int
forall a. Enum a => a -> Int
P.fromEnum VideoBufferFlags
b)

foreign import ccall "gst_video_buffer_flags_get_type" c_gst_video_buffer_flags_get_type :: 
    IO GType

instance BoxedFlags VideoBufferFlags where
    boxedFlagsType :: Proxy VideoBufferFlags -> IO GType
boxedFlagsType _ = IO GType
c_gst_video_buffer_flags_get_type

instance IsGFlag VideoBufferFlags