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

Structure describing the chromaticity coordinates of an RGB system. These
values can be used to construct a matrix to transform RGB to and from the
XYZ colorspace.

/Since: 1.6/
-}

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

module GI.GstVideo.Structs.VideoColorPrimariesInfo
    (

-- * Exported types
    VideoColorPrimariesInfo(..)             ,
    newZeroVideoColorPrimariesInfo          ,
    noVideoColorPrimariesInfo               ,


 -- * Properties
-- ** bx #attr:bx#
{- | blue x coordinate
-}
    getVideoColorPrimariesInfoBx            ,
    setVideoColorPrimariesInfoBx            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_bx              ,
#endif


-- ** by #attr:by#
{- | blue y coordinate
-}
    getVideoColorPrimariesInfoBy            ,
    setVideoColorPrimariesInfoBy            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_by              ,
#endif


-- ** gx #attr:gx#
{- | green x coordinate
-}
    getVideoColorPrimariesInfoGx            ,
    setVideoColorPrimariesInfoGx            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_gx              ,
#endif


-- ** gy #attr:gy#
{- | green y coordinate
-}
    getVideoColorPrimariesInfoGy            ,
    setVideoColorPrimariesInfoGy            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_gy              ,
#endif


-- ** primaries #attr:primaries#
{- | a 'GI.GstVideo.Enums.VideoColorPrimaries'
-}
    getVideoColorPrimariesInfoPrimaries     ,
    setVideoColorPrimariesInfoPrimaries     ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_primaries       ,
#endif


-- ** rx #attr:rx#
{- | red x coordinate
-}
    getVideoColorPrimariesInfoRx            ,
    setVideoColorPrimariesInfoRx            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_rx              ,
#endif


-- ** ry #attr:ry#
{- | red y coordinate
-}
    getVideoColorPrimariesInfoRy            ,
    setVideoColorPrimariesInfoRy            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_ry              ,
#endif


-- ** wx #attr:wx#
{- | reference white x coordinate
-}
    getVideoColorPrimariesInfoWx            ,
    setVideoColorPrimariesInfoWx            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_wx              ,
#endif


-- ** wy #attr:wy#
{- | reference white y coordinate
-}
    getVideoColorPrimariesInfoWy            ,
    setVideoColorPrimariesInfoWy            ,
#if ENABLE_OVERLOADING
    videoColorPrimariesInfo_wy              ,
#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.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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

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

-- | Memory-managed wrapper type.
newtype VideoColorPrimariesInfo = VideoColorPrimariesInfo (ManagedPtr VideoColorPrimariesInfo)
instance WrappedPtr VideoColorPrimariesInfo where
    wrappedPtrCalloc = callocBytes 72
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 72 >=> wrapPtr VideoColorPrimariesInfo)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `VideoColorPrimariesInfo` struct initialized to zero.
newZeroVideoColorPrimariesInfo :: MonadIO m => m VideoColorPrimariesInfo
newZeroVideoColorPrimariesInfo = liftIO $ wrappedPtrCalloc >>= wrapPtr VideoColorPrimariesInfo

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


-- | A convenience alias for `Nothing` :: `Maybe` `VideoColorPrimariesInfo`.
noVideoColorPrimariesInfo :: Maybe VideoColorPrimariesInfo
noVideoColorPrimariesInfo = Nothing

{- |
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' videoColorPrimariesInfo #primaries
@
-}
getVideoColorPrimariesInfoPrimaries :: MonadIO m => VideoColorPrimariesInfo -> m GstVideo.Enums.VideoColorPrimaries
getVideoColorPrimariesInfoPrimaries s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return 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' videoColorPrimariesInfo [ #primaries 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoPrimaries :: MonadIO m => VideoColorPrimariesInfo -> GstVideo.Enums.VideoColorPrimaries -> m ()
setVideoColorPrimariesInfoPrimaries s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoPrimariesFieldInfo
instance AttrInfo VideoColorPrimariesInfoPrimariesFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoPrimariesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoPrimariesFieldInfo = (~) GstVideo.Enums.VideoColorPrimaries
    type AttrBaseTypeConstraint VideoColorPrimariesInfoPrimariesFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoPrimariesFieldInfo = GstVideo.Enums.VideoColorPrimaries
    type AttrLabel VideoColorPrimariesInfoPrimariesFieldInfo = "primaries"
    type AttrOrigin VideoColorPrimariesInfoPrimariesFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoPrimaries
    attrSet _ = setVideoColorPrimariesInfoPrimaries
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_primaries :: AttrLabelProxy "primaries"
videoColorPrimariesInfo_primaries = AttrLabelProxy

#endif


{- |
Get the value of the “@Wx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #wx
@
-}
getVideoColorPrimariesInfoWx :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoWx s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Wx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #wx 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoWx :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoWx s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 8) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoWxFieldInfo
instance AttrInfo VideoColorPrimariesInfoWxFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoWxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoWxFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoWxFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoWxFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoWxFieldInfo = "Wx"
    type AttrOrigin VideoColorPrimariesInfoWxFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoWx
    attrSet _ = setVideoColorPrimariesInfoWx
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_wx :: AttrLabelProxy "wx"
videoColorPrimariesInfo_wx = AttrLabelProxy

#endif


{- |
Get the value of the “@Wy@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #wy
@
-}
getVideoColorPrimariesInfoWy :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoWy s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Wy@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #wy 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoWy :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoWy s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 16) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoWyFieldInfo
instance AttrInfo VideoColorPrimariesInfoWyFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoWyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoWyFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoWyFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoWyFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoWyFieldInfo = "Wy"
    type AttrOrigin VideoColorPrimariesInfoWyFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoWy
    attrSet _ = setVideoColorPrimariesInfoWy
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_wy :: AttrLabelProxy "wy"
videoColorPrimariesInfo_wy = AttrLabelProxy

#endif


{- |
Get the value of the “@Rx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #rx
@
-}
getVideoColorPrimariesInfoRx :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoRx s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Rx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #rx 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoRx :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoRx s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 24) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoRxFieldInfo
instance AttrInfo VideoColorPrimariesInfoRxFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoRxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoRxFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoRxFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoRxFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoRxFieldInfo = "Rx"
    type AttrOrigin VideoColorPrimariesInfoRxFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoRx
    attrSet _ = setVideoColorPrimariesInfoRx
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_rx :: AttrLabelProxy "rx"
videoColorPrimariesInfo_rx = AttrLabelProxy

#endif


{- |
Get the value of the “@Ry@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #ry
@
-}
getVideoColorPrimariesInfoRy :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoRy s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Ry@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #ry 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoRy :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoRy s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 32) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoRyFieldInfo
instance AttrInfo VideoColorPrimariesInfoRyFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoRyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoRyFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoRyFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoRyFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoRyFieldInfo = "Ry"
    type AttrOrigin VideoColorPrimariesInfoRyFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoRy
    attrSet _ = setVideoColorPrimariesInfoRy
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_ry :: AttrLabelProxy "ry"
videoColorPrimariesInfo_ry = AttrLabelProxy

#endif


{- |
Get the value of the “@Gx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #gx
@
-}
getVideoColorPrimariesInfoGx :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoGx s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Gx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #gx 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoGx :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoGx s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 40) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoGxFieldInfo
instance AttrInfo VideoColorPrimariesInfoGxFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoGxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoGxFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoGxFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoGxFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoGxFieldInfo = "Gx"
    type AttrOrigin VideoColorPrimariesInfoGxFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoGx
    attrSet _ = setVideoColorPrimariesInfoGx
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_gx :: AttrLabelProxy "gx"
videoColorPrimariesInfo_gx = AttrLabelProxy

#endif


{- |
Get the value of the “@Gy@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #gy
@
-}
getVideoColorPrimariesInfoGy :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoGy s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Gy@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #gy 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoGy :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoGy s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 48) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoGyFieldInfo
instance AttrInfo VideoColorPrimariesInfoGyFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoGyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoGyFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoGyFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoGyFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoGyFieldInfo = "Gy"
    type AttrOrigin VideoColorPrimariesInfoGyFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoGy
    attrSet _ = setVideoColorPrimariesInfoGy
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_gy :: AttrLabelProxy "gy"
videoColorPrimariesInfo_gy = AttrLabelProxy

#endif


{- |
Get the value of the “@Bx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #bx
@
-}
getVideoColorPrimariesInfoBx :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoBx s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@Bx@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #bx 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoBx :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoBx s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 56) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoBxFieldInfo
instance AttrInfo VideoColorPrimariesInfoBxFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoBxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoBxFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoBxFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoBxFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoBxFieldInfo = "Bx"
    type AttrOrigin VideoColorPrimariesInfoBxFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoBx
    attrSet _ = setVideoColorPrimariesInfoBx
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_bx :: AttrLabelProxy "bx"
videoColorPrimariesInfo_bx = AttrLabelProxy

#endif


{- |
Get the value of the “@By@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' videoColorPrimariesInfo #by
@
-}
getVideoColorPrimariesInfoBy :: MonadIO m => VideoColorPrimariesInfo -> m Double
getVideoColorPrimariesInfoBy s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO CDouble
    let val' = realToFrac val
    return val'

{- |
Set the value of the “@By@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' videoColorPrimariesInfo [ #by 'Data.GI.Base.Attributes.:=' value ]
@
-}
setVideoColorPrimariesInfoBy :: MonadIO m => VideoColorPrimariesInfo -> Double -> m ()
setVideoColorPrimariesInfoBy s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 64) (val' :: CDouble)

#if ENABLE_OVERLOADING
data VideoColorPrimariesInfoByFieldInfo
instance AttrInfo VideoColorPrimariesInfoByFieldInfo where
    type AttrAllowedOps VideoColorPrimariesInfoByFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoColorPrimariesInfoByFieldInfo = (~) Double
    type AttrBaseTypeConstraint VideoColorPrimariesInfoByFieldInfo = (~) VideoColorPrimariesInfo
    type AttrGetType VideoColorPrimariesInfoByFieldInfo = Double
    type AttrLabel VideoColorPrimariesInfoByFieldInfo = "By"
    type AttrOrigin VideoColorPrimariesInfoByFieldInfo = VideoColorPrimariesInfo
    attrGet _ = getVideoColorPrimariesInfoBy
    attrSet _ = setVideoColorPrimariesInfoBy
    attrConstruct = undefined
    attrClear _ = undefined

videoColorPrimariesInfo_by :: AttrLabelProxy "by"
videoColorPrimariesInfo_by = AttrLabelProxy

#endif



#if ENABLE_OVERLOADING
instance O.HasAttributeList VideoColorPrimariesInfo
type instance O.AttributeList VideoColorPrimariesInfo = VideoColorPrimariesInfoAttributeList
type VideoColorPrimariesInfoAttributeList = ('[ '("primaries", VideoColorPrimariesInfoPrimariesFieldInfo), '("wx", VideoColorPrimariesInfoWxFieldInfo), '("wy", VideoColorPrimariesInfoWyFieldInfo), '("rx", VideoColorPrimariesInfoRxFieldInfo), '("ry", VideoColorPrimariesInfoRyFieldInfo), '("gx", VideoColorPrimariesInfoGxFieldInfo), '("gy", VideoColorPrimariesInfoGyFieldInfo), '("bx", VideoColorPrimariesInfoBxFieldInfo), '("by", VideoColorPrimariesInfoByFieldInfo)] :: [(Symbol, *)])
#endif

#if ENABLE_OVERLOADING
type family ResolveVideoColorPrimariesInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoColorPrimariesInfoMethod l o = O.MethodResolutionFailed l o

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

#endif