{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Used for touchpad swipe gesture events. The current state of the
-- gesture will be determined by the /@phase@/ field.
-- 
-- /Since: 1.24/

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

module GI.Clutter.Structs.TouchpadSwipeEvent
    ( 

-- * Exported types
    TouchpadSwipeEvent(..)                  ,
    newZeroTouchpadSwipeEvent               ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveTouchpadSwipeEventMethod         ,
#endif



 -- * Properties


-- ** dx #attr:dx#
-- | movement delta of the pinch focal point in the X axis

    getTouchpadSwipeEventDx                 ,
    setTouchpadSwipeEventDx                 ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_dx                   ,
#endif


-- ** dy #attr:dy#
-- | movement delta of the pinch focal point in the Y axis

    getTouchpadSwipeEventDy                 ,
    setTouchpadSwipeEventDy                 ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_dy                   ,
#endif


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

    getTouchpadSwipeEventFlags              ,
    setTouchpadSwipeEventFlags              ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_flags                ,
#endif


-- ** nFingers #attr:nFingers#
-- | the number of fingers triggering the swipe

    getTouchpadSwipeEventNFingers           ,
    setTouchpadSwipeEventNFingers           ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_nFingers             ,
#endif


-- ** phase #attr:phase#
-- | the current phase of the gesture

    getTouchpadSwipeEventPhase              ,
    setTouchpadSwipeEventPhase              ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_phase                ,
#endif


-- ** source #attr:source#
-- | event source actor (unused)

    clearTouchpadSwipeEventSource           ,
    getTouchpadSwipeEventSource             ,
    setTouchpadSwipeEventSource             ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_source               ,
#endif


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

    clearTouchpadSwipeEventStage            ,
    getTouchpadSwipeEventStage              ,
    setTouchpadSwipeEventStage              ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_stage                ,
#endif


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

    getTouchpadSwipeEventTime               ,
    setTouchpadSwipeEventTime               ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_time                 ,
#endif


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

    getTouchpadSwipeEventType               ,
    setTouchpadSwipeEventType               ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_type                 ,
#endif


-- ** x #attr:x#
-- | the X coordinate of the pointer, relative to the stage

    getTouchpadSwipeEventX                  ,
    setTouchpadSwipeEventX                  ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_x                    ,
#endif


-- ** y #attr:y#
-- | the Y coordinate of the pointer, relative to the stage

    getTouchpadSwipeEventY                  ,
    setTouchpadSwipeEventY                  ,
#if defined(ENABLE_OVERLOADING)
    touchpadSwipeEvent_y                    ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.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.Stage as Clutter.Stage

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

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

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


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

instance tag ~ 'AttrSet => Constructible TouchpadSwipeEvent tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr TouchpadSwipeEvent -> TouchpadSwipeEvent)
-> [AttrOp TouchpadSwipeEvent tag] -> m TouchpadSwipeEvent
new ManagedPtr TouchpadSwipeEvent -> TouchpadSwipeEvent
_ [AttrOp TouchpadSwipeEvent tag]
attrs = do
        TouchpadSwipeEvent
o <- m TouchpadSwipeEvent
forall (m :: * -> *). MonadIO m => m TouchpadSwipeEvent
newZeroTouchpadSwipeEvent
        TouchpadSwipeEvent -> [AttrOp TouchpadSwipeEvent 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set TouchpadSwipeEvent
o [AttrOp TouchpadSwipeEvent tag]
[AttrOp TouchpadSwipeEvent 'AttrSet]
attrs
        TouchpadSwipeEvent -> m TouchpadSwipeEvent
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TouchpadSwipeEvent
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' touchpadSwipeEvent #type
-- @
getTouchpadSwipeEventType :: MonadIO m => TouchpadSwipeEvent -> m Clutter.Enums.EventType
getTouchpadSwipeEventType :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> m EventType
getTouchpadSwipeEventType TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO EventType) -> IO EventType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO EventType) -> IO EventType)
-> (Ptr TouchpadSwipeEvent -> IO EventType) -> IO EventType
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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' touchpadSwipeEvent [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventType :: MonadIO m => TouchpadSwipeEvent -> Clutter.Enums.EventType -> m ()
setTouchpadSwipeEventType :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> EventType -> m ()
setTouchpadSwipeEventType TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
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 TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

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

touchpadSwipeEvent_type :: AttrLabelProxy "type"
touchpadSwipeEvent_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' touchpadSwipeEvent #time
-- @
getTouchpadSwipeEventTime :: MonadIO m => TouchpadSwipeEvent -> m Word32
getTouchpadSwipeEventTime :: forall (m :: * -> *). MonadIO m => TouchpadSwipeEvent -> m Word32
getTouchpadSwipeEventTime TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO Word32) -> IO Word32)
-> (Ptr TouchpadSwipeEvent -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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' touchpadSwipeEvent [ #time 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventTime :: MonadIO m => TouchpadSwipeEvent -> Word32 -> m ()
setTouchpadSwipeEventTime :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> Word32 -> m ()
setTouchpadSwipeEventTime TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Word32
val :: Word32)

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

touchpadSwipeEvent_time :: AttrLabelProxy "time"
touchpadSwipeEvent_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' touchpadSwipeEvent #flags
-- @
getTouchpadSwipeEventFlags :: MonadIO m => TouchpadSwipeEvent -> m [Clutter.Flags.EventFlags]
getTouchpadSwipeEventFlags :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> m [EventFlags]
getTouchpadSwipeEventFlags TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO [EventFlags]) -> IO [EventFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO [EventFlags]) -> IO [EventFlags])
-> (Ptr TouchpadSwipeEvent -> IO [EventFlags]) -> IO [EventFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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' touchpadSwipeEvent [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventFlags :: MonadIO m => TouchpadSwipeEvent -> [Clutter.Flags.EventFlags] -> m ()
setTouchpadSwipeEventFlags :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> [EventFlags] -> m ()
setTouchpadSwipeEventFlags TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
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 TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CUInt
val' :: CUInt)

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

touchpadSwipeEvent_flags :: AttrLabelProxy "flags"
touchpadSwipeEvent_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' touchpadSwipeEvent #stage
-- @
getTouchpadSwipeEventStage :: MonadIO m => TouchpadSwipeEvent -> m (Maybe Clutter.Stage.Stage)
getTouchpadSwipeEventStage :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> m (Maybe Stage)
getTouchpadSwipeEventStage TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO (Maybe Stage)) -> IO (Maybe Stage)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO (Maybe Stage)) -> IO (Maybe Stage))
-> (Ptr TouchpadSwipeEvent -> IO (Maybe Stage)) -> IO (Maybe Stage)
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr Stage
val <- Ptr (Ptr Stage) -> IO (Ptr Stage)
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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' touchpadSwipeEvent [ #stage 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventStage :: MonadIO m => TouchpadSwipeEvent -> Ptr Clutter.Stage.Stage -> m ()
setTouchpadSwipeEventStage :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> Ptr Stage -> m ()
setTouchpadSwipeEventStage TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr (Ptr Stage) -> Ptr Stage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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
-- @
clearTouchpadSwipeEventStage :: MonadIO m => TouchpadSwipeEvent -> m ()
clearTouchpadSwipeEventStage :: forall (m :: * -> *). MonadIO m => TouchpadSwipeEvent -> m ()
clearTouchpadSwipeEventStage TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr (Ptr Stage) -> Ptr Stage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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 TouchpadSwipeEventStageFieldInfo
instance AttrInfo TouchpadSwipeEventStageFieldInfo where
    type AttrBaseTypeConstraint TouchpadSwipeEventStageFieldInfo = (~) TouchpadSwipeEvent
    type AttrAllowedOps TouchpadSwipeEventStageFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TouchpadSwipeEventStageFieldInfo = (~) (Ptr Clutter.Stage.Stage)
    type AttrTransferTypeConstraint TouchpadSwipeEventStageFieldInfo = (~)(Ptr Clutter.Stage.Stage)
    type AttrTransferType TouchpadSwipeEventStageFieldInfo = (Ptr Clutter.Stage.Stage)
    type AttrGetType TouchpadSwipeEventStageFieldInfo = Maybe Clutter.Stage.Stage
    type AttrLabel TouchpadSwipeEventStageFieldInfo = "stage"
    type AttrOrigin TouchpadSwipeEventStageFieldInfo = TouchpadSwipeEvent
    attrGet = getTouchpadSwipeEventStage
    attrSet = setTouchpadSwipeEventStage
    attrConstruct = undefined
    attrClear = clearTouchpadSwipeEventStage
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.TouchpadSwipeEvent.stage"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-TouchpadSwipeEvent.html#g:attr:stage"
        })

touchpadSwipeEvent_stage :: AttrLabelProxy "stage"
touchpadSwipeEvent_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' touchpadSwipeEvent #source
-- @
getTouchpadSwipeEventSource :: MonadIO m => TouchpadSwipeEvent -> m (Maybe Clutter.Actor.Actor)
getTouchpadSwipeEventSource :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> m (Maybe Actor)
getTouchpadSwipeEventSource TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO (Maybe Actor)) -> IO (Maybe Actor)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO (Maybe Actor)) -> IO (Maybe Actor))
-> (Ptr TouchpadSwipeEvent -> IO (Maybe Actor)) -> IO (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr Actor
val <- Ptr (Ptr Actor) -> IO (Ptr Actor)
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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' touchpadSwipeEvent [ #source 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventSource :: MonadIO m => TouchpadSwipeEvent -> Ptr Clutter.Actor.Actor -> m ()
setTouchpadSwipeEventSource :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> Ptr Actor -> m ()
setTouchpadSwipeEventSource TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr (Ptr Actor) -> Ptr Actor -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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
-- @
clearTouchpadSwipeEventSource :: MonadIO m => TouchpadSwipeEvent -> m ()
clearTouchpadSwipeEventSource :: forall (m :: * -> *). MonadIO m => TouchpadSwipeEvent -> m ()
clearTouchpadSwipeEventSource TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    Ptr (Ptr Actor) -> Ptr Actor -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> 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 TouchpadSwipeEventSourceFieldInfo
instance AttrInfo TouchpadSwipeEventSourceFieldInfo where
    type AttrBaseTypeConstraint TouchpadSwipeEventSourceFieldInfo = (~) TouchpadSwipeEvent
    type AttrAllowedOps TouchpadSwipeEventSourceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TouchpadSwipeEventSourceFieldInfo = (~) (Ptr Clutter.Actor.Actor)
    type AttrTransferTypeConstraint TouchpadSwipeEventSourceFieldInfo = (~)(Ptr Clutter.Actor.Actor)
    type AttrTransferType TouchpadSwipeEventSourceFieldInfo = (Ptr Clutter.Actor.Actor)
    type AttrGetType TouchpadSwipeEventSourceFieldInfo = Maybe Clutter.Actor.Actor
    type AttrLabel TouchpadSwipeEventSourceFieldInfo = "source"
    type AttrOrigin TouchpadSwipeEventSourceFieldInfo = TouchpadSwipeEvent
    attrGet = getTouchpadSwipeEventSource
    attrSet = setTouchpadSwipeEventSource
    attrConstruct = undefined
    attrClear = clearTouchpadSwipeEventSource
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.TouchpadSwipeEvent.source"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-TouchpadSwipeEvent.html#g:attr:source"
        })

touchpadSwipeEvent_source :: AttrLabelProxy "source"
touchpadSwipeEvent_source = AttrLabelProxy

#endif


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

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

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

touchpadSwipeEvent_phase :: AttrLabelProxy "phase"
touchpadSwipeEvent_phase = AttrLabelProxy

#endif


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

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

touchpadSwipeEvent_nFingers :: AttrLabelProxy "nFingers"
touchpadSwipeEvent_nFingers = 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' touchpadSwipeEvent #x
-- @
getTouchpadSwipeEventX :: MonadIO m => TouchpadSwipeEvent -> m Float
getTouchpadSwipeEventX :: forall (m :: * -> *). MonadIO m => TouchpadSwipeEvent -> m Float
getTouchpadSwipeEventX TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO Float) -> IO Float)
-> (Ptr TouchpadSwipeEvent -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: 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' touchpadSwipeEvent [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventX :: MonadIO m => TouchpadSwipeEvent -> Float -> m ()
setTouchpadSwipeEventX :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> Float -> m ()
setTouchpadSwipeEventX TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
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 TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CFloat
val' :: CFloat)

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

touchpadSwipeEvent_x :: AttrLabelProxy "x"
touchpadSwipeEvent_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' touchpadSwipeEvent #y
-- @
getTouchpadSwipeEventY :: MonadIO m => TouchpadSwipeEvent -> m Float
getTouchpadSwipeEventY :: forall (m :: * -> *). MonadIO m => TouchpadSwipeEvent -> m Float
getTouchpadSwipeEventY TouchpadSwipeEvent
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
$ TouchpadSwipeEvent
-> (Ptr TouchpadSwipeEvent -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO Float) -> IO Float)
-> (Ptr TouchpadSwipeEvent -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44) :: 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' touchpadSwipeEvent [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setTouchpadSwipeEventY :: MonadIO m => TouchpadSwipeEvent -> Float -> m ()
setTouchpadSwipeEventY :: forall (m :: * -> *).
MonadIO m =>
TouchpadSwipeEvent -> Float -> m ()
setTouchpadSwipeEventY TouchpadSwipeEvent
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
$ TouchpadSwipeEvent -> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TouchpadSwipeEvent
s ((Ptr TouchpadSwipeEvent -> IO ()) -> IO ())
-> (Ptr TouchpadSwipeEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TouchpadSwipeEvent
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 TouchpadSwipeEvent
ptr Ptr TouchpadSwipeEvent -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44) (CFloat
val' :: CFloat)

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

touchpadSwipeEvent_y :: AttrLabelProxy "y"
touchpadSwipeEvent_y = AttrLabelProxy

#endif


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

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

touchpadSwipeEvent_dx :: AttrLabelProxy "dx"
touchpadSwipeEvent_dx = AttrLabelProxy

#endif


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

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

touchpadSwipeEvent_dy :: AttrLabelProxy "dy"
touchpadSwipeEvent_dy = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TouchpadSwipeEvent
type instance O.AttributeList TouchpadSwipeEvent = TouchpadSwipeEventAttributeList
type TouchpadSwipeEventAttributeList = ('[ '("type", TouchpadSwipeEventTypeFieldInfo), '("time", TouchpadSwipeEventTimeFieldInfo), '("flags", TouchpadSwipeEventFlagsFieldInfo), '("stage", TouchpadSwipeEventStageFieldInfo), '("source", TouchpadSwipeEventSourceFieldInfo), '("phase", TouchpadSwipeEventPhaseFieldInfo), '("nFingers", TouchpadSwipeEventNFingersFieldInfo), '("x", TouchpadSwipeEventXFieldInfo), '("y", TouchpadSwipeEventYFieldInfo), '("dx", TouchpadSwipeEventDxFieldInfo), '("dy", TouchpadSwipeEventDyFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif

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

#endif