{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Event for the pointer motion
-- 
-- /Since: 0.2/

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

module GI.Clutter.Structs.MotionEvent
    ( 

-- * Exported types
    MotionEvent(..)                         ,
    newZeroMotionEvent                      ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveMotionEventMethod                ,
#endif



 -- * Properties


-- ** axes #attr:axes#
-- | reserved for future use

    getMotionEventAxes                      ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_axes                        ,
#endif
    setMotionEventAxes                      ,


-- ** device #attr:device#
-- | the device that originated the event. If you want the physical
-- device the event originated from, use 'GI.Clutter.Unions.Event.eventGetSourceDevice'

    clearMotionEventDevice                  ,
    getMotionEventDevice                    ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_device                      ,
#endif
    setMotionEventDevice                    ,


-- ** flags #attr:flags#
-- | event flags

    getMotionEventFlags                     ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_flags                       ,
#endif
    setMotionEventFlags                     ,


-- ** modifierState #attr:modifierState#
-- | button modifiers

    getMotionEventModifierState             ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_modifierState               ,
#endif
    setMotionEventModifierState             ,


-- ** source #attr:source#
-- | event source actor

    clearMotionEventSource                  ,
    getMotionEventSource                    ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_source                      ,
#endif
    setMotionEventSource                    ,


-- ** stage #attr:stage#
-- | event source stage

    clearMotionEventStage                   ,
    getMotionEventStage                     ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_stage                       ,
#endif
    setMotionEventStage                     ,


-- ** time #attr:time#
-- | event time

    getMotionEventTime                      ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_time                        ,
#endif
    setMotionEventTime                      ,


-- ** type #attr:type#
-- | event type

    getMotionEventType                      ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_type                        ,
#endif
    setMotionEventType                      ,


-- ** x #attr:x#
-- | event X coordinate

    getMotionEventX                         ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_x                           ,
#endif
    setMotionEventX                         ,


-- ** y #attr:y#
-- | event Y coordinate

    getMotionEventY                         ,
#if defined(ENABLE_OVERLOADING)
    motionEvent_y                           ,
#endif
    setMotionEventY                         ,




    ) 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.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.InputDevice as Clutter.InputDevice
import {-# SOURCE #-} qualified GI.Clutter.Objects.Stage as Clutter.Stage

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

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

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


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

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


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

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

#if defined(ENABLE_OVERLOADING)
data MotionEventTypeFieldInfo
instance AttrInfo MotionEventTypeFieldInfo where
    type AttrBaseTypeConstraint MotionEventTypeFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventTypeFieldInfo = (~) Clutter.Enums.EventType
    type AttrTransferTypeConstraint MotionEventTypeFieldInfo = (~)Clutter.Enums.EventType
    type AttrTransferType MotionEventTypeFieldInfo = Clutter.Enums.EventType
    type AttrGetType MotionEventTypeFieldInfo = Clutter.Enums.EventType
    type AttrLabel MotionEventTypeFieldInfo = "type"
    type AttrOrigin MotionEventTypeFieldInfo = MotionEvent
    attrGet = getMotionEventType
    attrSet = setMotionEventType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:type"
        })

motionEvent_type :: AttrLabelProxy "type"
motionEvent_type = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MotionEventTimeFieldInfo
instance AttrInfo MotionEventTimeFieldInfo where
    type AttrBaseTypeConstraint MotionEventTimeFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventTimeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventTimeFieldInfo = (~) Word32
    type AttrTransferTypeConstraint MotionEventTimeFieldInfo = (~)Word32
    type AttrTransferType MotionEventTimeFieldInfo = Word32
    type AttrGetType MotionEventTimeFieldInfo = Word32
    type AttrLabel MotionEventTimeFieldInfo = "time"
    type AttrOrigin MotionEventTimeFieldInfo = MotionEvent
    attrGet = getMotionEventTime
    attrSet = setMotionEventTime
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.time"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:time"
        })

motionEvent_time :: AttrLabelProxy "time"
motionEvent_time = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #flags
-- @
getMotionEventFlags :: MonadIO m => MotionEvent -> m [Clutter.Flags.EventFlags]
getMotionEventFlags :: forall (m :: * -> *). MonadIO m => MotionEvent -> m [EventFlags]
getMotionEventFlags MotionEvent
s = IO [EventFlags] -> m [EventFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EventFlags] -> m [EventFlags])
-> IO [EventFlags] -> m [EventFlags]
forall a b. (a -> b) -> a -> b
$ MotionEvent
-> (Ptr MotionEvent -> IO [EventFlags]) -> IO [EventFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO [EventFlags]) -> IO [EventFlags])
-> (Ptr MotionEvent -> IO [EventFlags]) -> IO [EventFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CUInt
    let val' :: [EventFlags]
val' = CUInt -> [EventFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [EventFlags] -> IO [EventFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [EventFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' motionEvent [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setMotionEventFlags :: MonadIO m => MotionEvent -> [Clutter.Flags.EventFlags] -> m ()
setMotionEventFlags :: forall (m :: * -> *).
MonadIO m =>
MotionEvent -> [EventFlags] -> m ()
setMotionEventFlags MotionEvent
s [EventFlags]
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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    let val' :: CUInt
val' = [EventFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [EventFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data MotionEventFlagsFieldInfo
instance AttrInfo MotionEventFlagsFieldInfo where
    type AttrBaseTypeConstraint MotionEventFlagsFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventFlagsFieldInfo = (~) [Clutter.Flags.EventFlags]
    type AttrTransferTypeConstraint MotionEventFlagsFieldInfo = (~)[Clutter.Flags.EventFlags]
    type AttrTransferType MotionEventFlagsFieldInfo = [Clutter.Flags.EventFlags]
    type AttrGetType MotionEventFlagsFieldInfo = [Clutter.Flags.EventFlags]
    type AttrLabel MotionEventFlagsFieldInfo = "flags"
    type AttrOrigin MotionEventFlagsFieldInfo = MotionEvent
    attrGet = getMotionEventFlags
    attrSet = setMotionEventFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:flags"
        })

motionEvent_flags :: AttrLabelProxy "flags"
motionEvent_flags = AttrLabelProxy

#endif


-- | Get the value of the “@stage@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #stage
-- @
getMotionEventStage :: MonadIO m => MotionEvent -> m (Maybe Clutter.Stage.Stage)
getMotionEventStage :: forall (m :: * -> *). MonadIO m => MotionEvent -> m (Maybe Stage)
getMotionEventStage MotionEvent
s = IO (Maybe Stage) -> m (Maybe Stage)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Stage) -> m (Maybe Stage))
-> IO (Maybe Stage) -> m (Maybe Stage)
forall a b. (a -> b) -> a -> b
$ MotionEvent
-> (Ptr MotionEvent -> IO (Maybe Stage)) -> IO (Maybe Stage)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO (Maybe Stage)) -> IO (Maybe Stage))
-> (Ptr MotionEvent -> IO (Maybe Stage)) -> IO (Maybe Stage)
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    Ptr Stage
val <- Ptr (Ptr Stage) -> IO (Ptr Stage)
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr (Ptr Stage)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr Clutter.Stage.Stage)
    Maybe Stage
result <- Ptr Stage -> (Ptr Stage -> IO Stage) -> IO (Maybe Stage)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Stage
val ((Ptr Stage -> IO Stage) -> IO (Maybe Stage))
-> (Ptr Stage -> IO Stage) -> IO (Maybe Stage)
forall a b. (a -> b) -> a -> b
$ \Ptr Stage
val' -> do
        Stage
val'' <- ((ManagedPtr Stage -> Stage) -> Ptr Stage -> IO Stage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Stage -> Stage
Clutter.Stage.Stage) Ptr Stage
val'
        Stage -> IO Stage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stage
val''
    Maybe Stage -> IO (Maybe Stage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stage
result

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

-- | Set the value of the “@stage@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #stage
-- @
clearMotionEventStage :: MonadIO m => MotionEvent -> m ()
clearMotionEventStage :: forall (m :: * -> *). MonadIO m => MotionEvent -> m ()
clearMotionEventStage MotionEvent
s = 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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    Ptr (Ptr Stage) -> Ptr Stage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr (Ptr Stage)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr Stage
forall a. Ptr a
FP.nullPtr :: Ptr Clutter.Stage.Stage)

#if defined(ENABLE_OVERLOADING)
data MotionEventStageFieldInfo
instance AttrInfo MotionEventStageFieldInfo where
    type AttrBaseTypeConstraint MotionEventStageFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventStageFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MotionEventStageFieldInfo = (~) (Ptr Clutter.Stage.Stage)
    type AttrTransferTypeConstraint MotionEventStageFieldInfo = (~)(Ptr Clutter.Stage.Stage)
    type AttrTransferType MotionEventStageFieldInfo = (Ptr Clutter.Stage.Stage)
    type AttrGetType MotionEventStageFieldInfo = Maybe Clutter.Stage.Stage
    type AttrLabel MotionEventStageFieldInfo = "stage"
    type AttrOrigin MotionEventStageFieldInfo = MotionEvent
    attrGet = getMotionEventStage
    attrSet = setMotionEventStage
    attrConstruct = undefined
    attrClear = clearMotionEventStage
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.stage"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:stage"
        })

motionEvent_stage :: AttrLabelProxy "stage"
motionEvent_stage = AttrLabelProxy

#endif


-- | Get the value of the “@source@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #source
-- @
getMotionEventSource :: MonadIO m => MotionEvent -> m (Maybe Clutter.Actor.Actor)
getMotionEventSource :: forall (m :: * -> *). MonadIO m => MotionEvent -> m (Maybe Actor)
getMotionEventSource MotionEvent
s = IO (Maybe Actor) -> m (Maybe Actor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Actor) -> m (Maybe Actor))
-> IO (Maybe Actor) -> m (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ MotionEvent
-> (Ptr MotionEvent -> IO (Maybe Actor)) -> IO (Maybe Actor)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO (Maybe Actor)) -> IO (Maybe Actor))
-> (Ptr MotionEvent -> IO (Maybe Actor)) -> IO (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    Ptr Actor
val <- Ptr (Ptr Actor) -> IO (Ptr Actor)
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr (Ptr Actor)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (Ptr Clutter.Actor.Actor)
    Maybe Actor
result <- Ptr Actor -> (Ptr Actor -> IO Actor) -> IO (Maybe Actor)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Actor
val ((Ptr Actor -> IO Actor) -> IO (Maybe Actor))
-> (Ptr Actor -> IO Actor) -> IO (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \Ptr Actor
val' -> do
        Actor
val'' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
val'
        Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
val''
    Maybe Actor -> IO (Maybe Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Actor
result

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

-- | Set the value of the “@source@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #source
-- @
clearMotionEventSource :: MonadIO m => MotionEvent -> m ()
clearMotionEventSource :: forall (m :: * -> *). MonadIO m => MotionEvent -> m ()
clearMotionEventSource MotionEvent
s = 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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    Ptr (Ptr Actor) -> Ptr Actor -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr (Ptr Actor)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr Actor
forall a. Ptr a
FP.nullPtr :: Ptr Clutter.Actor.Actor)

#if defined(ENABLE_OVERLOADING)
data MotionEventSourceFieldInfo
instance AttrInfo MotionEventSourceFieldInfo where
    type AttrBaseTypeConstraint MotionEventSourceFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventSourceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MotionEventSourceFieldInfo = (~) (Ptr Clutter.Actor.Actor)
    type AttrTransferTypeConstraint MotionEventSourceFieldInfo = (~)(Ptr Clutter.Actor.Actor)
    type AttrTransferType MotionEventSourceFieldInfo = (Ptr Clutter.Actor.Actor)
    type AttrGetType MotionEventSourceFieldInfo = Maybe Clutter.Actor.Actor
    type AttrLabel MotionEventSourceFieldInfo = "source"
    type AttrOrigin MotionEventSourceFieldInfo = MotionEvent
    attrGet = getMotionEventSource
    attrSet = setMotionEventSource
    attrConstruct = undefined
    attrClear = clearMotionEventSource
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.source"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:source"
        })

motionEvent_source :: AttrLabelProxy "source"
motionEvent_source = AttrLabelProxy

#endif


-- | Get the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #x
-- @
getMotionEventX :: MonadIO m => MotionEvent -> m Float
getMotionEventX :: forall (m :: * -> *). MonadIO m => MotionEvent -> m Float
getMotionEventX MotionEvent
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
$ MotionEvent -> (Ptr MotionEvent -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO Float) -> IO Float)
-> (Ptr MotionEvent -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: 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 “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' motionEvent [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setMotionEventX :: MonadIO m => MotionEvent -> Float -> m ()
setMotionEventX :: forall (m :: * -> *). MonadIO m => MotionEvent -> Float -> m ()
setMotionEventX MotionEvent
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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
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 MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data MotionEventXFieldInfo
instance AttrInfo MotionEventXFieldInfo where
    type AttrBaseTypeConstraint MotionEventXFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventXFieldInfo = (~) Float
    type AttrTransferTypeConstraint MotionEventXFieldInfo = (~)Float
    type AttrTransferType MotionEventXFieldInfo = Float
    type AttrGetType MotionEventXFieldInfo = Float
    type AttrLabel MotionEventXFieldInfo = "x"
    type AttrOrigin MotionEventXFieldInfo = MotionEvent
    attrGet = getMotionEventX
    attrSet = setMotionEventX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.x"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:x"
        })

motionEvent_x :: AttrLabelProxy "x"
motionEvent_x = AttrLabelProxy

#endif


-- | Get the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #y
-- @
getMotionEventY :: MonadIO m => MotionEvent -> m Float
getMotionEventY :: forall (m :: * -> *). MonadIO m => MotionEvent -> m Float
getMotionEventY MotionEvent
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
$ MotionEvent -> (Ptr MotionEvent -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO Float) -> IO Float)
-> (Ptr MotionEvent -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36) :: 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 “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' motionEvent [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setMotionEventY :: MonadIO m => MotionEvent -> Float -> m ()
setMotionEventY :: forall (m :: * -> *). MonadIO m => MotionEvent -> Float -> m ()
setMotionEventY MotionEvent
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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
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 MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data MotionEventYFieldInfo
instance AttrInfo MotionEventYFieldInfo where
    type AttrBaseTypeConstraint MotionEventYFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventYFieldInfo = (~) Float
    type AttrTransferTypeConstraint MotionEventYFieldInfo = (~)Float
    type AttrTransferType MotionEventYFieldInfo = Float
    type AttrGetType MotionEventYFieldInfo = Float
    type AttrLabel MotionEventYFieldInfo = "y"
    type AttrOrigin MotionEventYFieldInfo = MotionEvent
    attrGet = getMotionEventY
    attrSet = setMotionEventY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.y"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:y"
        })

motionEvent_y :: AttrLabelProxy "y"
motionEvent_y = AttrLabelProxy

#endif


-- | Get the value of the “@modifier_state@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #modifierState
-- @
getMotionEventModifierState :: MonadIO m => MotionEvent -> m [Clutter.Flags.ModifierType]
getMotionEventModifierState :: forall (m :: * -> *). MonadIO m => MotionEvent -> m [ModifierType]
getMotionEventModifierState MotionEvent
s = IO [ModifierType] -> m [ModifierType]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ModifierType] -> m [ModifierType])
-> IO [ModifierType] -> m [ModifierType]
forall a b. (a -> b) -> a -> b
$ MotionEvent
-> (Ptr MotionEvent -> IO [ModifierType]) -> IO [ModifierType]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO [ModifierType]) -> IO [ModifierType])
-> (Ptr MotionEvent -> IO [ModifierType]) -> IO [ModifierType]
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO CUInt
    let val' :: [ModifierType]
val' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [ModifierType] -> IO [ModifierType]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ModifierType]
val'

-- | Set the value of the “@modifier_state@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' motionEvent [ #modifierState 'Data.GI.Base.Attributes.:=' value ]
-- @
setMotionEventModifierState :: MonadIO m => MotionEvent -> [Clutter.Flags.ModifierType] -> m ()
setMotionEventModifierState :: forall (m :: * -> *).
MonadIO m =>
MotionEvent -> [ModifierType] -> m ()
setMotionEventModifierState MotionEvent
s [ModifierType]
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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    let val' :: CUInt
val' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data MotionEventModifierStateFieldInfo
instance AttrInfo MotionEventModifierStateFieldInfo where
    type AttrBaseTypeConstraint MotionEventModifierStateFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventModifierStateFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventModifierStateFieldInfo = (~) [Clutter.Flags.ModifierType]
    type AttrTransferTypeConstraint MotionEventModifierStateFieldInfo = (~)[Clutter.Flags.ModifierType]
    type AttrTransferType MotionEventModifierStateFieldInfo = [Clutter.Flags.ModifierType]
    type AttrGetType MotionEventModifierStateFieldInfo = [Clutter.Flags.ModifierType]
    type AttrLabel MotionEventModifierStateFieldInfo = "modifier_state"
    type AttrOrigin MotionEventModifierStateFieldInfo = MotionEvent
    attrGet = getMotionEventModifierState
    attrSet = setMotionEventModifierState
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.modifierState"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:modifierState"
        })

motionEvent_modifierState :: AttrLabelProxy "modifierState"
motionEvent_modifierState = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MotionEventAxesFieldInfo
instance AttrInfo MotionEventAxesFieldInfo where
    type AttrBaseTypeConstraint MotionEventAxesFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventAxesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MotionEventAxesFieldInfo = (~) Double
    type AttrTransferTypeConstraint MotionEventAxesFieldInfo = (~)Double
    type AttrTransferType MotionEventAxesFieldInfo = Double
    type AttrGetType MotionEventAxesFieldInfo = Double
    type AttrLabel MotionEventAxesFieldInfo = "axes"
    type AttrOrigin MotionEventAxesFieldInfo = MotionEvent
    attrGet = getMotionEventAxes
    attrSet = setMotionEventAxes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.axes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:axes"
        })

motionEvent_axes :: AttrLabelProxy "axes"
motionEvent_axes = AttrLabelProxy

#endif


-- | Get the value of the “@device@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' motionEvent #device
-- @
getMotionEventDevice :: MonadIO m => MotionEvent -> m (Maybe Clutter.InputDevice.InputDevice)
getMotionEventDevice :: forall (m :: * -> *).
MonadIO m =>
MotionEvent -> m (Maybe InputDevice)
getMotionEventDevice MotionEvent
s = IO (Maybe InputDevice) -> m (Maybe InputDevice)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InputDevice) -> m (Maybe InputDevice))
-> IO (Maybe InputDevice) -> m (Maybe InputDevice)
forall a b. (a -> b) -> a -> b
$ MotionEvent
-> (Ptr MotionEvent -> IO (Maybe InputDevice))
-> IO (Maybe InputDevice)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO (Maybe InputDevice))
 -> IO (Maybe InputDevice))
-> (Ptr MotionEvent -> IO (Maybe InputDevice))
-> IO (Maybe InputDevice)
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    Ptr InputDevice
val <- Ptr (Ptr InputDevice) -> IO (Ptr InputDevice)
forall a. Storable a => Ptr a -> IO a
peek (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr (Ptr InputDevice)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO (Ptr Clutter.InputDevice.InputDevice)
    Maybe InputDevice
result <- Ptr InputDevice
-> (Ptr InputDevice -> IO InputDevice) -> IO (Maybe InputDevice)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr InputDevice
val ((Ptr InputDevice -> IO InputDevice) -> IO (Maybe InputDevice))
-> (Ptr InputDevice -> IO InputDevice) -> IO (Maybe InputDevice)
forall a b. (a -> b) -> a -> b
$ \Ptr InputDevice
val' -> do
        InputDevice
val'' <- ((ManagedPtr InputDevice -> InputDevice)
-> Ptr InputDevice -> IO InputDevice
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InputDevice -> InputDevice
Clutter.InputDevice.InputDevice) Ptr InputDevice
val'
        InputDevice -> IO InputDevice
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputDevice
val''
    Maybe InputDevice -> IO (Maybe InputDevice)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InputDevice
result

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

-- | Set the value of the “@device@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #device
-- @
clearMotionEventDevice :: MonadIO m => MotionEvent -> m ()
clearMotionEventDevice :: forall (m :: * -> *). MonadIO m => MotionEvent -> m ()
clearMotionEventDevice MotionEvent
s = 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
$ MotionEvent -> (Ptr MotionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MotionEvent
s ((Ptr MotionEvent -> IO ()) -> IO ())
-> (Ptr MotionEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MotionEvent
ptr -> do
    Ptr (Ptr InputDevice) -> Ptr InputDevice -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MotionEvent
ptr Ptr MotionEvent -> Int -> Ptr (Ptr InputDevice)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (Ptr InputDevice
forall a. Ptr a
FP.nullPtr :: Ptr Clutter.InputDevice.InputDevice)

#if defined(ENABLE_OVERLOADING)
data MotionEventDeviceFieldInfo
instance AttrInfo MotionEventDeviceFieldInfo where
    type AttrBaseTypeConstraint MotionEventDeviceFieldInfo = (~) MotionEvent
    type AttrAllowedOps MotionEventDeviceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MotionEventDeviceFieldInfo = (~) (Ptr Clutter.InputDevice.InputDevice)
    type AttrTransferTypeConstraint MotionEventDeviceFieldInfo = (~)(Ptr Clutter.InputDevice.InputDevice)
    type AttrTransferType MotionEventDeviceFieldInfo = (Ptr Clutter.InputDevice.InputDevice)
    type AttrGetType MotionEventDeviceFieldInfo = Maybe Clutter.InputDevice.InputDevice
    type AttrLabel MotionEventDeviceFieldInfo = "device"
    type AttrOrigin MotionEventDeviceFieldInfo = MotionEvent
    attrGet = getMotionEventDevice
    attrSet = setMotionEventDevice
    attrConstruct = undefined
    attrClear = clearMotionEventDevice
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.MotionEvent.device"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-MotionEvent.html#g:attr:device"
        })

motionEvent_device :: AttrLabelProxy "device"
motionEvent_device = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MotionEvent
type instance O.AttributeList MotionEvent = MotionEventAttributeList
type MotionEventAttributeList = ('[ '("type", MotionEventTypeFieldInfo), '("time", MotionEventTimeFieldInfo), '("flags", MotionEventFlagsFieldInfo), '("stage", MotionEventStageFieldInfo), '("source", MotionEventSourceFieldInfo), '("x", MotionEventXFieldInfo), '("y", MotionEventYFieldInfo), '("modifierState", MotionEventModifierStateFieldInfo), '("axes", MotionEventAxesFieldInfo), '("device", MotionEventDeviceFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

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

#endif

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

#endif