{- | 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 button press and button release events. The /@type@/ field will be one of 'GI.Gdk.Enums.EventTypeButtonPress', 'GI.Gdk.Enums.EventType2buttonPress', 'GI.Gdk.Enums.EventType3buttonPress' or 'GI.Gdk.Enums.EventTypeButtonRelease', Double and triple-clicks result in a sequence of events being received. For double-clicks the order of events will be: * 'GI.Gdk.Enums.EventTypeButtonPress' * 'GI.Gdk.Enums.EventTypeButtonRelease' * 'GI.Gdk.Enums.EventTypeButtonPress' * 'GI.Gdk.Enums.EventType2buttonPress' * 'GI.Gdk.Enums.EventTypeButtonRelease' Note that the first click is received just like a normal button press, while the second click results in a 'GI.Gdk.Enums.EventType2buttonPress' being received just after the 'GI.Gdk.Enums.EventTypeButtonPress'. Triple-clicks are very similar to double-clicks, except that 'GI.Gdk.Enums.EventType3buttonPress' is inserted after the third click. The order of the events is: * 'GI.Gdk.Enums.EventTypeButtonPress' * 'GI.Gdk.Enums.EventTypeButtonRelease' * 'GI.Gdk.Enums.EventTypeButtonPress' * 'GI.Gdk.Enums.EventType2buttonPress' * 'GI.Gdk.Enums.EventTypeButtonRelease' * 'GI.Gdk.Enums.EventTypeButtonPress' * 'GI.Gdk.Enums.EventType3buttonPress' * 'GI.Gdk.Enums.EventTypeButtonRelease' For a double click to occur, the second button press must occur within 1\/4 of a second of the first. For a triple click to occur, the third button press must also occur within 1\/2 second of the first button press. -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gdk.Structs.EventButton ( -- * Exported types EventButton(..) , newZeroEventButton , noEventButton , -- * Properties -- ** axes #attr:axes# {- | /@x@/, /@y@/ translated to the axes of /@device@/, or 'Nothing' if /@device@/ is the mouse. -} #if ENABLE_OVERLOADING eventButton_axes , #endif getEventButtonAxes , setEventButtonAxes , -- ** button #attr:button# {- | the button which was pressed or released, numbered from 1 to 5. Normally button 1 is the left mouse button, 2 is the middle button, and 3 is the right button. On 2-button mice, the middle button can often be simulated by pressing both mouse buttons together. -} #if ENABLE_OVERLOADING eventButton_button , #endif getEventButtonButton , setEventButtonButton , -- ** device #attr:device# {- | the master device that the event originated from. Use 'GI.Gdk.Unions.Event.eventGetSourceDevice' to get the slave device. -} clearEventButtonDevice , #if ENABLE_OVERLOADING eventButton_device , #endif getEventButtonDevice , setEventButtonDevice , -- ** sendEvent #attr:sendEvent# {- | 'True' if the event was sent explicitly. -} #if ENABLE_OVERLOADING eventButton_sendEvent , #endif getEventButtonSendEvent , setEventButtonSendEvent , -- ** 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 eventButton_state , #endif getEventButtonState , setEventButtonState , -- ** time #attr:time# {- | the time of the event in milliseconds. -} #if ENABLE_OVERLOADING eventButton_time , #endif getEventButtonTime , setEventButtonTime , -- ** type #attr:type# {- | the type of the event ('GI.Gdk.Enums.EventTypeButtonPress', 'GI.Gdk.Enums.EventType2buttonPress', 'GI.Gdk.Enums.EventType3buttonPress' or 'GI.Gdk.Enums.EventTypeButtonRelease'). -} #if ENABLE_OVERLOADING eventButton_type , #endif getEventButtonType , setEventButtonType , -- ** window #attr:window# {- | the window which received the event. -} clearEventButtonWindow , #if ENABLE_OVERLOADING eventButton_window , #endif getEventButtonWindow , setEventButtonWindow , -- ** x #attr:x# {- | the x coordinate of the pointer relative to the window. -} #if ENABLE_OVERLOADING eventButton_x , #endif getEventButtonX , setEventButtonX , -- ** xRoot #attr:xRoot# {- | the x coordinate of the pointer relative to the root of the screen. -} #if ENABLE_OVERLOADING eventButton_xRoot , #endif getEventButtonXRoot , setEventButtonXRoot , -- ** y #attr:y# {- | the y coordinate of the pointer relative to the window. -} #if ENABLE_OVERLOADING eventButton_y , #endif getEventButtonY , setEventButtonY , -- ** yRoot #attr:yRoot# {- | the y coordinate of the pointer relative to the root of the screen. -} #if ENABLE_OVERLOADING eventButton_yRoot , #endif getEventButtonYRoot , setEventButtonYRoot , ) 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 -- | Memory-managed wrapper type. newtype EventButton = EventButton (ManagedPtr EventButton) instance WrappedPtr EventButton where wrappedPtrCalloc = callocBytes 80 wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 80 >=> wrapPtr EventButton) wrappedPtrFree = Just ptr_to_g_free -- | Construct a `EventButton` struct initialized to zero. newZeroEventButton :: MonadIO m => m EventButton newZeroEventButton = liftIO $ wrappedPtrCalloc >>= wrapPtr EventButton instance tag ~ 'AttrSet => Constructible EventButton tag where new _ attrs = do o <- newZeroEventButton GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `EventButton`. noEventButton :: Maybe EventButton noEventButton = Nothing {- | Get the value of the “@type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #type @ -} getEventButtonType :: MonadIO m => EventButton -> m Gdk.Enums.EventType getEventButtonType 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' eventButton [ #type 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonType :: MonadIO m => EventButton -> Gdk.Enums.EventType -> m () setEventButtonType s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = (fromIntegral . fromEnum) val poke (ptr `plusPtr` 0) (val' :: CInt) #if ENABLE_OVERLOADING data EventButtonTypeFieldInfo instance AttrInfo EventButtonTypeFieldInfo where type AttrAllowedOps EventButtonTypeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonTypeFieldInfo = (~) Gdk.Enums.EventType type AttrBaseTypeConstraint EventButtonTypeFieldInfo = (~) EventButton type AttrGetType EventButtonTypeFieldInfo = Gdk.Enums.EventType type AttrLabel EventButtonTypeFieldInfo = "type" type AttrOrigin EventButtonTypeFieldInfo = EventButton attrGet _ = getEventButtonType attrSet _ = setEventButtonType attrConstruct = undefined attrClear _ = undefined eventButton_type :: AttrLabelProxy "type" eventButton_type = AttrLabelProxy #endif {- | Get the value of the “@window@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #window @ -} getEventButtonWindow :: MonadIO m => EventButton -> m (Maybe Gdk.Window.Window) getEventButtonWindow 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' eventButton [ #window 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonWindow :: MonadIO m => EventButton -> Ptr Gdk.Window.Window -> m () setEventButtonWindow 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 @ -} clearEventButtonWindow :: MonadIO m => EventButton -> m () clearEventButtonWindow s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr Gdk.Window.Window) #if ENABLE_OVERLOADING data EventButtonWindowFieldInfo instance AttrInfo EventButtonWindowFieldInfo where type AttrAllowedOps EventButtonWindowFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventButtonWindowFieldInfo = (~) (Ptr Gdk.Window.Window) type AttrBaseTypeConstraint EventButtonWindowFieldInfo = (~) EventButton type AttrGetType EventButtonWindowFieldInfo = Maybe Gdk.Window.Window type AttrLabel EventButtonWindowFieldInfo = "window" type AttrOrigin EventButtonWindowFieldInfo = EventButton attrGet _ = getEventButtonWindow attrSet _ = setEventButtonWindow attrConstruct = undefined attrClear _ = clearEventButtonWindow eventButton_window :: AttrLabelProxy "window" eventButton_window = AttrLabelProxy #endif {- | Get the value of the “@send_event@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #sendEvent @ -} getEventButtonSendEvent :: MonadIO m => EventButton -> m Int8 getEventButtonSendEvent 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' eventButton [ #sendEvent 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonSendEvent :: MonadIO m => EventButton -> Int8 -> m () setEventButtonSendEvent s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 16) (val :: Int8) #if ENABLE_OVERLOADING data EventButtonSendEventFieldInfo instance AttrInfo EventButtonSendEventFieldInfo where type AttrAllowedOps EventButtonSendEventFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonSendEventFieldInfo = (~) Int8 type AttrBaseTypeConstraint EventButtonSendEventFieldInfo = (~) EventButton type AttrGetType EventButtonSendEventFieldInfo = Int8 type AttrLabel EventButtonSendEventFieldInfo = "send_event" type AttrOrigin EventButtonSendEventFieldInfo = EventButton attrGet _ = getEventButtonSendEvent attrSet _ = setEventButtonSendEvent attrConstruct = undefined attrClear _ = undefined eventButton_sendEvent :: AttrLabelProxy "sendEvent" eventButton_sendEvent = AttrLabelProxy #endif {- | Get the value of the “@time@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #time @ -} getEventButtonTime :: MonadIO m => EventButton -> m Word32 getEventButtonTime 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' eventButton [ #time 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonTime :: MonadIO m => EventButton -> Word32 -> m () setEventButtonTime s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 20) (val :: Word32) #if ENABLE_OVERLOADING data EventButtonTimeFieldInfo instance AttrInfo EventButtonTimeFieldInfo where type AttrAllowedOps EventButtonTimeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonTimeFieldInfo = (~) Word32 type AttrBaseTypeConstraint EventButtonTimeFieldInfo = (~) EventButton type AttrGetType EventButtonTimeFieldInfo = Word32 type AttrLabel EventButtonTimeFieldInfo = "time" type AttrOrigin EventButtonTimeFieldInfo = EventButton attrGet _ = getEventButtonTime attrSet _ = setEventButtonTime attrConstruct = undefined attrClear _ = undefined eventButton_time :: AttrLabelProxy "time" eventButton_time = AttrLabelProxy #endif {- | Get the value of the “@x@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #x @ -} getEventButtonX :: MonadIO m => EventButton -> m Double getEventButtonX 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' eventButton [ #x 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonX :: MonadIO m => EventButton -> Double -> m () setEventButtonX s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 24) (val' :: CDouble) #if ENABLE_OVERLOADING data EventButtonXFieldInfo instance AttrInfo EventButtonXFieldInfo where type AttrAllowedOps EventButtonXFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonXFieldInfo = (~) Double type AttrBaseTypeConstraint EventButtonXFieldInfo = (~) EventButton type AttrGetType EventButtonXFieldInfo = Double type AttrLabel EventButtonXFieldInfo = "x" type AttrOrigin EventButtonXFieldInfo = EventButton attrGet _ = getEventButtonX attrSet _ = setEventButtonX attrConstruct = undefined attrClear _ = undefined eventButton_x :: AttrLabelProxy "x" eventButton_x = AttrLabelProxy #endif {- | Get the value of the “@y@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #y @ -} getEventButtonY :: MonadIO m => EventButton -> m Double getEventButtonY 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' eventButton [ #y 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonY :: MonadIO m => EventButton -> Double -> m () setEventButtonY s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 32) (val' :: CDouble) #if ENABLE_OVERLOADING data EventButtonYFieldInfo instance AttrInfo EventButtonYFieldInfo where type AttrAllowedOps EventButtonYFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonYFieldInfo = (~) Double type AttrBaseTypeConstraint EventButtonYFieldInfo = (~) EventButton type AttrGetType EventButtonYFieldInfo = Double type AttrLabel EventButtonYFieldInfo = "y" type AttrOrigin EventButtonYFieldInfo = EventButton attrGet _ = getEventButtonY attrSet _ = setEventButtonY attrConstruct = undefined attrClear _ = undefined eventButton_y :: AttrLabelProxy "y" eventButton_y = AttrLabelProxy #endif {- | Get the value of the “@axes@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #axes @ -} getEventButtonAxes :: MonadIO m => EventButton -> m Double getEventButtonAxes 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' eventButton [ #axes 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonAxes :: MonadIO m => EventButton -> Double -> m () setEventButtonAxes s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 40) (val' :: CDouble) #if ENABLE_OVERLOADING data EventButtonAxesFieldInfo instance AttrInfo EventButtonAxesFieldInfo where type AttrAllowedOps EventButtonAxesFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonAxesFieldInfo = (~) Double type AttrBaseTypeConstraint EventButtonAxesFieldInfo = (~) EventButton type AttrGetType EventButtonAxesFieldInfo = Double type AttrLabel EventButtonAxesFieldInfo = "axes" type AttrOrigin EventButtonAxesFieldInfo = EventButton attrGet _ = getEventButtonAxes attrSet _ = setEventButtonAxes attrConstruct = undefined attrClear _ = undefined eventButton_axes :: AttrLabelProxy "axes" eventButton_axes = AttrLabelProxy #endif {- | Get the value of the “@state@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #state @ -} getEventButtonState :: MonadIO m => EventButton -> m [Gdk.Flags.ModifierType] getEventButtonState 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' eventButton [ #state 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonState :: MonadIO m => EventButton -> [Gdk.Flags.ModifierType] -> m () setEventButtonState s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = gflagsToWord val poke (ptr `plusPtr` 48) (val' :: CUInt) #if ENABLE_OVERLOADING data EventButtonStateFieldInfo instance AttrInfo EventButtonStateFieldInfo where type AttrAllowedOps EventButtonStateFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonStateFieldInfo = (~) [Gdk.Flags.ModifierType] type AttrBaseTypeConstraint EventButtonStateFieldInfo = (~) EventButton type AttrGetType EventButtonStateFieldInfo = [Gdk.Flags.ModifierType] type AttrLabel EventButtonStateFieldInfo = "state" type AttrOrigin EventButtonStateFieldInfo = EventButton attrGet _ = getEventButtonState attrSet _ = setEventButtonState attrConstruct = undefined attrClear _ = undefined eventButton_state :: AttrLabelProxy "state" eventButton_state = AttrLabelProxy #endif {- | Get the value of the “@button@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #button @ -} getEventButtonButton :: MonadIO m => EventButton -> m Word32 getEventButtonButton s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 52) :: IO Word32 return val {- | Set the value of the “@button@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' eventButton [ #button 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonButton :: MonadIO m => EventButton -> Word32 -> m () setEventButtonButton s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 52) (val :: Word32) #if ENABLE_OVERLOADING data EventButtonButtonFieldInfo instance AttrInfo EventButtonButtonFieldInfo where type AttrAllowedOps EventButtonButtonFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonButtonFieldInfo = (~) Word32 type AttrBaseTypeConstraint EventButtonButtonFieldInfo = (~) EventButton type AttrGetType EventButtonButtonFieldInfo = Word32 type AttrLabel EventButtonButtonFieldInfo = "button" type AttrOrigin EventButtonButtonFieldInfo = EventButton attrGet _ = getEventButtonButton attrSet _ = setEventButtonButton attrConstruct = undefined attrClear _ = undefined eventButton_button :: AttrLabelProxy "button" eventButton_button = AttrLabelProxy #endif {- | Get the value of the “@device@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #device @ -} getEventButtonDevice :: MonadIO m => EventButton -> m (Maybe Gdk.Device.Device) getEventButtonDevice s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 56) :: 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' eventButton [ #device 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonDevice :: MonadIO m => EventButton -> Ptr Gdk.Device.Device -> m () setEventButtonDevice s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 56) (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 @ -} clearEventButtonDevice :: MonadIO m => EventButton -> m () clearEventButtonDevice s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 56) (FP.nullPtr :: Ptr Gdk.Device.Device) #if ENABLE_OVERLOADING data EventButtonDeviceFieldInfo instance AttrInfo EventButtonDeviceFieldInfo where type AttrAllowedOps EventButtonDeviceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint EventButtonDeviceFieldInfo = (~) (Ptr Gdk.Device.Device) type AttrBaseTypeConstraint EventButtonDeviceFieldInfo = (~) EventButton type AttrGetType EventButtonDeviceFieldInfo = Maybe Gdk.Device.Device type AttrLabel EventButtonDeviceFieldInfo = "device" type AttrOrigin EventButtonDeviceFieldInfo = EventButton attrGet _ = getEventButtonDevice attrSet _ = setEventButtonDevice attrConstruct = undefined attrClear _ = clearEventButtonDevice eventButton_device :: AttrLabelProxy "device" eventButton_device = AttrLabelProxy #endif {- | Get the value of the “@x_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #xRoot @ -} getEventButtonXRoot :: MonadIO m => EventButton -> m Double getEventButtonXRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: 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' eventButton [ #xRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonXRoot :: MonadIO m => EventButton -> Double -> m () setEventButtonXRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 64) (val' :: CDouble) #if ENABLE_OVERLOADING data EventButtonXRootFieldInfo instance AttrInfo EventButtonXRootFieldInfo where type AttrAllowedOps EventButtonXRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonXRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventButtonXRootFieldInfo = (~) EventButton type AttrGetType EventButtonXRootFieldInfo = Double type AttrLabel EventButtonXRootFieldInfo = "x_root" type AttrOrigin EventButtonXRootFieldInfo = EventButton attrGet _ = getEventButtonXRoot attrSet _ = setEventButtonXRoot attrConstruct = undefined attrClear _ = undefined eventButton_xRoot :: AttrLabelProxy "xRoot" eventButton_xRoot = AttrLabelProxy #endif {- | Get the value of the “@y_root@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' eventButton #yRoot @ -} getEventButtonYRoot :: MonadIO m => EventButton -> m Double getEventButtonYRoot s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 72) :: 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' eventButton [ #yRoot 'Data.GI.Base.Attributes.:=' value ] @ -} setEventButtonYRoot :: MonadIO m => EventButton -> Double -> m () setEventButtonYRoot s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = realToFrac val poke (ptr `plusPtr` 72) (val' :: CDouble) #if ENABLE_OVERLOADING data EventButtonYRootFieldInfo instance AttrInfo EventButtonYRootFieldInfo where type AttrAllowedOps EventButtonYRootFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint EventButtonYRootFieldInfo = (~) Double type AttrBaseTypeConstraint EventButtonYRootFieldInfo = (~) EventButton type AttrGetType EventButtonYRootFieldInfo = Double type AttrLabel EventButtonYRootFieldInfo = "y_root" type AttrOrigin EventButtonYRootFieldInfo = EventButton attrGet _ = getEventButtonYRoot attrSet _ = setEventButtonYRoot attrConstruct = undefined attrClear _ = undefined eventButton_yRoot :: AttrLabelProxy "yRoot" eventButton_yRoot = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList EventButton type instance O.AttributeList EventButton = EventButtonAttributeList type EventButtonAttributeList = ('[ '("type", EventButtonTypeFieldInfo), '("window", EventButtonWindowFieldInfo), '("sendEvent", EventButtonSendEventFieldInfo), '("time", EventButtonTimeFieldInfo), '("x", EventButtonXFieldInfo), '("y", EventButtonYFieldInfo), '("axes", EventButtonAxesFieldInfo), '("state", EventButtonStateFieldInfo), '("button", EventButtonButtonFieldInfo), '("device", EventButtonDeviceFieldInfo), '("xRoot", EventButtonXRootFieldInfo), '("yRoot", EventButtonYRootFieldInfo)] :: [(Symbol, *)]) #endif #if ENABLE_OVERLOADING type family ResolveEventButtonMethod (t :: Symbol) (o :: *) :: * where ResolveEventButtonMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveEventButtonMethod t EventButton, O.MethodInfo info EventButton p) => OL.IsLabel t (EventButton -> 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