{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) Generated during touchpad swipe gestures. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gdk.Structs.EventTouchpadSwipe ( -- * Exported types EventTouchpadSwipe(..) , newZeroEventTouchpadSwipe , noEventTouchpadSwipe , -- * Properties -- ** dx #attr:dx# {- | Movement delta in the X axis of the swipe focal point -} #if ENABLE_OVERLOADING eventTouchpadSwipe_dx , #endif getEventTouchpadSwipeDx , setEventTouchpadSwipeDx , -- ** dy #attr:dy# {- | Movement delta in the Y axis of the swipe focal point -} #if ENABLE_OVERLOADING eventTouchpadSwipe_dy , #endif getEventTouchpadSwipeDy , setEventTouchpadSwipeDy , -- ** nFingers #attr:nFingers# {- | The number of fingers triggering the swipe -} #if ENABLE_OVERLOADING eventTouchpadSwipe_nFingers , #endif getEventTouchpadSwipeNFingers , setEventTouchpadSwipeNFingers , -- ** phase #attr:phase# {- | the current phase of the gesture -} #if ENABLE_OVERLOADING eventTouchpadSwipe_phase , #endif getEventTouchpadSwipePhase , setEventTouchpadSwipePhase , -- ** sendEvent #attr:sendEvent# {- | 'True' if the event was sent explicitly -} #if ENABLE_OVERLOADING eventTouchpadSwipe_sendEvent , #endif getEventTouchpadSwipeSendEvent , setEventTouchpadSwipeSendEvent , -- ** state #attr:state# {- | a bit-mask representing the state of the modifier keys (e.g. Control, Shift and Alt) and the pointer buttons. See 'GI.Gdk.Flags.ModifierType'. -} #if ENABLE_OVERLOADING eventTouchpadSwipe_state , #endif getEventTouchpadSwipeState , setEventTouchpadSwipeState , -- ** time #attr:time# {- | the time of the event in milliseconds -} #if ENABLE_OVERLOADING eventTouchpadSwipe_time , #endif getEventTouchpadSwipeTime , setEventTouchpadSwipeTime , -- ** type #attr:type# {- | the type of the event ('GI.Gdk.Enums.EventTypeTouchpadSwipe') -} #if ENABLE_OVERLOADING eventTouchpadSwipe_type , #endif getEventTouchpadSwipeType , setEventTouchpadSwipeType , -- ** window #attr:window# {- | the window which received the event -} clearEventTouchpadSwipeWindow , #if ENABLE_OVERLOADING eventTouchpadSwipe_window , #endif getEventTouchpadSwipeWindow , setEventTouchpadSwipeWindow , -- ** x #attr:x# {- | The X coordinate of the pointer -} #if ENABLE_OVERLOADING eventTouchpadSwipe_x , #endif getEventTouchpadSwipeX , setEventTouchpadSwipeX , -- ** xRoot #attr:xRoot# {- | The X coordinate of the pointer, relative to the root of the screen. -} #if ENABLE_OVERLOADING eventTouchpadSwipe_xRoot , #endif getEventTouchpadSwipeXRoot , setEventTouchpadSwipeXRoot , -- ** y #attr:y# {- | The Y coordinate of the pointer -} #if ENABLE_OVERLOADING eventTouchpadSwipe_y , #endif getEventTouchpadSwipeY , setEventTouchpadSwipeY , -- ** yRoot #attr:yRoot# {- | The Y coordinate of the pointer, relative to the root of the screen. -} #if ENABLE_OVERLOADING eventTouchpadSwipe_yRoot , #endif getEventTouchpadSwipeYRoot , setEventTouchpadSwipeYRoot , ) where import Data.GI.Base.ShortPrelude import qualified Data.GI.Base.ShortPrelude as SP import qualified Data.GI.Base.Overloading as O import qualified Prelude as P import qualified Data.GI.Base.Attributes as GI.Attributes import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr import qualified Data.GI.Base.GClosure as B.GClosure import qualified Data.GI.Base.GError as B.GError import qualified Data.GI.Base.GVariant as B.GVariant import qualified Data.GI.Base.GValue as B.GValue import qualified Data.GI.Base.GParamSpec as B.GParamSpec import qualified Data.GI.Base.CallStack as B.CallStack import qualified Data.GI.Base.Properties as B.Properties import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import qualified Foreign.Ptr as FP import qualified GHC.OverloadedLabels as OL import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags import {-# SOURCE #-} qualified GI.Gdk.Objects.Window as Gdk.Window -- | Memory-managed wrapper type. newtype EventTouchpadSwipe = EventTouchpadSwipe (ManagedPtr EventTouchpadSwipe) instance WrappedPtr EventTouchpadSwipe where wrappedPtrCalloc = callocBytes 80 wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 80 >=> wrapPtr EventTouchpadSwipe) wrappedPtrFree = Just ptr_to_g_free -- | Construct a `EventTouchpadSwipe` struct initialized to zero. newZeroEventTouchpadSwipe :: MonadIO m => m EventTouchpadSwipe newZeroEventTouchpadSwipe = liftIO $ wrappedPtrCalloc >>= wrapPtr EventTouchpadSwipe instance tag ~ 'AttrSet => Constructible EventTouchpadSwipe tag where new _ attrs = do o <- newZeroEventTouchpadSwipe GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `EventTouchpadSwipe`. noEventTouchpadSwipe :: Maybe EventTouchpadSwipe noEventTouchpadSwipe = Nothing {- | Get the value of the “@type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #type @ -} getEventTouchpadSwipeType :: MonadIO m => EventTouchpadSwipe -> m Gdk.Enums.EventType getEventTouchpadSwipeType s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CInt let val' = (toEnum . fromIntegral) val return val' {- | Set the value of the “@type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #type 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeType :: MonadIO m => EventTouchpadSwipe -> Gdk.Enums.EventType -> m () setEventTouchpadSwipeType s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = (fromIntegral . fromEnum) val poke (ptr `plusPtr` 0) (val' :: CInt) #if ENABLE_OVERLOADING data EventTouchpadSwipeTypeFieldInfo instance AttrInfo EventTouchpadSwipeTypeFieldInfo where type AttrAllowedOps EventTouchpadSwipeTypeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeTypeFieldInfo = (~) Gdk.Enums.EventType type AttrBaseTypeConstraint EventTouchpadSwipeTypeFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeTypeFieldInfo = Gdk.Enums.EventType type AttrLabel EventTouchpadSwipeTypeFieldInfo = "type" type AttrOrigin EventTouchpadSwipeTypeFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeType attrSet _ = setEventTouchpadSwipeType attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_type :: AttrLabelProxy "type" eventTouchpadSwipe_type = AttrLabelProxy #endif {- | Get the value of the “@window@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #window @ -} getEventTouchpadSwipeWindow :: MonadIO m => EventTouchpadSwipe -> m (Maybe Gdk.Window.Window) getEventTouchpadSwipeWindow s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr Gdk.Window.Window) result <- SP.convertIfNonNull val $ \val' -> do val'' <- (newObject Gdk.Window.Window) val' return val'' return result {- | Set the value of the “@window@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #window 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeWindow :: MonadIO m => EventTouchpadSwipe -> Ptr Gdk.Window.Window -> m () setEventTouchpadSwipeWindow s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (val :: Ptr Gdk.Window.Window) {- | Set the value of the “@window@” field to `Nothing`. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.clear' #window @ -} clearEventTouchpadSwipeWindow :: MonadIO m => EventTouchpadSwipe -> m () clearEventTouchpadSwipeWindow s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr Gdk.Window.Window) #if ENABLE_OVERLOADING data EventTouchpadSwipeWindowFieldInfo instance AttrInfo EventTouchpadSwipeWindowFieldInfo where type AttrAllowedOps EventTouchpadSwipeWindowFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventTouchpadSwipeWindowFieldInfo = (~) (Ptr Gdk.Window.Window) type AttrBaseTypeConstraint EventTouchpadSwipeWindowFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeWindowFieldInfo = Maybe Gdk.Window.Window type AttrLabel EventTouchpadSwipeWindowFieldInfo = "window" type AttrOrigin EventTouchpadSwipeWindowFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeWindow attrSet _ = setEventTouchpadSwipeWindow attrConstruct = undefined attrClear _ = clearEventTouchpadSwipeWindow eventTouchpadSwipe_window :: AttrLabelProxy "window" eventTouchpadSwipe_window = AttrLabelProxy #endif {- | Get the value of the “@send_event@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #sendEvent @ -} getEventTouchpadSwipeSendEvent :: MonadIO m => EventTouchpadSwipe -> m Int8 getEventTouchpadSwipeSendEvent s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Int8 return val {- | Set the value of the “@send_event@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #sendEvent 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeSendEvent :: MonadIO m => EventTouchpadSwipe -> Int8 -> m () setEventTouchpadSwipeSendEvent s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 16) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchpadSwipeSendEventFieldInfo instance AttrInfo EventTouchpadSwipeSendEventFieldInfo where type AttrAllowedOps EventTouchpadSwipeSendEventFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeSendEventFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchpadSwipeSendEventFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeSendEventFieldInfo = Int8 type AttrLabel EventTouchpadSwipeSendEventFieldInfo = "send_event" type AttrOrigin EventTouchpadSwipeSendEventFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeSendEvent attrSet _ = setEventTouchpadSwipeSendEvent attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_sendEvent :: AttrLabelProxy "sendEvent" eventTouchpadSwipe_sendEvent = AttrLabelProxy #endif {- | Get the value of the “@phase@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #phase @ -} getEventTouchpadSwipePhase :: MonadIO m => EventTouchpadSwipe -> m Int8 getEventTouchpadSwipePhase s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 17) :: IO Int8 return val {- | Set the value of the “@phase@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #phase 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipePhase :: MonadIO m => EventTouchpadSwipe -> Int8 -> m () setEventTouchpadSwipePhase s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 17) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchpadSwipePhaseFieldInfo instance AttrInfo EventTouchpadSwipePhaseFieldInfo where type AttrAllowedOps EventTouchpadSwipePhaseFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipePhaseFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchpadSwipePhaseFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipePhaseFieldInfo = Int8 type AttrLabel EventTouchpadSwipePhaseFieldInfo = "phase" type AttrOrigin EventTouchpadSwipePhaseFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipePhase attrSet _ = setEventTouchpadSwipePhase attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_phase :: AttrLabelProxy "phase" eventTouchpadSwipe_phase = AttrLabelProxy #endif {- | Get the value of the “@n_fingers@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #nFingers @ -} getEventTouchpadSwipeNFingers :: MonadIO m => EventTouchpadSwipe -> m Int8 getEventTouchpadSwipeNFingers s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 18) :: IO Int8 return val {- | Set the value of the “@n_fingers@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #nFingers 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeNFingers :: MonadIO m => EventTouchpadSwipe -> Int8 -> m () setEventTouchpadSwipeNFingers s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 18) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchpadSwipeNFingersFieldInfo instance AttrInfo EventTouchpadSwipeNFingersFieldInfo where type AttrAllowedOps EventTouchpadSwipeNFingersFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeNFingersFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchpadSwipeNFingersFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeNFingersFieldInfo = Int8 type AttrLabel EventTouchpadSwipeNFingersFieldInfo = "n_fingers" type AttrOrigin EventTouchpadSwipeNFingersFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeNFingers attrSet _ = setEventTouchpadSwipeNFingers attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_nFingers :: AttrLabelProxy "nFingers" eventTouchpadSwipe_nFingers = AttrLabelProxy #endif {- | Get the value of the “@time@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #time @ -} getEventTouchpadSwipeTime :: MonadIO m => EventTouchpadSwipe -> m Word32 getEventTouchpadSwipeTime s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val {- | Set the value of the “@time@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #time 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeTime :: MonadIO m => EventTouchpadSwipe -> Word32 -> m () setEventTouchpadSwipeTime s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 20) (val :: Word32) #if ENABLE_OVERLOADING data EventTouchpadSwipeTimeFieldInfo instance AttrInfo EventTouchpadSwipeTimeFieldInfo where type AttrAllowedOps EventTouchpadSwipeTimeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeTimeFieldInfo = (~) Word32 type AttrBaseTypeConstraint EventTouchpadSwipeTimeFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeTimeFieldInfo = Word32 type AttrLabel EventTouchpadSwipeTimeFieldInfo = "time" type AttrOrigin EventTouchpadSwipeTimeFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeTime attrSet _ = setEventTouchpadSwipeTime attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_time :: AttrLabelProxy "time" eventTouchpadSwipe_time = AttrLabelProxy #endif {- | Get the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #x @ -} getEventTouchpadSwipeX :: MonadIO m => EventTouchpadSwipe -> m Double getEventTouchpadSwipeX s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #x 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeX :: MonadIO m => EventTouchpadSwipe -> Double -> m () setEventTouchpadSwipeX s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 24) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadSwipeXFieldInfo instance AttrInfo EventTouchpadSwipeXFieldInfo where type AttrAllowedOps EventTouchpadSwipeXFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeXFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadSwipeXFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeXFieldInfo = Double type AttrLabel EventTouchpadSwipeXFieldInfo = "x" type AttrOrigin EventTouchpadSwipeXFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeX attrSet _ = setEventTouchpadSwipeX attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_x :: AttrLabelProxy "x" eventTouchpadSwipe_x = AttrLabelProxy #endif {- | Get the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #y @ -} getEventTouchpadSwipeY :: MonadIO m => EventTouchpadSwipe -> m Double getEventTouchpadSwipeY s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #y 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeY :: MonadIO m => EventTouchpadSwipe -> Double -> m () setEventTouchpadSwipeY s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 32) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadSwipeYFieldInfo instance AttrInfo EventTouchpadSwipeYFieldInfo where type AttrAllowedOps EventTouchpadSwipeYFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeYFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadSwipeYFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeYFieldInfo = Double type AttrLabel EventTouchpadSwipeYFieldInfo = "y" type AttrOrigin EventTouchpadSwipeYFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeY attrSet _ = setEventTouchpadSwipeY attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_y :: AttrLabelProxy "y" eventTouchpadSwipe_y = AttrLabelProxy #endif {- | Get the value of the “@dx@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #dx @ -} getEventTouchpadSwipeDx :: MonadIO m => EventTouchpadSwipe -> m Double getEventTouchpadSwipeDx s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@dx@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #dx 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeDx :: MonadIO m => EventTouchpadSwipe -> Double -> m () setEventTouchpadSwipeDx s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 40) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadSwipeDxFieldInfo instance AttrInfo EventTouchpadSwipeDxFieldInfo where type AttrAllowedOps EventTouchpadSwipeDxFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeDxFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadSwipeDxFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeDxFieldInfo = Double type AttrLabel EventTouchpadSwipeDxFieldInfo = "dx" type AttrOrigin EventTouchpadSwipeDxFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeDx attrSet _ = setEventTouchpadSwipeDx attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_dx :: AttrLabelProxy "dx" eventTouchpadSwipe_dx = AttrLabelProxy #endif {- | Get the value of the “@dy@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #dy @ -} getEventTouchpadSwipeDy :: MonadIO m => EventTouchpadSwipe -> m Double getEventTouchpadSwipeDy s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@dy@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #dy 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeDy :: MonadIO m => EventTouchpadSwipe -> Double -> m () setEventTouchpadSwipeDy s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 48) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadSwipeDyFieldInfo instance AttrInfo EventTouchpadSwipeDyFieldInfo where type AttrAllowedOps EventTouchpadSwipeDyFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeDyFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadSwipeDyFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeDyFieldInfo = Double type AttrLabel EventTouchpadSwipeDyFieldInfo = "dy" type AttrOrigin EventTouchpadSwipeDyFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeDy attrSet _ = setEventTouchpadSwipeDy attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_dy :: AttrLabelProxy "dy" eventTouchpadSwipe_dy = AttrLabelProxy #endif {- | Get the value of the “@x_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #xRoot @ -} getEventTouchpadSwipeXRoot :: MonadIO m => EventTouchpadSwipe -> m Double getEventTouchpadSwipeXRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 56) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@x_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #xRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeXRoot :: MonadIO m => EventTouchpadSwipe -> Double -> m () setEventTouchpadSwipeXRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 56) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadSwipeXRootFieldInfo instance AttrInfo EventTouchpadSwipeXRootFieldInfo where type AttrAllowedOps EventTouchpadSwipeXRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeXRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadSwipeXRootFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeXRootFieldInfo = Double type AttrLabel EventTouchpadSwipeXRootFieldInfo = "x_root" type AttrOrigin EventTouchpadSwipeXRootFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeXRoot attrSet _ = setEventTouchpadSwipeXRoot attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_xRoot :: AttrLabelProxy "xRoot" eventTouchpadSwipe_xRoot = AttrLabelProxy #endif {- | Get the value of the “@y_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #yRoot @ -} getEventTouchpadSwipeYRoot :: MonadIO m => EventTouchpadSwipe -> m Double getEventTouchpadSwipeYRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@y_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #yRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeYRoot :: MonadIO m => EventTouchpadSwipe -> Double -> m () setEventTouchpadSwipeYRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 64) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadSwipeYRootFieldInfo instance AttrInfo EventTouchpadSwipeYRootFieldInfo where type AttrAllowedOps EventTouchpadSwipeYRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeYRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadSwipeYRootFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeYRootFieldInfo = Double type AttrLabel EventTouchpadSwipeYRootFieldInfo = "y_root" type AttrOrigin EventTouchpadSwipeYRootFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeYRoot attrSet _ = setEventTouchpadSwipeYRoot attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_yRoot :: AttrLabelProxy "yRoot" eventTouchpadSwipe_yRoot = AttrLabelProxy #endif {- | Get the value of the “@state@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadSwipe #state @ -} getEventTouchpadSwipeState :: MonadIO m => EventTouchpadSwipe -> m [Gdk.Flags.ModifierType] getEventTouchpadSwipeState s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 72) :: IO CUInt let val' = wordToGFlags val return val' {- | Set the value of the “@state@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadSwipe [ #state 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadSwipeState :: MonadIO m => EventTouchpadSwipe -> [Gdk.Flags.ModifierType] -> m () setEventTouchpadSwipeState s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = gflagsToWord val poke (ptr `plusPtr` 72) (val' :: CUInt) #if ENABLE_OVERLOADING data EventTouchpadSwipeStateFieldInfo instance AttrInfo EventTouchpadSwipeStateFieldInfo where type AttrAllowedOps EventTouchpadSwipeStateFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadSwipeStateFieldInfo = (~) [Gdk.Flags.ModifierType] type AttrBaseTypeConstraint EventTouchpadSwipeStateFieldInfo = (~) EventTouchpadSwipe type AttrGetType EventTouchpadSwipeStateFieldInfo = [Gdk.Flags.ModifierType] type AttrLabel EventTouchpadSwipeStateFieldInfo = "state" type AttrOrigin EventTouchpadSwipeStateFieldInfo = EventTouchpadSwipe attrGet _ = getEventTouchpadSwipeState attrSet _ = setEventTouchpadSwipeState attrConstruct = undefined attrClear _ = undefined eventTouchpadSwipe_state :: AttrLabelProxy "state" eventTouchpadSwipe_state = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList EventTouchpadSwipe type instance O.AttributeList EventTouchpadSwipe = EventTouchpadSwipeAttributeList type EventTouchpadSwipeAttributeList = ('[ '("type", EventTouchpadSwipeTypeFieldInfo), '("window", EventTouchpadSwipeWindowFieldInfo), '("sendEvent", EventTouchpadSwipeSendEventFieldInfo), '("phase", EventTouchpadSwipePhaseFieldInfo), '("nFingers", EventTouchpadSwipeNFingersFieldInfo), '("time", EventTouchpadSwipeTimeFieldInfo), '("x", EventTouchpadSwipeXFieldInfo), '("y", EventTouchpadSwipeYFieldInfo), '("dx", EventTouchpadSwipeDxFieldInfo), '("dy", EventTouchpadSwipeDyFieldInfo), '("xRoot", EventTouchpadSwipeXRootFieldInfo), '("yRoot", EventTouchpadSwipeYRootFieldInfo), '("state", EventTouchpadSwipeStateFieldInfo)] :: [(Symbol, *)]) #endif #if ENABLE_OVERLOADING type family ResolveEventTouchpadSwipeMethod (t :: Symbol) (o :: *) :: * where ResolveEventTouchpadSwipeMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveEventTouchpadSwipeMethod t EventTouchpadSwipe, O.MethodInfo info EventTouchpadSwipe p) => OL.IsLabel t (EventTouchpadSwipe -> p) where #if MIN_VERSION_base(4,10,0) fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #else fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #endif #endif