{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Current drawing state.
-- 
-- /Since: 4.0.0/

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

module GI.HarfBuzz.Structs.DrawStateT
    ( 

-- * Exported types
    DrawStateT(..)                          ,
    newZeroDrawStateT                       ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveDrawStateTMethod                 ,
#endif



 -- * Properties


-- ** currentX #attr:currentX#
-- | X component of current point

#if defined(ENABLE_OVERLOADING)
    drawStateT_currentX                     ,
#endif
    getDrawStateTCurrentX                   ,
    setDrawStateTCurrentX                   ,


-- ** currentY #attr:currentY#
-- | Y component of current point

#if defined(ENABLE_OVERLOADING)
    drawStateT_currentY                     ,
#endif
    getDrawStateTCurrentY                   ,
    setDrawStateTCurrentY                   ,


-- ** pathOpen #attr:pathOpen#
-- | Whether there is an open path

#if defined(ENABLE_OVERLOADING)
    drawStateT_pathOpen                     ,
#endif
    getDrawStateTPathOpen                   ,
    setDrawStateTPathOpen                   ,


-- ** pathStartX #attr:pathStartX#
-- | X component of the start of current path

#if defined(ENABLE_OVERLOADING)
    drawStateT_pathStartX                   ,
#endif
    getDrawStateTPathStartX                 ,
    setDrawStateTPathStartX                 ,


-- ** pathStartY #attr:pathStartY#
-- | Y component of the start of current path

#if defined(ENABLE_OVERLOADING)
    drawStateT_pathStartY                   ,
#endif
    getDrawStateTPathStartY                 ,
    setDrawStateTPathStartY                 ,




    ) 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


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

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

foreign import ccall "hb_gobject_draw_state_get_type" c_hb_gobject_draw_state_get_type :: 
    IO GType

type instance O.ParentTypes DrawStateT = '[]
instance O.HasParentTypes DrawStateT

instance B.Types.TypedObject DrawStateT where
    glibType :: IO GType
glibType = IO GType
c_hb_gobject_draw_state_get_type

instance B.Types.GBoxed DrawStateT

-- | Convert 'DrawStateT' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe DrawStateT) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_hb_gobject_draw_state_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DrawStateT -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DrawStateT
P.Nothing = Ptr GValue -> Ptr DrawStateT -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr DrawStateT
forall a. Ptr a
FP.nullPtr :: FP.Ptr DrawStateT)
    gvalueSet_ Ptr GValue
gv (P.Just DrawStateT
obj) = DrawStateT -> (Ptr DrawStateT -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DrawStateT
obj (Ptr GValue -> Ptr DrawStateT -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DrawStateT)
gvalueGet_ Ptr GValue
gv = do
        Ptr DrawStateT
ptr <- Ptr GValue -> IO (Ptr DrawStateT)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr DrawStateT)
        if Ptr DrawStateT
ptr Ptr DrawStateT -> Ptr DrawStateT -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DrawStateT
forall a. Ptr a
FP.nullPtr
        then DrawStateT -> Maybe DrawStateT
forall a. a -> Maybe a
P.Just (DrawStateT -> Maybe DrawStateT)
-> IO DrawStateT -> IO (Maybe DrawStateT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DrawStateT -> DrawStateT)
-> Ptr DrawStateT -> IO DrawStateT
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr DrawStateT -> DrawStateT
DrawStateT Ptr DrawStateT
ptr
        else Maybe DrawStateT -> IO (Maybe DrawStateT)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DrawStateT
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `DrawStateT` struct initialized to zero.
newZeroDrawStateT :: MonadIO m => m DrawStateT
newZeroDrawStateT :: forall (m :: * -> *). MonadIO m => m DrawStateT
newZeroDrawStateT = IO DrawStateT -> m DrawStateT
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DrawStateT -> m DrawStateT) -> IO DrawStateT -> m DrawStateT
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr DrawStateT)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
48 IO (Ptr DrawStateT)
-> (Ptr DrawStateT -> IO DrawStateT) -> IO DrawStateT
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr DrawStateT -> DrawStateT)
-> Ptr DrawStateT -> IO DrawStateT
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DrawStateT -> DrawStateT
DrawStateT

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


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

-- | Set the value of the “@path_open@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drawStateT [ #pathOpen 'Data.GI.Base.Attributes.:=' value ]
-- @
setDrawStateTPathOpen :: MonadIO m => DrawStateT -> Int32 -> m ()
setDrawStateTPathOpen :: forall (m :: * -> *). MonadIO m => DrawStateT -> Int32 -> m ()
setDrawStateTPathOpen DrawStateT
s Int32
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
$ DrawStateT -> (Ptr DrawStateT -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DrawStateT
s ((Ptr DrawStateT -> IO ()) -> IO ())
-> (Ptr DrawStateT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawStateT
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DrawStateT
ptr Ptr DrawStateT -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DrawStateTPathOpenFieldInfo
instance AttrInfo DrawStateTPathOpenFieldInfo where
    type AttrBaseTypeConstraint DrawStateTPathOpenFieldInfo = (~) DrawStateT
    type AttrAllowedOps DrawStateTPathOpenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DrawStateTPathOpenFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DrawStateTPathOpenFieldInfo = (~)Int32
    type AttrTransferType DrawStateTPathOpenFieldInfo = Int32
    type AttrGetType DrawStateTPathOpenFieldInfo = Int32
    type AttrLabel DrawStateTPathOpenFieldInfo = "path_open"
    type AttrOrigin DrawStateTPathOpenFieldInfo = DrawStateT
    attrGet = getDrawStateTPathOpen
    attrSet = setDrawStateTPathOpen
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.HarfBuzz.Structs.DrawStateT.pathOpen"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-harfbuzz-0.0.9/docs/GI-HarfBuzz-Structs-DrawStateT.html#g:attr:pathOpen"
        })

drawStateT_pathOpen :: AttrLabelProxy "pathOpen"
drawStateT_pathOpen = AttrLabelProxy

#endif


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

-- | Set the value of the “@path_start_x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drawStateT [ #pathStartX 'Data.GI.Base.Attributes.:=' value ]
-- @
setDrawStateTPathStartX :: MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTPathStartX :: forall (m :: * -> *). MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTPathStartX DrawStateT
s Float
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
$ DrawStateT -> (Ptr DrawStateT -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DrawStateT
s ((Ptr DrawStateT -> IO ()) -> IO ())
-> (Ptr DrawStateT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawStateT
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DrawStateT
ptr Ptr DrawStateT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data DrawStateTPathStartXFieldInfo
instance AttrInfo DrawStateTPathStartXFieldInfo where
    type AttrBaseTypeConstraint DrawStateTPathStartXFieldInfo = (~) DrawStateT
    type AttrAllowedOps DrawStateTPathStartXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DrawStateTPathStartXFieldInfo = (~) Float
    type AttrTransferTypeConstraint DrawStateTPathStartXFieldInfo = (~)Float
    type AttrTransferType DrawStateTPathStartXFieldInfo = Float
    type AttrGetType DrawStateTPathStartXFieldInfo = Float
    type AttrLabel DrawStateTPathStartXFieldInfo = "path_start_x"
    type AttrOrigin DrawStateTPathStartXFieldInfo = DrawStateT
    attrGet = getDrawStateTPathStartX
    attrSet = setDrawStateTPathStartX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.HarfBuzz.Structs.DrawStateT.pathStartX"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-harfbuzz-0.0.9/docs/GI-HarfBuzz-Structs-DrawStateT.html#g:attr:pathStartX"
        })

drawStateT_pathStartX :: AttrLabelProxy "pathStartX"
drawStateT_pathStartX = AttrLabelProxy

#endif


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

-- | Set the value of the “@path_start_y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drawStateT [ #pathStartY 'Data.GI.Base.Attributes.:=' value ]
-- @
setDrawStateTPathStartY :: MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTPathStartY :: forall (m :: * -> *). MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTPathStartY DrawStateT
s Float
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
$ DrawStateT -> (Ptr DrawStateT -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DrawStateT
s ((Ptr DrawStateT -> IO ()) -> IO ())
-> (Ptr DrawStateT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawStateT
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DrawStateT
ptr Ptr DrawStateT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data DrawStateTPathStartYFieldInfo
instance AttrInfo DrawStateTPathStartYFieldInfo where
    type AttrBaseTypeConstraint DrawStateTPathStartYFieldInfo = (~) DrawStateT
    type AttrAllowedOps DrawStateTPathStartYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DrawStateTPathStartYFieldInfo = (~) Float
    type AttrTransferTypeConstraint DrawStateTPathStartYFieldInfo = (~)Float
    type AttrTransferType DrawStateTPathStartYFieldInfo = Float
    type AttrGetType DrawStateTPathStartYFieldInfo = Float
    type AttrLabel DrawStateTPathStartYFieldInfo = "path_start_y"
    type AttrOrigin DrawStateTPathStartYFieldInfo = DrawStateT
    attrGet = getDrawStateTPathStartY
    attrSet = setDrawStateTPathStartY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.HarfBuzz.Structs.DrawStateT.pathStartY"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-harfbuzz-0.0.9/docs/GI-HarfBuzz-Structs-DrawStateT.html#g:attr:pathStartY"
        })

drawStateT_pathStartY :: AttrLabelProxy "pathStartY"
drawStateT_pathStartY = AttrLabelProxy

#endif


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

-- | Set the value of the “@current_x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drawStateT [ #currentX 'Data.GI.Base.Attributes.:=' value ]
-- @
setDrawStateTCurrentX :: MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTCurrentX :: forall (m :: * -> *). MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTCurrentX DrawStateT
s Float
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
$ DrawStateT -> (Ptr DrawStateT -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DrawStateT
s ((Ptr DrawStateT -> IO ()) -> IO ())
-> (Ptr DrawStateT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawStateT
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DrawStateT
ptr Ptr DrawStateT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data DrawStateTCurrentXFieldInfo
instance AttrInfo DrawStateTCurrentXFieldInfo where
    type AttrBaseTypeConstraint DrawStateTCurrentXFieldInfo = (~) DrawStateT
    type AttrAllowedOps DrawStateTCurrentXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DrawStateTCurrentXFieldInfo = (~) Float
    type AttrTransferTypeConstraint DrawStateTCurrentXFieldInfo = (~)Float
    type AttrTransferType DrawStateTCurrentXFieldInfo = Float
    type AttrGetType DrawStateTCurrentXFieldInfo = Float
    type AttrLabel DrawStateTCurrentXFieldInfo = "current_x"
    type AttrOrigin DrawStateTCurrentXFieldInfo = DrawStateT
    attrGet = getDrawStateTCurrentX
    attrSet = setDrawStateTCurrentX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.HarfBuzz.Structs.DrawStateT.currentX"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-harfbuzz-0.0.9/docs/GI-HarfBuzz-Structs-DrawStateT.html#g:attr:currentX"
        })

drawStateT_currentX :: AttrLabelProxy "currentX"
drawStateT_currentX = AttrLabelProxy

#endif


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

-- | Set the value of the “@current_y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drawStateT [ #currentY 'Data.GI.Base.Attributes.:=' value ]
-- @
setDrawStateTCurrentY :: MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTCurrentY :: forall (m :: * -> *). MonadIO m => DrawStateT -> Float -> m ()
setDrawStateTCurrentY DrawStateT
s Float
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
$ DrawStateT -> (Ptr DrawStateT -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DrawStateT
s ((Ptr DrawStateT -> IO ()) -> IO ())
-> (Ptr DrawStateT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawStateT
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DrawStateT
ptr Ptr DrawStateT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data DrawStateTCurrentYFieldInfo
instance AttrInfo DrawStateTCurrentYFieldInfo where
    type AttrBaseTypeConstraint DrawStateTCurrentYFieldInfo = (~) DrawStateT
    type AttrAllowedOps DrawStateTCurrentYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DrawStateTCurrentYFieldInfo = (~) Float
    type AttrTransferTypeConstraint DrawStateTCurrentYFieldInfo = (~)Float
    type AttrTransferType DrawStateTCurrentYFieldInfo = Float
    type AttrGetType DrawStateTCurrentYFieldInfo = Float
    type AttrLabel DrawStateTCurrentYFieldInfo = "current_y"
    type AttrOrigin DrawStateTCurrentYFieldInfo = DrawStateT
    attrGet = getDrawStateTCurrentY
    attrSet = setDrawStateTCurrentY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.HarfBuzz.Structs.DrawStateT.currentY"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-harfbuzz-0.0.9/docs/GI-HarfBuzz-Structs-DrawStateT.html#g:attr:currentY"
        })

drawStateT_currentY :: AttrLabelProxy "currentY"
drawStateT_currentY = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DrawStateT
type instance O.AttributeList DrawStateT = DrawStateTAttributeList
type DrawStateTAttributeList = ('[ '("pathOpen", DrawStateTPathOpenFieldInfo), '("pathStartX", DrawStateTPathStartXFieldInfo), '("pathStartY", DrawStateTPathStartYFieldInfo), '("currentX", DrawStateTCurrentXFieldInfo), '("currentY", DrawStateTCurrentYFieldInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDrawStateTMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDrawStateTMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDrawStateTMethod t DrawStateT, O.OverloadedMethod info DrawStateT p) => OL.IsLabel t (DrawStateT -> 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 ~ ResolveDrawStateTMethod t DrawStateT, O.OverloadedMethod info DrawStateT p, R.HasField t DrawStateT p) => R.HasField t DrawStateT p where
    getField = O.overloadedMethod @info

#endif

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

#endif