{- | 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.EventTouchpadPinch ( -- * Exported types EventTouchpadPinch(..) , newZeroEventTouchpadPinch , noEventTouchpadPinch , -- * Properties -- ** angleDelta #attr:angleDelta# {- | The angle change in radians, negative angles denote counter-clockwise movements -} #if ENABLE_OVERLOADING eventTouchpadPinch_angleDelta , #endif getEventTouchpadPinchAngleDelta , setEventTouchpadPinchAngleDelta , -- ** dx #attr:dx# {- | Movement delta in the X axis of the swipe focal point -} #if ENABLE_OVERLOADING eventTouchpadPinch_dx , #endif getEventTouchpadPinchDx , setEventTouchpadPinchDx , -- ** dy #attr:dy# {- | Movement delta in the Y axis of the swipe focal point -} #if ENABLE_OVERLOADING eventTouchpadPinch_dy , #endif getEventTouchpadPinchDy , setEventTouchpadPinchDy , -- ** nFingers #attr:nFingers# {- | The number of fingers triggering the pinch -} #if ENABLE_OVERLOADING eventTouchpadPinch_nFingers , #endif getEventTouchpadPinchNFingers , setEventTouchpadPinchNFingers , -- ** phase #attr:phase# {- | the current phase of the gesture -} #if ENABLE_OVERLOADING eventTouchpadPinch_phase , #endif getEventTouchpadPinchPhase , setEventTouchpadPinchPhase , -- ** scale #attr:scale# {- | The current scale, relative to that at the time of the corresponding 'GI.Gdk.Enums.TouchpadGesturePhaseBegin' event -} #if ENABLE_OVERLOADING eventTouchpadPinch_scale , #endif getEventTouchpadPinchScale , setEventTouchpadPinchScale , -- ** sendEvent #attr:sendEvent# {- | 'True' if the event was sent explicitly -} #if ENABLE_OVERLOADING eventTouchpadPinch_sendEvent , #endif getEventTouchpadPinchSendEvent , setEventTouchpadPinchSendEvent , -- ** 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 eventTouchpadPinch_state , #endif getEventTouchpadPinchState , setEventTouchpadPinchState , -- ** time #attr:time# {- | the time of the event in milliseconds -} #if ENABLE_OVERLOADING eventTouchpadPinch_time , #endif getEventTouchpadPinchTime , setEventTouchpadPinchTime , -- ** type #attr:type# {- | the type of the event ('GI.Gdk.Enums.EventTypeTouchpadPinch') -} #if ENABLE_OVERLOADING eventTouchpadPinch_type , #endif getEventTouchpadPinchType , setEventTouchpadPinchType , -- ** window #attr:window# {- | the window which received the event -} clearEventTouchpadPinchWindow , #if ENABLE_OVERLOADING eventTouchpadPinch_window , #endif getEventTouchpadPinchWindow , setEventTouchpadPinchWindow , -- ** x #attr:x# {- | The X coordinate of the pointer -} #if ENABLE_OVERLOADING eventTouchpadPinch_x , #endif getEventTouchpadPinchX , setEventTouchpadPinchX , -- ** xRoot #attr:xRoot# {- | The X coordinate of the pointer, relative to the root of the screen. -} #if ENABLE_OVERLOADING eventTouchpadPinch_xRoot , #endif getEventTouchpadPinchXRoot , setEventTouchpadPinchXRoot , -- ** y #attr:y# {- | The Y coordinate of the pointer -} #if ENABLE_OVERLOADING eventTouchpadPinch_y , #endif getEventTouchpadPinchY , setEventTouchpadPinchY , -- ** yRoot #attr:yRoot# {- | The Y coordinate of the pointer, relative to the root of the screen. -} #if ENABLE_OVERLOADING eventTouchpadPinch_yRoot , #endif getEventTouchpadPinchYRoot , setEventTouchpadPinchYRoot , ) 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 EventTouchpadPinch = EventTouchpadPinch (ManagedPtr EventTouchpadPinch) instance WrappedPtr EventTouchpadPinch where wrappedPtrCalloc = callocBytes 96 wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 96 >=> wrapPtr EventTouchpadPinch) wrappedPtrFree = Just ptr_to_g_free -- | Construct a `EventTouchpadPinch` struct initialized to zero. newZeroEventTouchpadPinch :: MonadIO m => m EventTouchpadPinch newZeroEventTouchpadPinch = liftIO $ wrappedPtrCalloc >>= wrapPtr EventTouchpadPinch instance tag ~ 'AttrSet => Constructible EventTouchpadPinch tag where new _ attrs = do o <- newZeroEventTouchpadPinch GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `EventTouchpadPinch`. noEventTouchpadPinch :: Maybe EventTouchpadPinch noEventTouchpadPinch = Nothing {- | Get the value of the “@type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #type @ -} getEventTouchpadPinchType :: MonadIO m => EventTouchpadPinch -> m Gdk.Enums.EventType getEventTouchpadPinchType 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' eventTouchpadPinch [ #type 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchType :: MonadIO m => EventTouchpadPinch -> Gdk.Enums.EventType -> m () setEventTouchpadPinchType s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = (fromIntegral . fromEnum) val poke (ptr `plusPtr` 0) (val' :: CInt) #if ENABLE_OVERLOADING data EventTouchpadPinchTypeFieldInfo instance AttrInfo EventTouchpadPinchTypeFieldInfo where type AttrAllowedOps EventTouchpadPinchTypeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchTypeFieldInfo = (~) Gdk.Enums.EventType type AttrBaseTypeConstraint EventTouchpadPinchTypeFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchTypeFieldInfo = Gdk.Enums.EventType type AttrLabel EventTouchpadPinchTypeFieldInfo = "type" type AttrOrigin EventTouchpadPinchTypeFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchType attrSet _ = setEventTouchpadPinchType attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_type :: AttrLabelProxy "type" eventTouchpadPinch_type = AttrLabelProxy #endif {- | Get the value of the “@window@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #window @ -} getEventTouchpadPinchWindow :: MonadIO m => EventTouchpadPinch -> m (Maybe Gdk.Window.Window) getEventTouchpadPinchWindow 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' eventTouchpadPinch [ #window 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchWindow :: MonadIO m => EventTouchpadPinch -> Ptr Gdk.Window.Window -> m () setEventTouchpadPinchWindow 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 @ -} clearEventTouchpadPinchWindow :: MonadIO m => EventTouchpadPinch -> m () clearEventTouchpadPinchWindow s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr Gdk.Window.Window) #if ENABLE_OVERLOADING data EventTouchpadPinchWindowFieldInfo instance AttrInfo EventTouchpadPinchWindowFieldInfo where type AttrAllowedOps EventTouchpadPinchWindowFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventTouchpadPinchWindowFieldInfo = (~) (Ptr Gdk.Window.Window) type AttrBaseTypeConstraint EventTouchpadPinchWindowFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchWindowFieldInfo = Maybe Gdk.Window.Window type AttrLabel EventTouchpadPinchWindowFieldInfo = "window" type AttrOrigin EventTouchpadPinchWindowFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchWindow attrSet _ = setEventTouchpadPinchWindow attrConstruct = undefined attrClear _ = clearEventTouchpadPinchWindow eventTouchpadPinch_window :: AttrLabelProxy "window" eventTouchpadPinch_window = AttrLabelProxy #endif {- | Get the value of the “@send_event@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #sendEvent @ -} getEventTouchpadPinchSendEvent :: MonadIO m => EventTouchpadPinch -> m Int8 getEventTouchpadPinchSendEvent 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' eventTouchpadPinch [ #sendEvent 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchSendEvent :: MonadIO m => EventTouchpadPinch -> Int8 -> m () setEventTouchpadPinchSendEvent s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 16) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchpadPinchSendEventFieldInfo instance AttrInfo EventTouchpadPinchSendEventFieldInfo where type AttrAllowedOps EventTouchpadPinchSendEventFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchSendEventFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchpadPinchSendEventFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchSendEventFieldInfo = Int8 type AttrLabel EventTouchpadPinchSendEventFieldInfo = "send_event" type AttrOrigin EventTouchpadPinchSendEventFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchSendEvent attrSet _ = setEventTouchpadPinchSendEvent attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_sendEvent :: AttrLabelProxy "sendEvent" eventTouchpadPinch_sendEvent = AttrLabelProxy #endif {- | Get the value of the “@phase@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #phase @ -} getEventTouchpadPinchPhase :: MonadIO m => EventTouchpadPinch -> m Int8 getEventTouchpadPinchPhase 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' eventTouchpadPinch [ #phase 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchPhase :: MonadIO m => EventTouchpadPinch -> Int8 -> m () setEventTouchpadPinchPhase s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 17) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchpadPinchPhaseFieldInfo instance AttrInfo EventTouchpadPinchPhaseFieldInfo where type AttrAllowedOps EventTouchpadPinchPhaseFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchPhaseFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchpadPinchPhaseFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchPhaseFieldInfo = Int8 type AttrLabel EventTouchpadPinchPhaseFieldInfo = "phase" type AttrOrigin EventTouchpadPinchPhaseFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchPhase attrSet _ = setEventTouchpadPinchPhase attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_phase :: AttrLabelProxy "phase" eventTouchpadPinch_phase = AttrLabelProxy #endif {- | Get the value of the “@n_fingers@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #nFingers @ -} getEventTouchpadPinchNFingers :: MonadIO m => EventTouchpadPinch -> m Int8 getEventTouchpadPinchNFingers 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' eventTouchpadPinch [ #nFingers 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchNFingers :: MonadIO m => EventTouchpadPinch -> Int8 -> m () setEventTouchpadPinchNFingers s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 18) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchpadPinchNFingersFieldInfo instance AttrInfo EventTouchpadPinchNFingersFieldInfo where type AttrAllowedOps EventTouchpadPinchNFingersFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchNFingersFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchpadPinchNFingersFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchNFingersFieldInfo = Int8 type AttrLabel EventTouchpadPinchNFingersFieldInfo = "n_fingers" type AttrOrigin EventTouchpadPinchNFingersFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchNFingers attrSet _ = setEventTouchpadPinchNFingers attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_nFingers :: AttrLabelProxy "nFingers" eventTouchpadPinch_nFingers = AttrLabelProxy #endif {- | Get the value of the “@time@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #time @ -} getEventTouchpadPinchTime :: MonadIO m => EventTouchpadPinch -> m Word32 getEventTouchpadPinchTime 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' eventTouchpadPinch [ #time 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchTime :: MonadIO m => EventTouchpadPinch -> Word32 -> m () setEventTouchpadPinchTime s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 20) (val :: Word32) #if ENABLE_OVERLOADING data EventTouchpadPinchTimeFieldInfo instance AttrInfo EventTouchpadPinchTimeFieldInfo where type AttrAllowedOps EventTouchpadPinchTimeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchTimeFieldInfo = (~) Word32 type AttrBaseTypeConstraint EventTouchpadPinchTimeFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchTimeFieldInfo = Word32 type AttrLabel EventTouchpadPinchTimeFieldInfo = "time" type AttrOrigin EventTouchpadPinchTimeFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchTime attrSet _ = setEventTouchpadPinchTime attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_time :: AttrLabelProxy "time" eventTouchpadPinch_time = AttrLabelProxy #endif {- | Get the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #x @ -} getEventTouchpadPinchX :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchX 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' eventTouchpadPinch [ #x 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchX :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchX s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 24) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchXFieldInfo instance AttrInfo EventTouchpadPinchXFieldInfo where type AttrAllowedOps EventTouchpadPinchXFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchXFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchXFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchXFieldInfo = Double type AttrLabel EventTouchpadPinchXFieldInfo = "x" type AttrOrigin EventTouchpadPinchXFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchX attrSet _ = setEventTouchpadPinchX attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_x :: AttrLabelProxy "x" eventTouchpadPinch_x = AttrLabelProxy #endif {- | Get the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #y @ -} getEventTouchpadPinchY :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchY 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' eventTouchpadPinch [ #y 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchY :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchY s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 32) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchYFieldInfo instance AttrInfo EventTouchpadPinchYFieldInfo where type AttrAllowedOps EventTouchpadPinchYFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchYFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchYFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchYFieldInfo = Double type AttrLabel EventTouchpadPinchYFieldInfo = "y" type AttrOrigin EventTouchpadPinchYFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchY attrSet _ = setEventTouchpadPinchY attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_y :: AttrLabelProxy "y" eventTouchpadPinch_y = AttrLabelProxy #endif {- | Get the value of the “@dx@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #dx @ -} getEventTouchpadPinchDx :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchDx 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' eventTouchpadPinch [ #dx 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchDx :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchDx s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 40) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchDxFieldInfo instance AttrInfo EventTouchpadPinchDxFieldInfo where type AttrAllowedOps EventTouchpadPinchDxFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchDxFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchDxFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchDxFieldInfo = Double type AttrLabel EventTouchpadPinchDxFieldInfo = "dx" type AttrOrigin EventTouchpadPinchDxFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchDx attrSet _ = setEventTouchpadPinchDx attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_dx :: AttrLabelProxy "dx" eventTouchpadPinch_dx = AttrLabelProxy #endif {- | Get the value of the “@dy@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #dy @ -} getEventTouchpadPinchDy :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchDy 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' eventTouchpadPinch [ #dy 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchDy :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchDy s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 48) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchDyFieldInfo instance AttrInfo EventTouchpadPinchDyFieldInfo where type AttrAllowedOps EventTouchpadPinchDyFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchDyFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchDyFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchDyFieldInfo = Double type AttrLabel EventTouchpadPinchDyFieldInfo = "dy" type AttrOrigin EventTouchpadPinchDyFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchDy attrSet _ = setEventTouchpadPinchDy attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_dy :: AttrLabelProxy "dy" eventTouchpadPinch_dy = AttrLabelProxy #endif {- | Get the value of the “@angle_delta@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #angleDelta @ -} getEventTouchpadPinchAngleDelta :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchAngleDelta s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 56) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@angle_delta@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadPinch [ #angleDelta 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchAngleDelta :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchAngleDelta s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 56) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchAngleDeltaFieldInfo instance AttrInfo EventTouchpadPinchAngleDeltaFieldInfo where type AttrAllowedOps EventTouchpadPinchAngleDeltaFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchAngleDeltaFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchAngleDeltaFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchAngleDeltaFieldInfo = Double type AttrLabel EventTouchpadPinchAngleDeltaFieldInfo = "angle_delta" type AttrOrigin EventTouchpadPinchAngleDeltaFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchAngleDelta attrSet _ = setEventTouchpadPinchAngleDelta attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_angleDelta :: AttrLabelProxy "angleDelta" eventTouchpadPinch_angleDelta = AttrLabelProxy #endif {- | Get the value of the “@scale@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #scale @ -} getEventTouchpadPinchScale :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchScale s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@scale@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouchpadPinch [ #scale 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchScale :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchScale s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 64) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchScaleFieldInfo instance AttrInfo EventTouchpadPinchScaleFieldInfo where type AttrAllowedOps EventTouchpadPinchScaleFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchScaleFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchScaleFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchScaleFieldInfo = Double type AttrLabel EventTouchpadPinchScaleFieldInfo = "scale" type AttrOrigin EventTouchpadPinchScaleFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchScale attrSet _ = setEventTouchpadPinchScale attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_scale :: AttrLabelProxy "scale" eventTouchpadPinch_scale = AttrLabelProxy #endif {- | Get the value of the “@x_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #xRoot @ -} getEventTouchpadPinchXRoot :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchXRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 72) :: 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' eventTouchpadPinch [ #xRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchXRoot :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchXRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 72) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchXRootFieldInfo instance AttrInfo EventTouchpadPinchXRootFieldInfo where type AttrAllowedOps EventTouchpadPinchXRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchXRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchXRootFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchXRootFieldInfo = Double type AttrLabel EventTouchpadPinchXRootFieldInfo = "x_root" type AttrOrigin EventTouchpadPinchXRootFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchXRoot attrSet _ = setEventTouchpadPinchXRoot attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_xRoot :: AttrLabelProxy "xRoot" eventTouchpadPinch_xRoot = AttrLabelProxy #endif {- | Get the value of the “@y_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #yRoot @ -} getEventTouchpadPinchYRoot :: MonadIO m => EventTouchpadPinch -> m Double getEventTouchpadPinchYRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 80) :: 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' eventTouchpadPinch [ #yRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchYRoot :: MonadIO m => EventTouchpadPinch -> Double -> m () setEventTouchpadPinchYRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 80) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchpadPinchYRootFieldInfo instance AttrInfo EventTouchpadPinchYRootFieldInfo where type AttrAllowedOps EventTouchpadPinchYRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchYRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchpadPinchYRootFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchYRootFieldInfo = Double type AttrLabel EventTouchpadPinchYRootFieldInfo = "y_root" type AttrOrigin EventTouchpadPinchYRootFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchYRoot attrSet _ = setEventTouchpadPinchYRoot attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_yRoot :: AttrLabelProxy "yRoot" eventTouchpadPinch_yRoot = AttrLabelProxy #endif {- | Get the value of the “@state@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouchpadPinch #state @ -} getEventTouchpadPinchState :: MonadIO m => EventTouchpadPinch -> m [Gdk.Flags.ModifierType] getEventTouchpadPinchState s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 88) :: 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' eventTouchpadPinch [ #state 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchpadPinchState :: MonadIO m => EventTouchpadPinch -> [Gdk.Flags.ModifierType] -> m () setEventTouchpadPinchState s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = gflagsToWord val poke (ptr `plusPtr` 88) (val' :: CUInt) #if ENABLE_OVERLOADING data EventTouchpadPinchStateFieldInfo instance AttrInfo EventTouchpadPinchStateFieldInfo where type AttrAllowedOps EventTouchpadPinchStateFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchpadPinchStateFieldInfo = (~) [Gdk.Flags.ModifierType] type AttrBaseTypeConstraint EventTouchpadPinchStateFieldInfo = (~) EventTouchpadPinch type AttrGetType EventTouchpadPinchStateFieldInfo = [Gdk.Flags.ModifierType] type AttrLabel EventTouchpadPinchStateFieldInfo = "state" type AttrOrigin EventTouchpadPinchStateFieldInfo = EventTouchpadPinch attrGet _ = getEventTouchpadPinchState attrSet _ = setEventTouchpadPinchState attrConstruct = undefined attrClear _ = undefined eventTouchpadPinch_state :: AttrLabelProxy "state" eventTouchpadPinch_state = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList EventTouchpadPinch type instance O.AttributeList EventTouchpadPinch = EventTouchpadPinchAttributeList type EventTouchpadPinchAttributeList = ('[ '("type", EventTouchpadPinchTypeFieldInfo), '("window", EventTouchpadPinchWindowFieldInfo), '("sendEvent", EventTouchpadPinchSendEventFieldInfo), '("phase", EventTouchpadPinchPhaseFieldInfo), '("nFingers", EventTouchpadPinchNFingersFieldInfo), '("time", EventTouchpadPinchTimeFieldInfo), '("x", EventTouchpadPinchXFieldInfo), '("y", EventTouchpadPinchYFieldInfo), '("dx", EventTouchpadPinchDxFieldInfo), '("dy", EventTouchpadPinchDyFieldInfo), '("angleDelta", EventTouchpadPinchAngleDeltaFieldInfo), '("scale", EventTouchpadPinchScaleFieldInfo), '("xRoot", EventTouchpadPinchXRootFieldInfo), '("yRoot", EventTouchpadPinchYRootFieldInfo), '("state", EventTouchpadPinchStateFieldInfo)] :: [(Symbol, *)]) #endif #if ENABLE_OVERLOADING type family ResolveEventTouchpadPinchMethod (t :: Symbol) (o :: *) :: * where ResolveEventTouchpadPinchMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveEventTouchpadPinchMethod t EventTouchpadPinch, O.MethodInfo info EventTouchpadPinch p) => OL.IsLabel t (EventTouchpadPinch -> 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