{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) Used for touch events. /@type@/ field will be one of 'GI.Gdk.Enums.EventTypeTouchBegin', 'GI.Gdk.Enums.EventTypeTouchUpdate', 'GI.Gdk.Enums.EventTypeTouchEnd' or 'GI.Gdk.Enums.EventTypeTouchCancel'. Touch events are grouped into sequences by means of the /@sequence@/ field, which can also be obtained with 'GI.Gdk.Unions.Event.eventGetEventSequence'. Each sequence begins with a 'GI.Gdk.Enums.EventTypeTouchBegin' event, followed by any number of 'GI.Gdk.Enums.EventTypeTouchUpdate' events, and ends with a 'GI.Gdk.Enums.EventTypeTouchEnd' (or 'GI.Gdk.Enums.EventTypeTouchCancel') event. With multitouch devices, there may be several active sequences at the same time. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gdk.Structs.EventTouch ( -- * Exported types EventTouch(..) , newZeroEventTouch , noEventTouch , -- * Properties -- ** axes #attr:axes# {- | /@x@/, /@y@/ translated to the axes of /@device@/, or 'Nothing' if /@device@/ is the mouse -} #if ENABLE_OVERLOADING eventTouch_axes , #endif getEventTouchAxes , setEventTouchAxes , -- ** device #attr:device# {- | the master device that the event originated from. Use 'GI.Gdk.Unions.Event.eventGetSourceDevice' to get the slave device. -} clearEventTouchDevice , #if ENABLE_OVERLOADING eventTouch_device , #endif getEventTouchDevice , setEventTouchDevice , -- ** emulatingPointer #attr:emulatingPointer# {- | whether the event should be used for emulating pointer event -} #if ENABLE_OVERLOADING eventTouch_emulatingPointer , #endif getEventTouchEmulatingPointer , setEventTouchEmulatingPointer , -- ** sendEvent #attr:sendEvent# {- | 'True' if the event was sent explicitly. -} #if ENABLE_OVERLOADING eventTouch_sendEvent , #endif getEventTouchSendEvent , setEventTouchSendEvent , -- ** sequence #attr:sequence# {- | the event sequence that the event belongs to -} clearEventTouchSequence , #if ENABLE_OVERLOADING eventTouch_sequence , #endif getEventTouchSequence , setEventTouchSequence , -- ** 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 eventTouch_state , #endif getEventTouchState , setEventTouchState , -- ** time #attr:time# {- | the time of the event in milliseconds. -} #if ENABLE_OVERLOADING eventTouch_time , #endif getEventTouchTime , setEventTouchTime , -- ** type #attr:type# {- | the type of the event ('GI.Gdk.Enums.EventTypeTouchBegin', 'GI.Gdk.Enums.EventTypeTouchUpdate', 'GI.Gdk.Enums.EventTypeTouchEnd', 'GI.Gdk.Enums.EventTypeTouchCancel') -} #if ENABLE_OVERLOADING eventTouch_type , #endif getEventTouchType , setEventTouchType , -- ** window #attr:window# {- | the window which received the event -} clearEventTouchWindow , #if ENABLE_OVERLOADING eventTouch_window , #endif getEventTouchWindow , setEventTouchWindow , -- ** x #attr:x# {- | the x coordinate of the pointer relative to the window -} #if ENABLE_OVERLOADING eventTouch_x , #endif getEventTouchX , setEventTouchX , -- ** xRoot #attr:xRoot# {- | the x coordinate of the pointer relative to the root of the screen -} #if ENABLE_OVERLOADING eventTouch_xRoot , #endif getEventTouchXRoot , setEventTouchXRoot , -- ** y #attr:y# {- | the y coordinate of the pointer relative to the window -} #if ENABLE_OVERLOADING eventTouch_y , #endif getEventTouchY , setEventTouchY , -- ** yRoot #attr:yRoot# {- | the y coordinate of the pointer relative to the root of the screen -} #if ENABLE_OVERLOADING eventTouch_yRoot , #endif getEventTouchYRoot , setEventTouchYRoot , ) 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.Device as Gdk.Device import {-# SOURCE #-} qualified GI.Gdk.Objects.Window as Gdk.Window import {-# SOURCE #-} qualified GI.Gdk.Structs.EventSequence as Gdk.EventSequence -- | Memory-managed wrapper type. newtype EventTouch = EventTouch (ManagedPtr EventTouch) instance WrappedPtr EventTouch where wrappedPtrCalloc = callocBytes 96 wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 96 >=> wrapPtr EventTouch) wrappedPtrFree = Just ptr_to_g_free -- | Construct a `EventTouch` struct initialized to zero. newZeroEventTouch :: MonadIO m => m EventTouch newZeroEventTouch = liftIO $ wrappedPtrCalloc >>= wrapPtr EventTouch instance tag ~ 'AttrSet => Constructible EventTouch tag where new _ attrs = do o <- newZeroEventTouch GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `EventTouch`. noEventTouch :: Maybe EventTouch noEventTouch = Nothing {- | Get the value of the “@type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #type @ -} getEventTouchType :: MonadIO m => EventTouch -> m Gdk.Enums.EventType getEventTouchType 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' eventTouch [ #type 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchType :: MonadIO m => EventTouch -> Gdk.Enums.EventType -> m () setEventTouchType s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = (fromIntegral . fromEnum) val poke (ptr `plusPtr` 0) (val' :: CInt) #if ENABLE_OVERLOADING data EventTouchTypeFieldInfo instance AttrInfo EventTouchTypeFieldInfo where type AttrAllowedOps EventTouchTypeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchTypeFieldInfo = (~) Gdk.Enums.EventType type AttrBaseTypeConstraint EventTouchTypeFieldInfo = (~) EventTouch type AttrGetType EventTouchTypeFieldInfo = Gdk.Enums.EventType type AttrLabel EventTouchTypeFieldInfo = "type" type AttrOrigin EventTouchTypeFieldInfo = EventTouch attrGet _ = getEventTouchType attrSet _ = setEventTouchType attrConstruct = undefined attrClear _ = undefined eventTouch_type :: AttrLabelProxy "type" eventTouch_type = AttrLabelProxy #endif {- | Get the value of the “@window@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #window @ -} getEventTouchWindow :: MonadIO m => EventTouch -> m (Maybe Gdk.Window.Window) getEventTouchWindow 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' eventTouch [ #window 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchWindow :: MonadIO m => EventTouch -> Ptr Gdk.Window.Window -> m () setEventTouchWindow 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 @ -} clearEventTouchWindow :: MonadIO m => EventTouch -> m () clearEventTouchWindow s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr Gdk.Window.Window) #if ENABLE_OVERLOADING data EventTouchWindowFieldInfo instance AttrInfo EventTouchWindowFieldInfo where type AttrAllowedOps EventTouchWindowFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventTouchWindowFieldInfo = (~) (Ptr Gdk.Window.Window) type AttrBaseTypeConstraint EventTouchWindowFieldInfo = (~) EventTouch type AttrGetType EventTouchWindowFieldInfo = Maybe Gdk.Window.Window type AttrLabel EventTouchWindowFieldInfo = "window" type AttrOrigin EventTouchWindowFieldInfo = EventTouch attrGet _ = getEventTouchWindow attrSet _ = setEventTouchWindow attrConstruct = undefined attrClear _ = clearEventTouchWindow eventTouch_window :: AttrLabelProxy "window" eventTouch_window = AttrLabelProxy #endif {- | Get the value of the “@send_event@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #sendEvent @ -} getEventTouchSendEvent :: MonadIO m => EventTouch -> m Int8 getEventTouchSendEvent 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' eventTouch [ #sendEvent 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchSendEvent :: MonadIO m => EventTouch -> Int8 -> m () setEventTouchSendEvent s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 16) (val :: Int8) #if ENABLE_OVERLOADING data EventTouchSendEventFieldInfo instance AttrInfo EventTouchSendEventFieldInfo where type AttrAllowedOps EventTouchSendEventFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchSendEventFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventTouchSendEventFieldInfo = (~) EventTouch type AttrGetType EventTouchSendEventFieldInfo = Int8 type AttrLabel EventTouchSendEventFieldInfo = "send_event" type AttrOrigin EventTouchSendEventFieldInfo = EventTouch attrGet _ = getEventTouchSendEvent attrSet _ = setEventTouchSendEvent attrConstruct = undefined attrClear _ = undefined eventTouch_sendEvent :: AttrLabelProxy "sendEvent" eventTouch_sendEvent = AttrLabelProxy #endif {- | Get the value of the “@time@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #time @ -} getEventTouchTime :: MonadIO m => EventTouch -> m Word32 getEventTouchTime 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' eventTouch [ #time 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchTime :: MonadIO m => EventTouch -> Word32 -> m () setEventTouchTime s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 20) (val :: Word32) #if ENABLE_OVERLOADING data EventTouchTimeFieldInfo instance AttrInfo EventTouchTimeFieldInfo where type AttrAllowedOps EventTouchTimeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchTimeFieldInfo = (~) Word32 type AttrBaseTypeConstraint EventTouchTimeFieldInfo = (~) EventTouch type AttrGetType EventTouchTimeFieldInfo = Word32 type AttrLabel EventTouchTimeFieldInfo = "time" type AttrOrigin EventTouchTimeFieldInfo = EventTouch attrGet _ = getEventTouchTime attrSet _ = setEventTouchTime attrConstruct = undefined attrClear _ = undefined eventTouch_time :: AttrLabelProxy "time" eventTouch_time = AttrLabelProxy #endif {- | Get the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #x @ -} getEventTouchX :: MonadIO m => EventTouch -> m Double getEventTouchX 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' eventTouch [ #x 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchX :: MonadIO m => EventTouch -> Double -> m () setEventTouchX s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 24) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchXFieldInfo instance AttrInfo EventTouchXFieldInfo where type AttrAllowedOps EventTouchXFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchXFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchXFieldInfo = (~) EventTouch type AttrGetType EventTouchXFieldInfo = Double type AttrLabel EventTouchXFieldInfo = "x" type AttrOrigin EventTouchXFieldInfo = EventTouch attrGet _ = getEventTouchX attrSet _ = setEventTouchX attrConstruct = undefined attrClear _ = undefined eventTouch_x :: AttrLabelProxy "x" eventTouch_x = AttrLabelProxy #endif {- | Get the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #y @ -} getEventTouchY :: MonadIO m => EventTouch -> m Double getEventTouchY 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' eventTouch [ #y 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchY :: MonadIO m => EventTouch -> Double -> m () setEventTouchY s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 32) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchYFieldInfo instance AttrInfo EventTouchYFieldInfo where type AttrAllowedOps EventTouchYFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchYFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchYFieldInfo = (~) EventTouch type AttrGetType EventTouchYFieldInfo = Double type AttrLabel EventTouchYFieldInfo = "y" type AttrOrigin EventTouchYFieldInfo = EventTouch attrGet _ = getEventTouchY attrSet _ = setEventTouchY attrConstruct = undefined attrClear _ = undefined eventTouch_y :: AttrLabelProxy "y" eventTouch_y = AttrLabelProxy #endif {- | Get the value of the “@axes@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #axes @ -} getEventTouchAxes :: MonadIO m => EventTouch -> m Double getEventTouchAxes s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO CDouble let val' = realToFrac val return val' {- | Set the value of the “@axes@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouch [ #axes 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchAxes :: MonadIO m => EventTouch -> Double -> m () setEventTouchAxes s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 40) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchAxesFieldInfo instance AttrInfo EventTouchAxesFieldInfo where type AttrAllowedOps EventTouchAxesFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchAxesFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchAxesFieldInfo = (~) EventTouch type AttrGetType EventTouchAxesFieldInfo = Double type AttrLabel EventTouchAxesFieldInfo = "axes" type AttrOrigin EventTouchAxesFieldInfo = EventTouch attrGet _ = getEventTouchAxes attrSet _ = setEventTouchAxes attrConstruct = undefined attrClear _ = undefined eventTouch_axes :: AttrLabelProxy "axes" eventTouch_axes = AttrLabelProxy #endif {- | Get the value of the “@state@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #state @ -} getEventTouchState :: MonadIO m => EventTouch -> m [Gdk.Flags.ModifierType] getEventTouchState s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: 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' eventTouch [ #state 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchState :: MonadIO m => EventTouch -> [Gdk.Flags.ModifierType] -> m () setEventTouchState s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = gflagsToWord val poke (ptr `plusPtr` 48) (val' :: CUInt) #if ENABLE_OVERLOADING data EventTouchStateFieldInfo instance AttrInfo EventTouchStateFieldInfo where type AttrAllowedOps EventTouchStateFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchStateFieldInfo = (~) [Gdk.Flags.ModifierType] type AttrBaseTypeConstraint EventTouchStateFieldInfo = (~) EventTouch type AttrGetType EventTouchStateFieldInfo = [Gdk.Flags.ModifierType] type AttrLabel EventTouchStateFieldInfo = "state" type AttrOrigin EventTouchStateFieldInfo = EventTouch attrGet _ = getEventTouchState attrSet _ = setEventTouchState attrConstruct = undefined attrClear _ = undefined eventTouch_state :: AttrLabelProxy "state" eventTouch_state = AttrLabelProxy #endif {- | Get the value of the “@sequence@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #sequence @ -} getEventTouchSequence :: MonadIO m => EventTouch -> m (Maybe Gdk.EventSequence.EventSequence) getEventTouchSequence s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 56) :: IO (Ptr Gdk.EventSequence.EventSequence) result <- SP.convertIfNonNull val $ \val' -> do val'' <- (newBoxed Gdk.EventSequence.EventSequence) val' return val'' return result {- | Set the value of the “@sequence@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouch [ #sequence 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchSequence :: MonadIO m => EventTouch -> Ptr Gdk.EventSequence.EventSequence -> m () setEventTouchSequence s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 56) (val :: Ptr Gdk.EventSequence.EventSequence) {- | Set the value of the “@sequence@” field to `Nothing`. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.clear' #sequence @ -} clearEventTouchSequence :: MonadIO m => EventTouch -> m () clearEventTouchSequence s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 56) (FP.nullPtr :: Ptr Gdk.EventSequence.EventSequence) #if ENABLE_OVERLOADING data EventTouchSequenceFieldInfo instance AttrInfo EventTouchSequenceFieldInfo where type AttrAllowedOps EventTouchSequenceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventTouchSequenceFieldInfo = (~) (Ptr Gdk.EventSequence.EventSequence) type AttrBaseTypeConstraint EventTouchSequenceFieldInfo = (~) EventTouch type AttrGetType EventTouchSequenceFieldInfo = Maybe Gdk.EventSequence.EventSequence type AttrLabel EventTouchSequenceFieldInfo = "sequence" type AttrOrigin EventTouchSequenceFieldInfo = EventTouch attrGet _ = getEventTouchSequence attrSet _ = setEventTouchSequence attrConstruct = undefined attrClear _ = clearEventTouchSequence eventTouch_sequence :: AttrLabelProxy "sequence" eventTouch_sequence = AttrLabelProxy #endif {- | Get the value of the “@emulating_pointer@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #emulatingPointer @ -} getEventTouchEmulatingPointer :: MonadIO m => EventTouch -> m Bool getEventTouchEmulatingPointer s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO CInt let val' = (/= 0) val return val' {- | Set the value of the “@emulating_pointer@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouch [ #emulatingPointer 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchEmulatingPointer :: MonadIO m => EventTouch -> Bool -> m () setEventTouchEmulatingPointer s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = (fromIntegral . fromEnum) val poke (ptr `plusPtr` 64) (val' :: CInt) #if ENABLE_OVERLOADING data EventTouchEmulatingPointerFieldInfo instance AttrInfo EventTouchEmulatingPointerFieldInfo where type AttrAllowedOps EventTouchEmulatingPointerFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchEmulatingPointerFieldInfo = (~) Bool type AttrBaseTypeConstraint EventTouchEmulatingPointerFieldInfo = (~) EventTouch type AttrGetType EventTouchEmulatingPointerFieldInfo = Bool type AttrLabel EventTouchEmulatingPointerFieldInfo = "emulating_pointer" type AttrOrigin EventTouchEmulatingPointerFieldInfo = EventTouch attrGet _ = getEventTouchEmulatingPointer attrSet _ = setEventTouchEmulatingPointer attrConstruct = undefined attrClear _ = undefined eventTouch_emulatingPointer :: AttrLabelProxy "emulatingPointer" eventTouch_emulatingPointer = AttrLabelProxy #endif {- | Get the value of the “@device@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #device @ -} getEventTouchDevice :: MonadIO m => EventTouch -> m (Maybe Gdk.Device.Device) getEventTouchDevice s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 72) :: IO (Ptr Gdk.Device.Device) result <- SP.convertIfNonNull val $ \val' -> do val'' <- (newObject Gdk.Device.Device) val' return val'' return result {- | Set the value of the “@device@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventTouch [ #device 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchDevice :: MonadIO m => EventTouch -> Ptr Gdk.Device.Device -> m () setEventTouchDevice s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 72) (val :: Ptr Gdk.Device.Device) {- | Set the value of the “@device@” field to `Nothing`. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.clear' #device @ -} clearEventTouchDevice :: MonadIO m => EventTouch -> m () clearEventTouchDevice s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 72) (FP.nullPtr :: Ptr Gdk.Device.Device) #if ENABLE_OVERLOADING data EventTouchDeviceFieldInfo instance AttrInfo EventTouchDeviceFieldInfo where type AttrAllowedOps EventTouchDeviceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventTouchDeviceFieldInfo = (~) (Ptr Gdk.Device.Device) type AttrBaseTypeConstraint EventTouchDeviceFieldInfo = (~) EventTouch type AttrGetType EventTouchDeviceFieldInfo = Maybe Gdk.Device.Device type AttrLabel EventTouchDeviceFieldInfo = "device" type AttrOrigin EventTouchDeviceFieldInfo = EventTouch attrGet _ = getEventTouchDevice attrSet _ = setEventTouchDevice attrConstruct = undefined attrClear _ = clearEventTouchDevice eventTouch_device :: AttrLabelProxy "device" eventTouch_device = AttrLabelProxy #endif {- | Get the value of the “@x_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #xRoot @ -} getEventTouchXRoot :: MonadIO m => EventTouch -> m Double getEventTouchXRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 80) :: 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' eventTouch [ #xRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchXRoot :: MonadIO m => EventTouch -> Double -> m () setEventTouchXRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 80) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchXRootFieldInfo instance AttrInfo EventTouchXRootFieldInfo where type AttrAllowedOps EventTouchXRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchXRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchXRootFieldInfo = (~) EventTouch type AttrGetType EventTouchXRootFieldInfo = Double type AttrLabel EventTouchXRootFieldInfo = "x_root" type AttrOrigin EventTouchXRootFieldInfo = EventTouch attrGet _ = getEventTouchXRoot attrSet _ = setEventTouchXRoot attrConstruct = undefined attrClear _ = undefined eventTouch_xRoot :: AttrLabelProxy "xRoot" eventTouch_xRoot = AttrLabelProxy #endif {- | Get the value of the “@y_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventTouch #yRoot @ -} getEventTouchYRoot :: MonadIO m => EventTouch -> m Double getEventTouchYRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 88) :: 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' eventTouch [ #yRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventTouchYRoot :: MonadIO m => EventTouch -> Double -> m () setEventTouchYRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 88) (val' :: CDouble) #if ENABLE_OVERLOADING data EventTouchYRootFieldInfo instance AttrInfo EventTouchYRootFieldInfo where type AttrAllowedOps EventTouchYRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventTouchYRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventTouchYRootFieldInfo = (~) EventTouch type AttrGetType EventTouchYRootFieldInfo = Double type AttrLabel EventTouchYRootFieldInfo = "y_root" type AttrOrigin EventTouchYRootFieldInfo = EventTouch attrGet _ = getEventTouchYRoot attrSet _ = setEventTouchYRoot attrConstruct = undefined attrClear _ = undefined eventTouch_yRoot :: AttrLabelProxy "yRoot" eventTouch_yRoot = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList EventTouch type instance O.AttributeList EventTouch = EventTouchAttributeList type EventTouchAttributeList = ('[ '("type", EventTouchTypeFieldInfo), '("window", EventTouchWindowFieldInfo), '("sendEvent", EventTouchSendEventFieldInfo), '("time", EventTouchTimeFieldInfo), '("x", EventTouchXFieldInfo), '("y", EventTouchYFieldInfo), '("axes", EventTouchAxesFieldInfo), '("state", EventTouchStateFieldInfo), '("sequence", EventTouchSequenceFieldInfo), '("emulatingPointer", EventTouchEmulatingPointerFieldInfo), '("device", EventTouchDeviceFieldInfo), '("xRoot", EventTouchXRootFieldInfo), '("yRoot", EventTouchYRootFieldInfo)] :: [(Symbol, *)]) #endif #if ENABLE_OVERLOADING type family ResolveEventTouchMethod (t :: Symbol) (o :: *) :: * where ResolveEventTouchMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveEventTouchMethod t EventTouch, O.MethodInfo info EventTouch p) => OL.IsLabel t (EventTouch -> 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