{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Structure describing the color info.

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

module GI.GstVideo.Structs.VideoColorimetry
    ( 

-- * Exported types
    VideoColorimetry(..)                    ,
    newZeroVideoColorimetry                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [fromString]("GI.GstVideo.Structs.VideoColorimetry#g:method:fromString"), [isEqual]("GI.GstVideo.Structs.VideoColorimetry#g:method:isEqual"), [isEquivalent]("GI.GstVideo.Structs.VideoColorimetry#g:method:isEquivalent"), [matches]("GI.GstVideo.Structs.VideoColorimetry#g:method:matches"), [toString]("GI.GstVideo.Structs.VideoColorimetry#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoColorimetryMethod           ,
#endif

-- ** fromString #method:fromString#

#if defined(ENABLE_OVERLOADING)
    VideoColorimetryFromStringMethodInfo    ,
#endif
    videoColorimetryFromString              ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    VideoColorimetryIsEqualMethodInfo       ,
#endif
    videoColorimetryIsEqual                 ,


-- ** isEquivalent #method:isEquivalent#

#if defined(ENABLE_OVERLOADING)
    VideoColorimetryIsEquivalentMethodInfo  ,
#endif
    videoColorimetryIsEquivalent            ,


-- ** matches #method:matches#

#if defined(ENABLE_OVERLOADING)
    VideoColorimetryMatchesMethodInfo       ,
#endif
    videoColorimetryMatches                 ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    VideoColorimetryToStringMethodInfo      ,
#endif
    videoColorimetryToString                ,




 -- * Properties


-- ** matrix #attr:matrix#
-- | the color matrix. Used to convert between Y\'PbPr and
--          non-linear RGB (R\'G\'B\')

    getVideoColorimetryMatrix               ,
    setVideoColorimetryMatrix               ,
#if defined(ENABLE_OVERLOADING)
    videoColorimetry_matrix                 ,
#endif


-- ** primaries #attr:primaries#
-- | color primaries. used to convert between R\'G\'B\' and CIE XYZ

    getVideoColorimetryPrimaries            ,
    setVideoColorimetryPrimaries            ,
#if defined(ENABLE_OVERLOADING)
    videoColorimetry_primaries              ,
#endif


-- ** range #attr:range#
-- | the color range. This is the valid range for the samples.
--         It is used to convert the samples to Y\'PbPr values.

    getVideoColorimetryRange                ,
    setVideoColorimetryRange                ,
#if defined(ENABLE_OVERLOADING)
    videoColorimetry_range                  ,
#endif


-- ** transfer #attr:transfer#
-- | the transfer function. used to convert between R\'G\'B\' and RGB

    getVideoColorimetryTransfer             ,
    setVideoColorimetryTransfer             ,
#if defined(ENABLE_OVERLOADING)
    videoColorimetry_transfer               ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums

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

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

instance BoxedPtr VideoColorimetry where
    boxedPtrCopy :: VideoColorimetry -> IO VideoColorimetry
boxedPtrCopy = \VideoColorimetry
p -> VideoColorimetry
-> (Ptr VideoColorimetry -> IO VideoColorimetry)
-> IO VideoColorimetry
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoColorimetry
p (Int -> Ptr VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
16 (Ptr VideoColorimetry -> IO (Ptr VideoColorimetry))
-> (Ptr VideoColorimetry -> IO VideoColorimetry)
-> Ptr VideoColorimetry
-> IO VideoColorimetry
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr VideoColorimetry -> VideoColorimetry)
-> Ptr VideoColorimetry -> IO VideoColorimetry
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr VideoColorimetry -> VideoColorimetry
VideoColorimetry)
    boxedPtrFree :: VideoColorimetry -> IO ()
boxedPtrFree = \VideoColorimetry
x -> VideoColorimetry -> (Ptr VideoColorimetry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr VideoColorimetry
x Ptr VideoColorimetry -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr VideoColorimetry where
    boxedPtrCalloc :: IO (Ptr VideoColorimetry)
boxedPtrCalloc = Int -> IO (Ptr VideoColorimetry)
forall a. Int -> IO (Ptr a)
callocBytes Int
16


-- | Construct a `VideoColorimetry` struct initialized to zero.
newZeroVideoColorimetry :: MonadIO m => m VideoColorimetry
newZeroVideoColorimetry :: forall (m :: * -> *). MonadIO m => m VideoColorimetry
newZeroVideoColorimetry = IO VideoColorimetry -> m VideoColorimetry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoColorimetry -> m VideoColorimetry)
-> IO VideoColorimetry -> m VideoColorimetry
forall a b. (a -> b) -> a -> b
$ IO (Ptr VideoColorimetry)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr VideoColorimetry)
-> (Ptr VideoColorimetry -> IO VideoColorimetry)
-> IO VideoColorimetry
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoColorimetry -> VideoColorimetry)
-> Ptr VideoColorimetry -> IO VideoColorimetry
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoColorimetry -> VideoColorimetry
VideoColorimetry

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


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

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

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryRangeFieldInfo
instance AttrInfo VideoColorimetryRangeFieldInfo where
    type AttrBaseTypeConstraint VideoColorimetryRangeFieldInfo = (~) VideoColorimetry
    type AttrAllowedOps VideoColorimetryRangeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorimetryRangeFieldInfo = (~) GstVideo.Enums.VideoColorRange
    type AttrTransferTypeConstraint VideoColorimetryRangeFieldInfo = (~)GstVideo.Enums.VideoColorRange
    type AttrTransferType VideoColorimetryRangeFieldInfo = GstVideo.Enums.VideoColorRange
    type AttrGetType VideoColorimetryRangeFieldInfo = GstVideo.Enums.VideoColorRange
    type AttrLabel VideoColorimetryRangeFieldInfo = "range"
    type AttrOrigin VideoColorimetryRangeFieldInfo = VideoColorimetry
    attrGet = getVideoColorimetryRange
    attrSet = setVideoColorimetryRange
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.range"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#g:attr:range"
        })

videoColorimetry_range :: AttrLabelProxy "range"
videoColorimetry_range = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryMatrixFieldInfo
instance AttrInfo VideoColorimetryMatrixFieldInfo where
    type AttrBaseTypeConstraint VideoColorimetryMatrixFieldInfo = (~) VideoColorimetry
    type AttrAllowedOps VideoColorimetryMatrixFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorimetryMatrixFieldInfo = (~) GstVideo.Enums.VideoColorMatrix
    type AttrTransferTypeConstraint VideoColorimetryMatrixFieldInfo = (~)GstVideo.Enums.VideoColorMatrix
    type AttrTransferType VideoColorimetryMatrixFieldInfo = GstVideo.Enums.VideoColorMatrix
    type AttrGetType VideoColorimetryMatrixFieldInfo = GstVideo.Enums.VideoColorMatrix
    type AttrLabel VideoColorimetryMatrixFieldInfo = "matrix"
    type AttrOrigin VideoColorimetryMatrixFieldInfo = VideoColorimetry
    attrGet = getVideoColorimetryMatrix
    attrSet = setVideoColorimetryMatrix
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.matrix"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#g:attr:matrix"
        })

videoColorimetry_matrix :: AttrLabelProxy "matrix"
videoColorimetry_matrix = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryTransferFieldInfo
instance AttrInfo VideoColorimetryTransferFieldInfo where
    type AttrBaseTypeConstraint VideoColorimetryTransferFieldInfo = (~) VideoColorimetry
    type AttrAllowedOps VideoColorimetryTransferFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorimetryTransferFieldInfo = (~) GstVideo.Enums.VideoTransferFunction
    type AttrTransferTypeConstraint VideoColorimetryTransferFieldInfo = (~)GstVideo.Enums.VideoTransferFunction
    type AttrTransferType VideoColorimetryTransferFieldInfo = GstVideo.Enums.VideoTransferFunction
    type AttrGetType VideoColorimetryTransferFieldInfo = GstVideo.Enums.VideoTransferFunction
    type AttrLabel VideoColorimetryTransferFieldInfo = "transfer"
    type AttrOrigin VideoColorimetryTransferFieldInfo = VideoColorimetry
    attrGet = getVideoColorimetryTransfer
    attrSet = setVideoColorimetryTransfer
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.transfer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#g:attr:transfer"
        })

videoColorimetry_transfer :: AttrLabelProxy "transfer"
videoColorimetry_transfer = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryPrimariesFieldInfo
instance AttrInfo VideoColorimetryPrimariesFieldInfo where
    type AttrBaseTypeConstraint VideoColorimetryPrimariesFieldInfo = (~) VideoColorimetry
    type AttrAllowedOps VideoColorimetryPrimariesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorimetryPrimariesFieldInfo = (~) GstVideo.Enums.VideoColorPrimaries
    type AttrTransferTypeConstraint VideoColorimetryPrimariesFieldInfo = (~)GstVideo.Enums.VideoColorPrimaries
    type AttrTransferType VideoColorimetryPrimariesFieldInfo = GstVideo.Enums.VideoColorPrimaries
    type AttrGetType VideoColorimetryPrimariesFieldInfo = GstVideo.Enums.VideoColorPrimaries
    type AttrLabel VideoColorimetryPrimariesFieldInfo = "primaries"
    type AttrOrigin VideoColorimetryPrimariesFieldInfo = VideoColorimetry
    attrGet = getVideoColorimetryPrimaries
    attrSet = setVideoColorimetryPrimaries
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.primaries"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#g:attr:primaries"
        })

videoColorimetry_primaries :: AttrLabelProxy "primaries"
videoColorimetry_primaries = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoColorimetry
type instance O.AttributeList VideoColorimetry = VideoColorimetryAttributeList
type VideoColorimetryAttributeList = ('[ '("range", VideoColorimetryRangeFieldInfo), '("matrix", VideoColorimetryMatrixFieldInfo), '("transfer", VideoColorimetryTransferFieldInfo), '("primaries", VideoColorimetryPrimariesFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method VideoColorimetry::from_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cinfo"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoColorimetry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoColorimetry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a colorimetry string"
--                 , 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_video_colorimetry_from_string" gst_video_colorimetry_from_string :: 
    Ptr VideoColorimetry ->                 -- cinfo : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    CString ->                              -- color : TBasicType TUTF8
    IO CInt

-- | Parse the colorimetry string and update /@cinfo@/ with the parsed
-- values.
videoColorimetryFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoColorimetry
    -- ^ /@cinfo@/: a t'GI.GstVideo.Structs.VideoColorimetry.VideoColorimetry'
    -> T.Text
    -- ^ /@color@/: a colorimetry string
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@color@/ points to valid colorimetry info.
videoColorimetryFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoColorimetry -> Text -> m Bool
videoColorimetryFromString VideoColorimetry
cinfo Text
color = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoColorimetry
cinfo' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
cinfo
    CString
color' <- Text -> IO CString
textToCString Text
color
    CInt
result <- Ptr VideoColorimetry -> CString -> IO CInt
gst_video_colorimetry_from_string Ptr VideoColorimetry
cinfo' CString
color'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
cinfo
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
color'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryFromStringMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod VideoColorimetryFromStringMethodInfo VideoColorimetry signature where
    overloadedMethod = videoColorimetryFromString

instance O.OverloadedMethodInfo VideoColorimetryFromStringMethodInfo VideoColorimetry where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.videoColorimetryFromString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#v:videoColorimetryFromString"
        })


#endif

-- method VideoColorimetry::is_equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cinfo"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoColorimetry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoColorimetry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoColorimetry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #GstVideoColorimetry"
--                 , 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_video_colorimetry_is_equal" gst_video_colorimetry_is_equal :: 
    Ptr VideoColorimetry ->                 -- cinfo : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    Ptr VideoColorimetry ->                 -- other : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    IO CInt

-- | Compare the 2 colorimetry sets for equality
-- 
-- /Since: 1.6/
videoColorimetryIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoColorimetry
    -- ^ /@cinfo@/: a t'GI.GstVideo.Structs.VideoColorimetry.VideoColorimetry'
    -> VideoColorimetry
    -- ^ /@other@/: another t'GI.GstVideo.Structs.VideoColorimetry.VideoColorimetry'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@cinfo@/ and /@other@/ are equal.
videoColorimetryIsEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoColorimetry -> VideoColorimetry -> m Bool
videoColorimetryIsEqual VideoColorimetry
cinfo VideoColorimetry
other = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoColorimetry
cinfo' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
cinfo
    Ptr VideoColorimetry
other' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
other
    CInt
result <- Ptr VideoColorimetry -> Ptr VideoColorimetry -> IO CInt
gst_video_colorimetry_is_equal Ptr VideoColorimetry
cinfo' Ptr VideoColorimetry
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
cinfo
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
other
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryIsEqualMethodInfo
instance (signature ~ (VideoColorimetry -> m Bool), MonadIO m) => O.OverloadedMethod VideoColorimetryIsEqualMethodInfo VideoColorimetry signature where
    overloadedMethod = videoColorimetryIsEqual

instance O.OverloadedMethodInfo VideoColorimetryIsEqualMethodInfo VideoColorimetry where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.videoColorimetryIsEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#v:videoColorimetryIsEqual"
        })


#endif

-- method VideoColorimetry::is_equivalent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cinfo"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoColorimetry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoColorimetry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bitdepth"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitdepth of a format associated with @cinfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoColorimetry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #GstVideoColorimetry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other_bitdepth"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitdepth of a format associated with @other"
--                 , 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_video_colorimetry_is_equivalent" gst_video_colorimetry_is_equivalent :: 
    Ptr VideoColorimetry ->                 -- cinfo : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    Word32 ->                               -- bitdepth : TBasicType TUInt
    Ptr VideoColorimetry ->                 -- other : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    Word32 ->                               -- other_bitdepth : TBasicType TUInt
    IO CInt

-- | Compare the 2 colorimetry sets for functionally equality
-- 
-- /Since: 1.22/
videoColorimetryIsEquivalent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoColorimetry
    -- ^ /@cinfo@/: a t'GI.GstVideo.Structs.VideoColorimetry.VideoColorimetry'
    -> Word32
    -- ^ /@bitdepth@/: bitdepth of a format associated with /@cinfo@/
    -> VideoColorimetry
    -- ^ /@other@/: another t'GI.GstVideo.Structs.VideoColorimetry.VideoColorimetry'
    -> Word32
    -- ^ /@otherBitdepth@/: bitdepth of a format associated with /@other@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@cinfo@/ and /@other@/ are equivalent.
videoColorimetryIsEquivalent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoColorimetry -> Word32 -> VideoColorimetry -> Word32 -> m Bool
videoColorimetryIsEquivalent VideoColorimetry
cinfo Word32
bitdepth VideoColorimetry
other Word32
otherBitdepth = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoColorimetry
cinfo' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
cinfo
    Ptr VideoColorimetry
other' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
other
    CInt
result <- Ptr VideoColorimetry
-> Word32 -> Ptr VideoColorimetry -> Word32 -> IO CInt
gst_video_colorimetry_is_equivalent Ptr VideoColorimetry
cinfo' Word32
bitdepth Ptr VideoColorimetry
other' Word32
otherBitdepth
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
cinfo
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
other
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryIsEquivalentMethodInfo
instance (signature ~ (Word32 -> VideoColorimetry -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod VideoColorimetryIsEquivalentMethodInfo VideoColorimetry signature where
    overloadedMethod = videoColorimetryIsEquivalent

instance O.OverloadedMethodInfo VideoColorimetryIsEquivalentMethodInfo VideoColorimetry where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.videoColorimetryIsEquivalent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#v:videoColorimetryIsEquivalent"
        })


#endif

-- method VideoColorimetry::matches
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cinfo"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoColorimetry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a colorimetry string"
--                 , 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_video_colorimetry_matches" gst_video_colorimetry_matches :: 
    Ptr VideoColorimetry ->                 -- cinfo : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    CString ->                              -- color : TBasicType TUTF8
    IO CInt

-- | Check if the colorimetry information in /@info@/ matches that of the
-- string /@color@/.
videoColorimetryMatches ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoColorimetry
    -- ^ /@cinfo@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> T.Text
    -- ^ /@color@/: a colorimetry string
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@color@/ conveys the same colorimetry info as the color
    -- information in /@info@/.
videoColorimetryMatches :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoColorimetry -> Text -> m Bool
videoColorimetryMatches VideoColorimetry
cinfo Text
color = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoColorimetry
cinfo' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
cinfo
    CString
color' <- Text -> IO CString
textToCString Text
color
    CInt
result <- Ptr VideoColorimetry -> CString -> IO CInt
gst_video_colorimetry_matches Ptr VideoColorimetry
cinfo' CString
color'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
cinfo
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
color'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryMatchesMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod VideoColorimetryMatchesMethodInfo VideoColorimetry signature where
    overloadedMethod = videoColorimetryMatches

instance O.OverloadedMethodInfo VideoColorimetryMatchesMethodInfo VideoColorimetry where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.videoColorimetryMatches",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#v:videoColorimetryMatches"
        })


#endif

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

foreign import ccall "gst_video_colorimetry_to_string" gst_video_colorimetry_to_string :: 
    Ptr VideoColorimetry ->                 -- cinfo : TInterface (Name {namespace = "GstVideo", name = "VideoColorimetry"})
    IO CString

-- | Make a string representation of /@cinfo@/.
videoColorimetryToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoColorimetry
    -- ^ /@cinfo@/: a t'GI.GstVideo.Structs.VideoColorimetry.VideoColorimetry'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string representation of /@cinfo@/
    -- or 'P.Nothing' if all the entries of /@cinfo@/ are unknown values.
videoColorimetryToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoColorimetry -> m (Maybe Text)
videoColorimetryToString VideoColorimetry
cinfo = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoColorimetry
cinfo' <- VideoColorimetry -> IO (Ptr VideoColorimetry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoColorimetry
cinfo
    CString
result <- Ptr VideoColorimetry -> IO CString
gst_video_colorimetry_to_string Ptr VideoColorimetry
cinfo'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    VideoColorimetry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoColorimetry
cinfo
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoColorimetryToStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod VideoColorimetryToStringMethodInfo VideoColorimetry signature where
    overloadedMethod = videoColorimetryToString

instance O.OverloadedMethodInfo VideoColorimetryToStringMethodInfo VideoColorimetry where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoColorimetry.videoColorimetryToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoColorimetry.html#v:videoColorimetryToString"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoColorimetryMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVideoColorimetryMethod "fromString" o = VideoColorimetryFromStringMethodInfo
    ResolveVideoColorimetryMethod "isEqual" o = VideoColorimetryIsEqualMethodInfo
    ResolveVideoColorimetryMethod "isEquivalent" o = VideoColorimetryIsEquivalentMethodInfo
    ResolveVideoColorimetryMethod "matches" o = VideoColorimetryMatchesMethodInfo
    ResolveVideoColorimetryMethod "toString" o = VideoColorimetryToStringMethodInfo
    ResolveVideoColorimetryMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveVideoColorimetryMethod t VideoColorimetry, O.OverloadedMethod info VideoColorimetry p, R.HasField t VideoColorimetry p) => R.HasField t VideoColorimetry p where
    getField = O.overloadedMethod @info

#endif

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

#endif