{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The GdkEvent struct contains only private fields and
-- should not be accessed directly.

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

module GI.Gdk.Objects.Event
    ( 

-- * Exported types
    Event(..)                               ,
    IsEvent                                 ,
    toEvent                                 ,
    noEvent                                 ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveEventMethod                      ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    EventCopyMethodInfo                     ,
#endif
    eventCopy                               ,


-- ** getAxes #method:getAxes#

#if defined(ENABLE_OVERLOADING)
    EventGetAxesMethodInfo                  ,
#endif
    eventGetAxes                            ,


-- ** getAxis #method:getAxis#

#if defined(ENABLE_OVERLOADING)
    EventGetAxisMethodInfo                  ,
#endif
    eventGetAxis                            ,


-- ** getButton #method:getButton#

#if defined(ENABLE_OVERLOADING)
    EventGetButtonMethodInfo                ,
#endif
    eventGetButton                          ,


-- ** getClickCount #method:getClickCount#

#if defined(ENABLE_OVERLOADING)
    EventGetClickCountMethodInfo            ,
#endif
    eventGetClickCount                      ,


-- ** getCoords #method:getCoords#

#if defined(ENABLE_OVERLOADING)
    EventGetCoordsMethodInfo                ,
#endif
    eventGetCoords                          ,


-- ** getCrossingDetail #method:getCrossingDetail#

#if defined(ENABLE_OVERLOADING)
    EventGetCrossingDetailMethodInfo        ,
#endif
    eventGetCrossingDetail                  ,


-- ** getCrossingMode #method:getCrossingMode#

#if defined(ENABLE_OVERLOADING)
    EventGetCrossingModeMethodInfo          ,
#endif
    eventGetCrossingMode                    ,


-- ** getDevice #method:getDevice#

#if defined(ENABLE_OVERLOADING)
    EventGetDeviceMethodInfo                ,
#endif
    eventGetDevice                          ,


-- ** getDeviceTool #method:getDeviceTool#

#if defined(ENABLE_OVERLOADING)
    EventGetDeviceToolMethodInfo            ,
#endif
    eventGetDeviceTool                      ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    EventGetDisplayMethodInfo               ,
#endif
    eventGetDisplay                         ,


-- ** getDrop #method:getDrop#

#if defined(ENABLE_OVERLOADING)
    EventGetDropMethodInfo                  ,
#endif
    eventGetDrop                            ,


-- ** getEventSequence #method:getEventSequence#

#if defined(ENABLE_OVERLOADING)
    EventGetEventSequenceMethodInfo         ,
#endif
    eventGetEventSequence                   ,


-- ** getEventType #method:getEventType#

#if defined(ENABLE_OVERLOADING)
    EventGetEventTypeMethodInfo             ,
#endif
    eventGetEventType                       ,


-- ** getFocusIn #method:getFocusIn#

#if defined(ENABLE_OVERLOADING)
    EventGetFocusInMethodInfo               ,
#endif
    eventGetFocusIn                         ,


-- ** getGrabSurface #method:getGrabSurface#

#if defined(ENABLE_OVERLOADING)
    EventGetGrabSurfaceMethodInfo           ,
#endif
    eventGetGrabSurface                     ,


-- ** getKeyGroup #method:getKeyGroup#

#if defined(ENABLE_OVERLOADING)
    EventGetKeyGroupMethodInfo              ,
#endif
    eventGetKeyGroup                        ,


-- ** getKeyIsModifier #method:getKeyIsModifier#

#if defined(ENABLE_OVERLOADING)
    EventGetKeyIsModifierMethodInfo         ,
#endif
    eventGetKeyIsModifier                   ,


-- ** getKeycode #method:getKeycode#

#if defined(ENABLE_OVERLOADING)
    EventGetKeycodeMethodInfo               ,
#endif
    eventGetKeycode                         ,


-- ** getKeyval #method:getKeyval#

#if defined(ENABLE_OVERLOADING)
    EventGetKeyvalMethodInfo                ,
#endif
    eventGetKeyval                          ,


-- ** getMotionHistory #method:getMotionHistory#

#if defined(ENABLE_OVERLOADING)
    EventGetMotionHistoryMethodInfo         ,
#endif
    eventGetMotionHistory                   ,


-- ** getPadAxisValue #method:getPadAxisValue#

#if defined(ENABLE_OVERLOADING)
    EventGetPadAxisValueMethodInfo          ,
#endif
    eventGetPadAxisValue                    ,


-- ** getPadButton #method:getPadButton#

#if defined(ENABLE_OVERLOADING)
    EventGetPadButtonMethodInfo             ,
#endif
    eventGetPadButton                       ,


-- ** getPadGroupMode #method:getPadGroupMode#

#if defined(ENABLE_OVERLOADING)
    EventGetPadGroupModeMethodInfo          ,
#endif
    eventGetPadGroupMode                    ,


-- ** getPointerEmulated #method:getPointerEmulated#

#if defined(ENABLE_OVERLOADING)
    EventGetPointerEmulatedMethodInfo       ,
#endif
    eventGetPointerEmulated                 ,


-- ** getRootCoords #method:getRootCoords#

#if defined(ENABLE_OVERLOADING)
    EventGetRootCoordsMethodInfo            ,
#endif
    eventGetRootCoords                      ,


-- ** getScancode #method:getScancode#

#if defined(ENABLE_OVERLOADING)
    EventGetScancodeMethodInfo              ,
#endif
    eventGetScancode                        ,


-- ** getScrollDeltas #method:getScrollDeltas#

#if defined(ENABLE_OVERLOADING)
    EventGetScrollDeltasMethodInfo          ,
#endif
    eventGetScrollDeltas                    ,


-- ** getScrollDirection #method:getScrollDirection#

#if defined(ENABLE_OVERLOADING)
    EventGetScrollDirectionMethodInfo       ,
#endif
    eventGetScrollDirection                 ,


-- ** getSeat #method:getSeat#

#if defined(ENABLE_OVERLOADING)
    EventGetSeatMethodInfo                  ,
#endif
    eventGetSeat                            ,


-- ** getSourceDevice #method:getSourceDevice#

#if defined(ENABLE_OVERLOADING)
    EventGetSourceDeviceMethodInfo          ,
#endif
    eventGetSourceDevice                    ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    EventGetStateMethodInfo                 ,
#endif
    eventGetState                           ,


-- ** getSurface #method:getSurface#

#if defined(ENABLE_OVERLOADING)
    EventGetSurfaceMethodInfo               ,
#endif
    eventGetSurface                         ,


-- ** getTime #method:getTime#

#if defined(ENABLE_OVERLOADING)
    EventGetTimeMethodInfo                  ,
#endif
    eventGetTime                            ,


-- ** getTouchEmulatingPointer #method:getTouchEmulatingPointer#

#if defined(ENABLE_OVERLOADING)
    EventGetTouchEmulatingPointerMethodInfo ,
#endif
    eventGetTouchEmulatingPointer           ,


-- ** getTouchpadAngleDelta #method:getTouchpadAngleDelta#

#if defined(ENABLE_OVERLOADING)
    EventGetTouchpadAngleDeltaMethodInfo    ,
#endif
    eventGetTouchpadAngleDelta              ,


-- ** getTouchpadDeltas #method:getTouchpadDeltas#

#if defined(ENABLE_OVERLOADING)
    EventGetTouchpadDeltasMethodInfo        ,
#endif
    eventGetTouchpadDeltas                  ,


-- ** getTouchpadGestureNFingers #method:getTouchpadGestureNFingers#

#if defined(ENABLE_OVERLOADING)
    EventGetTouchpadGestureNFingersMethodInfo,
#endif
    eventGetTouchpadGestureNFingers         ,


-- ** getTouchpadGesturePhase #method:getTouchpadGesturePhase#

#if defined(ENABLE_OVERLOADING)
    EventGetTouchpadGesturePhaseMethodInfo  ,
#endif
    eventGetTouchpadGesturePhase            ,


-- ** getTouchpadScale #method:getTouchpadScale#

#if defined(ENABLE_OVERLOADING)
    EventGetTouchpadScaleMethodInfo         ,
#endif
    eventGetTouchpadScale                   ,


-- ** isScrollStopEvent #method:isScrollStopEvent#

#if defined(ENABLE_OVERLOADING)
    EventIsScrollStopEventMethodInfo        ,
#endif
    eventIsScrollStopEvent                  ,


-- ** isSent #method:isSent#

#if defined(ENABLE_OVERLOADING)
    EventIsSentMethodInfo                   ,
#endif
    eventIsSent                             ,


-- ** new #method:new#

    eventNew                                ,


-- ** setCoords #method:setCoords#

#if defined(ENABLE_OVERLOADING)
    EventSetCoordsMethodInfo                ,
#endif
    eventSetCoords                          ,


-- ** setDevice #method:setDevice#

#if defined(ENABLE_OVERLOADING)
    EventSetDeviceMethodInfo                ,
#endif
    eventSetDevice                          ,


-- ** setDeviceTool #method:setDeviceTool#

#if defined(ENABLE_OVERLOADING)
    EventSetDeviceToolMethodInfo            ,
#endif
    eventSetDeviceTool                      ,


-- ** setDisplay #method:setDisplay#

#if defined(ENABLE_OVERLOADING)
    EventSetDisplayMethodInfo               ,
#endif
    eventSetDisplay                         ,


-- ** setKeyval #method:setKeyval#

#if defined(ENABLE_OVERLOADING)
    EventSetKeyvalMethodInfo                ,
#endif
    eventSetKeyval                          ,


-- ** setSourceDevice #method:setSourceDevice#

#if defined(ENABLE_OVERLOADING)
    EventSetSourceDeviceMethodInfo          ,
#endif
    eventSetSourceDevice                    ,


-- ** triggersContextMenu #method:triggersContextMenu#

#if defined(ENABLE_OVERLOADING)
    EventTriggersContextMenuMethodInfo      ,
#endif
    eventTriggersContextMenu                ,




 -- * Properties
-- ** eventType #attr:eventType#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    EventEventTypePropertyInfo              ,
#endif
    constructEventEventType                 ,
#if defined(ENABLE_OVERLOADING)
    eventEventType                          ,
#endif
    getEventEventType                       ,




    ) 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.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
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.DeviceTool as Gdk.DeviceTool
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Drop as Gdk.Drop
import {-# SOURCE #-} qualified GI.Gdk.Objects.Seat as Gdk.Seat
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Structs.EventSequence as Gdk.EventSequence
import {-# SOURCE #-} qualified GI.Gdk.Structs.TimeCoord as Gdk.TimeCoord

-- | Memory-managed wrapper type.
newtype Event = Event (ManagedPtr Event)
    deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)
foreign import ccall "gdk_event_get_type"
    c_gdk_event_get_type :: IO GType

instance GObject Event where
    gobjectType :: IO GType
gobjectType = IO GType
c_gdk_event_get_type
    

-- | Convert 'Event' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Event where
    toGValue :: Event -> IO GValue
toGValue o :: Event
o = do
        GType
gtype <- IO GType
c_gdk_event_get_type
        Event -> (Ptr Event -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Event
o (GType -> (GValue -> Ptr Event -> IO ()) -> Ptr Event -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Event -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Event
fromGValue gv :: GValue
gv = do
        Ptr Event
ptr <- GValue -> IO (Ptr Event)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Event)
        (ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Event -> Event
Event Ptr Event
ptr
        
    

-- | Type class for types which can be safely cast to `Event`, for instance with `toEvent`.
class (GObject o, O.IsDescendantOf Event o) => IsEvent o
instance (GObject o, O.IsDescendantOf Event o) => IsEvent o

instance O.HasParentTypes Event
type instance O.ParentTypes Event = '[GObject.Object.Object]

-- | Cast to `Event`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toEvent :: (MonadIO m, IsEvent o) => o -> m Event
toEvent :: o -> m Event
toEvent = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> (o -> IO Event) -> o -> m Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Event -> Event) -> o -> IO Event
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Event -> Event
Event

-- | A convenience alias for `Nothing` :: `Maybe` `Event`.
noEvent :: Maybe Event
noEvent :: Maybe Event
noEvent = Maybe Event
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveEventMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEventMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEventMethod "copy" o = EventCopyMethodInfo
    ResolveEventMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEventMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEventMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEventMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEventMethod "isScrollStopEvent" o = EventIsScrollStopEventMethodInfo
    ResolveEventMethod "isSent" o = EventIsSentMethodInfo
    ResolveEventMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEventMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEventMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEventMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEventMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEventMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEventMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEventMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEventMethod "triggersContextMenu" o = EventTriggersContextMenuMethodInfo
    ResolveEventMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEventMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEventMethod "getAxes" o = EventGetAxesMethodInfo
    ResolveEventMethod "getAxis" o = EventGetAxisMethodInfo
    ResolveEventMethod "getButton" o = EventGetButtonMethodInfo
    ResolveEventMethod "getClickCount" o = EventGetClickCountMethodInfo
    ResolveEventMethod "getCoords" o = EventGetCoordsMethodInfo
    ResolveEventMethod "getCrossingDetail" o = EventGetCrossingDetailMethodInfo
    ResolveEventMethod "getCrossingMode" o = EventGetCrossingModeMethodInfo
    ResolveEventMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEventMethod "getDevice" o = EventGetDeviceMethodInfo
    ResolveEventMethod "getDeviceTool" o = EventGetDeviceToolMethodInfo
    ResolveEventMethod "getDisplay" o = EventGetDisplayMethodInfo
    ResolveEventMethod "getDrop" o = EventGetDropMethodInfo
    ResolveEventMethod "getEventSequence" o = EventGetEventSequenceMethodInfo
    ResolveEventMethod "getEventType" o = EventGetEventTypeMethodInfo
    ResolveEventMethod "getFocusIn" o = EventGetFocusInMethodInfo
    ResolveEventMethod "getGrabSurface" o = EventGetGrabSurfaceMethodInfo
    ResolveEventMethod "getKeyGroup" o = EventGetKeyGroupMethodInfo
    ResolveEventMethod "getKeyIsModifier" o = EventGetKeyIsModifierMethodInfo
    ResolveEventMethod "getKeycode" o = EventGetKeycodeMethodInfo
    ResolveEventMethod "getKeyval" o = EventGetKeyvalMethodInfo
    ResolveEventMethod "getMotionHistory" o = EventGetMotionHistoryMethodInfo
    ResolveEventMethod "getPadAxisValue" o = EventGetPadAxisValueMethodInfo
    ResolveEventMethod "getPadButton" o = EventGetPadButtonMethodInfo
    ResolveEventMethod "getPadGroupMode" o = EventGetPadGroupModeMethodInfo
    ResolveEventMethod "getPointerEmulated" o = EventGetPointerEmulatedMethodInfo
    ResolveEventMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEventMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEventMethod "getRootCoords" o = EventGetRootCoordsMethodInfo
    ResolveEventMethod "getScancode" o = EventGetScancodeMethodInfo
    ResolveEventMethod "getScrollDeltas" o = EventGetScrollDeltasMethodInfo
    ResolveEventMethod "getScrollDirection" o = EventGetScrollDirectionMethodInfo
    ResolveEventMethod "getSeat" o = EventGetSeatMethodInfo
    ResolveEventMethod "getSourceDevice" o = EventGetSourceDeviceMethodInfo
    ResolveEventMethod "getState" o = EventGetStateMethodInfo
    ResolveEventMethod "getSurface" o = EventGetSurfaceMethodInfo
    ResolveEventMethod "getTime" o = EventGetTimeMethodInfo
    ResolveEventMethod "getTouchEmulatingPointer" o = EventGetTouchEmulatingPointerMethodInfo
    ResolveEventMethod "getTouchpadAngleDelta" o = EventGetTouchpadAngleDeltaMethodInfo
    ResolveEventMethod "getTouchpadDeltas" o = EventGetTouchpadDeltasMethodInfo
    ResolveEventMethod "getTouchpadGestureNFingers" o = EventGetTouchpadGestureNFingersMethodInfo
    ResolveEventMethod "getTouchpadGesturePhase" o = EventGetTouchpadGesturePhaseMethodInfo
    ResolveEventMethod "getTouchpadScale" o = EventGetTouchpadScaleMethodInfo
    ResolveEventMethod "setCoords" o = EventSetCoordsMethodInfo
    ResolveEventMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEventMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEventMethod "setDevice" o = EventSetDeviceMethodInfo
    ResolveEventMethod "setDeviceTool" o = EventSetDeviceToolMethodInfo
    ResolveEventMethod "setDisplay" o = EventSetDisplayMethodInfo
    ResolveEventMethod "setKeyval" o = EventSetKeyvalMethodInfo
    ResolveEventMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEventMethod "setSourceDevice" o = EventSetSourceDeviceMethodInfo
    ResolveEventMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveEventMethod t Event, O.MethodInfo info Event p) => OL.IsLabel t (Event -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- VVV Prop "event-type"
   -- Type: TInterface (Name {namespace = "Gdk", name = "EventType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@event-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' event #eventType
-- @
getEventEventType :: (MonadIO m, IsEvent o) => o -> m Gdk.Enums.EventType
getEventEventType :: o -> m EventType
getEventEventType obj :: o
obj = IO EventType -> m EventType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EventType -> m EventType) -> IO EventType -> m EventType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO EventType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "event-type"

-- | Construct a `GValueConstruct` with valid value for the “@event-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEventEventType :: (IsEvent o) => Gdk.Enums.EventType -> IO (GValueConstruct o)
constructEventEventType :: EventType -> IO (GValueConstruct o)
constructEventEventType val :: EventType
val = String -> EventType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "event-type" EventType
val

#if defined(ENABLE_OVERLOADING)
data EventEventTypePropertyInfo
instance AttrInfo EventEventTypePropertyInfo where
    type AttrAllowedOps EventEventTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EventEventTypePropertyInfo = IsEvent
    type AttrSetTypeConstraint EventEventTypePropertyInfo = (~) Gdk.Enums.EventType
    type AttrTransferTypeConstraint EventEventTypePropertyInfo = (~) Gdk.Enums.EventType
    type AttrTransferType EventEventTypePropertyInfo = Gdk.Enums.EventType
    type AttrGetType EventEventTypePropertyInfo = Gdk.Enums.EventType
    type AttrLabel EventEventTypePropertyInfo = "event-type"
    type AttrOrigin EventEventTypePropertyInfo = Event
    attrGet = getEventEventType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructEventEventType
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Event
type instance O.AttributeList Event = EventAttributeList
type EventAttributeList = ('[ '("eventType", EventEventTypePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
eventEventType :: AttrLabelProxy "eventType"
eventEventType = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Event = EventSignalList
type EventSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Event::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "EventType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEventType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Event" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_new" gdk_event_new :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Gdk", name = "EventType"})
    IO (Ptr Event)

-- | Creates a new event of the given type. All fields are set to 0.
eventNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gdk.Enums.EventType
    -- ^ /@type@/: a t'GI.Gdk.Enums.EventType'
    -> m Event
    -- ^ __Returns:__ a newly-allocated @/GdkEvent/@. Free with 'GI.GObject.Objects.Object.objectUnref'
eventNew :: EventType -> m Event
eventNew type_ :: EventType
type_ = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (EventType -> Int) -> EventType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventType -> Int
forall a. Enum a => a -> Int
fromEnum) EventType
type_
    Ptr Event
result <- CUInt -> IO (Ptr Event)
gdk_event_new CUInt
type_'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "eventNew" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Event::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Event" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_copy" gdk_event_copy :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Event)

-- | Copies a @/GdkEvent/@, copying or incrementing the reference count of the
-- resources associated with it (e.g. t'GI.Gdk.Objects.Surface.Surface'’s and strings).
eventCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Event
    -- ^ __Returns:__ a copy of /@event@/. Free with 'GI.GObject.Objects.Object.objectUnref'
eventCopy :: a -> m Event
eventCopy event :: a
event = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Event
result <- Ptr Event -> IO (Ptr Event)
gdk_event_copy Ptr Event
event'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "eventCopy" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Event -> Event
Event) Ptr Event
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(ENABLE_OVERLOADING)
data EventCopyMethodInfo
instance (signature ~ (m Event), MonadIO m, IsEvent a) => O.MethodInfo EventCopyMethodInfo a signature where
    overloadedMethod = eventCopy

#endif

-- method Event::get_axes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axes"
--           , argType = TCArray False (-1) 2 (TBasicType TDouble)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the array of values for all axes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_axes"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_axes"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_axes" gdk_event_get_axes :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr (Ptr CDouble) ->                    -- axes : TCArray False (-1) 2 (TBasicType TDouble)
    Ptr Word32 ->                           -- n_axes : TBasicType TUInt
    IO CInt

-- | Extracts all axis values from an event.
eventGetAxes ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, [Double]))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetAxes :: a -> m (Bool, [Double])
eventGetAxes event :: a
event = IO (Bool, [Double]) -> m (Bool, [Double])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [Double]) -> m (Bool, [Double]))
-> IO (Bool, [Double]) -> m (Bool, [Double])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr (Ptr CDouble)
axes <- IO (Ptr (Ptr CDouble))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr CDouble))
    Ptr Word32
nAxes <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr (Ptr CDouble) -> Ptr Word32 -> IO CInt
gdk_event_get_axes Ptr Event
event' Ptr (Ptr CDouble)
axes Ptr Word32
nAxes
    Word32
nAxes' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nAxes
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Ptr CDouble
axes' <- Ptr (Ptr CDouble) -> IO (Ptr CDouble)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CDouble)
axes
    [Double]
axes'' <- ((CDouble -> Double) -> Word32 -> Ptr CDouble -> IO [Double]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
nAxes') Ptr CDouble
axes'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr (Ptr CDouble) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CDouble)
axes
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nAxes
    (Bool, [Double]) -> IO (Bool, [Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [Double]
axes'')

#if defined(ENABLE_OVERLOADING)
data EventGetAxesMethodInfo
instance (signature ~ (m ((Bool, [Double]))), MonadIO m, IsEvent a) => O.MethodInfo EventGetAxesMethodInfo a signature where
    overloadedMethod = eventGetAxes

#endif

-- method Event::get_axis
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axis_use"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "AxisUse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the axis use to look for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the value found"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_axis" gdk_event_get_axis :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    CUInt ->                                -- axis_use : TInterface (Name {namespace = "Gdk", name = "AxisUse"})
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Extract the axis value for a particular axis use from
-- an event structure.
eventGetAxis ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> Gdk.Enums.AxisUse
    -- ^ /@axisUse@/: the axis use to look for
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if the specified axis was found, otherwise 'P.False'
eventGetAxis :: a -> AxisUse -> m (Bool, Double)
eventGetAxis event :: a
event axisUse :: AxisUse
axisUse = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    let axisUse' :: CUInt
axisUse' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (AxisUse -> Int) -> AxisUse -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AxisUse -> Int
forall a. Enum a => a -> Int
fromEnum) AxisUse
axisUse
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> CUInt -> Ptr CDouble -> IO CInt
gdk_event_get_axis Ptr Event
event' CUInt
axisUse' Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
value'')

#if defined(ENABLE_OVERLOADING)
data EventGetAxisMethodInfo
instance (signature ~ (Gdk.Enums.AxisUse -> m ((Bool, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetAxisMethodInfo a signature where
    overloadedMethod = eventGetAxis

#endif

-- method Event::get_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store mouse button number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_button" gdk_event_get_button :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- button : TBasicType TUInt
    IO CInt

-- | Extract the button number from an event.
eventGetButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the event delivered a button number
eventGetButton :: a -> m (Bool, Word32)
eventGetButton event :: a
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
button <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gdk_event_get_button Ptr Event
event' Ptr Word32
button
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
button' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
button
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
button
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
button')

#if defined(ENABLE_OVERLOADING)
data EventGetButtonMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetButtonMethodInfo a signature where
    overloadedMethod = eventGetButton

#endif

-- method Event::get_click_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "click_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store click count"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_click_count" gdk_event_get_click_count :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- click_count : TBasicType TUInt
    IO CInt

-- | Extracts the click count from an event.
eventGetClickCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the event delivered a click count
eventGetClickCount :: a -> m (Bool, Word32)
eventGetClickCount event :: a
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
clickCount <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gdk_event_get_click_count Ptr Event
event' Ptr Word32
clickCount
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
clickCount' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
clickCount
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
clickCount
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
clickCount')

#if defined(ENABLE_OVERLOADING)
data EventGetClickCountMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetClickCountMethodInfo a signature where
    overloadedMethod = eventGetClickCount

#endif

-- method Event::get_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_win"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to put event surface x coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_win"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to put event surface y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_coords" gdk_event_get_coords :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- x_win : TBasicType TDouble
    Ptr CDouble ->                          -- y_win : TBasicType TDouble
    IO CInt

-- | Extract the event surface relative x\/y coordinates from an event.
eventGetCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' if the event delivered event surface coordinates
eventGetCoords :: a -> m (Bool, Double, Double)
eventGetCoords event :: a
event = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CDouble
xWin <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
yWin <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> Ptr CDouble -> IO CInt
gdk_event_get_coords Ptr Event
event' Ptr CDouble
xWin Ptr CDouble
yWin
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
xWin' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xWin
    let xWin'' :: Double
xWin'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
xWin'
    CDouble
yWin' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
yWin
    let yWin'' :: Double
yWin'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
yWin'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
xWin
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
yWin
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
xWin'', Double
yWin'')

#if defined(ENABLE_OVERLOADING)
data EventGetCoordsMethodInfo
instance (signature ~ (m ((Bool, Double, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetCoordsMethodInfo a signature where
    overloadedMethod = eventGetCoords

#endif

-- method Event::get_crossing_detail
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detail"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "NotifyType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the crossing detail"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_crossing_detail" gdk_event_get_crossing_detail :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CUInt ->                            -- detail : TInterface (Name {namespace = "Gdk", name = "NotifyType"})
    IO CInt

-- | Extracts the crossing detail from an event.
eventGetCrossingDetail ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Gdk.Enums.NotifyType))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetCrossingDetail :: a -> m (Bool, NotifyType)
eventGetCrossingDetail event :: a
event = IO (Bool, NotifyType) -> m (Bool, NotifyType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, NotifyType) -> m (Bool, NotifyType))
-> IO (Bool, NotifyType) -> m (Bool, NotifyType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CUInt
detail <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Event -> Ptr CUInt -> IO CInt
gdk_event_get_crossing_detail Ptr Event
event' Ptr CUInt
detail
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CUInt
detail' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
detail
    let detail'' :: NotifyType
detail'' = (Int -> NotifyType
forall a. Enum a => Int -> a
toEnum (Int -> NotifyType) -> (CUInt -> Int) -> CUInt -> NotifyType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
detail'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
detail
    (Bool, NotifyType) -> IO (Bool, NotifyType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', NotifyType
detail'')

#if defined(ENABLE_OVERLOADING)
data EventGetCrossingDetailMethodInfo
instance (signature ~ (m ((Bool, Gdk.Enums.NotifyType))), MonadIO m, IsEvent a) => O.MethodInfo EventGetCrossingDetailMethodInfo a signature where
    overloadedMethod = eventGetCrossingDetail

#endif

-- method Event::get_crossing_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "CrossingMode" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the crossing mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_crossing_mode" gdk_event_get_crossing_mode :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CUInt ->                            -- mode : TInterface (Name {namespace = "Gdk", name = "CrossingMode"})
    IO CInt

-- | Extracts the crossing mode from an event.
eventGetCrossingMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Gdk.Enums.CrossingMode))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetCrossingMode :: a -> m (Bool, CrossingMode)
eventGetCrossingMode event :: a
event = IO (Bool, CrossingMode) -> m (Bool, CrossingMode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, CrossingMode) -> m (Bool, CrossingMode))
-> IO (Bool, CrossingMode) -> m (Bool, CrossingMode)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CUInt
mode <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Event -> Ptr CUInt -> IO CInt
gdk_event_get_crossing_mode Ptr Event
event' Ptr CUInt
mode
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CUInt
mode' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
mode
    let mode'' :: CrossingMode
mode'' = (Int -> CrossingMode
forall a. Enum a => Int -> a
toEnum (Int -> CrossingMode) -> (CUInt -> Int) -> CUInt -> CrossingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
mode
    (Bool, CrossingMode) -> IO (Bool, CrossingMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', CrossingMode
mode'')

#if defined(ENABLE_OVERLOADING)
data EventGetCrossingModeMethodInfo
instance (signature ~ (m ((Bool, Gdk.Enums.CrossingMode))), MonadIO m, IsEvent a) => O.MethodInfo EventGetCrossingModeMethodInfo a signature where
    overloadedMethod = eventGetCrossingMode

#endif

-- method Event::get_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Device" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_device" gdk_event_get_device :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.Device.Device)

-- | If the event contains a “device” field, this function will return
-- it, else it will return 'P.Nothing'.
eventGetDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@.
    -> m (Maybe Gdk.Device.Device)
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Device.Device', or 'P.Nothing'.
eventGetDevice :: a -> m (Maybe Device)
eventGetDevice event :: a
event = IO (Maybe Device) -> m (Maybe Device)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Device) -> m (Maybe Device))
-> IO (Maybe Device) -> m (Maybe Device)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Device
result <- Ptr Event -> IO (Ptr Device)
gdk_event_get_device Ptr Event
event'
    Maybe Device
maybeResult <- Ptr Device -> (Ptr Device -> IO Device) -> IO (Maybe Device)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Device
result ((Ptr Device -> IO Device) -> IO (Maybe Device))
-> (Ptr Device -> IO Device) -> IO (Maybe Device)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Device
result' -> do
        Device
result'' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
result'
        Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Maybe Device -> IO (Maybe Device)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Device
maybeResult

#if defined(ENABLE_OVERLOADING)
data EventGetDeviceMethodInfo
instance (signature ~ (m (Maybe Gdk.Device.Device)), MonadIO m, IsEvent a) => O.MethodInfo EventGetDeviceMethodInfo a signature where
    overloadedMethod = eventGetDevice

#endif

-- method Event::get_device_tool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "DeviceTool" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_device_tool" gdk_event_get_device_tool :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.DeviceTool.DeviceTool)

-- | If the event was generated by a device that supports
-- different tools (eg. a tablet), this function will
-- return a t'GI.Gdk.Objects.DeviceTool.DeviceTool' representing the tool that
-- caused the event. Otherwise, 'P.Nothing' will be returned.
-- 
-- Note: the t'GI.Gdk.Objects.DeviceTool.DeviceTool's will be constant during
-- the application lifetime, if settings must be stored
-- persistently across runs, see 'GI.Gdk.Objects.DeviceTool.deviceToolGetSerial'
eventGetDeviceTool ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Gdk.DeviceTool.DeviceTool
    -- ^ __Returns:__ The current device tool, or 'P.Nothing'
eventGetDeviceTool :: a -> m DeviceTool
eventGetDeviceTool event :: a
event = IO DeviceTool -> m DeviceTool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DeviceTool -> m DeviceTool) -> IO DeviceTool -> m DeviceTool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr DeviceTool
result <- Ptr Event -> IO (Ptr DeviceTool)
gdk_event_get_device_tool Ptr Event
event'
    Text -> Ptr DeviceTool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "eventGetDeviceTool" Ptr DeviceTool
result
    DeviceTool
result' <- ((ManagedPtr DeviceTool -> DeviceTool)
-> Ptr DeviceTool -> IO DeviceTool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DeviceTool -> DeviceTool
Gdk.DeviceTool.DeviceTool) Ptr DeviceTool
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    DeviceTool -> IO DeviceTool
forall (m :: * -> *) a. Monad m => a -> m a
return DeviceTool
result'

#if defined(ENABLE_OVERLOADING)
data EventGetDeviceToolMethodInfo
instance (signature ~ (m Gdk.DeviceTool.DeviceTool), MonadIO m, IsEvent a) => O.MethodInfo EventGetDeviceToolMethodInfo a signature where
    overloadedMethod = eventGetDeviceTool

#endif

-- method Event::get_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Display" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_display" gdk_event_get_display :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.Display.Display)

-- | Retrieves the t'GI.Gdk.Objects.Display.Display' associated to the /@event@/.
eventGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m (Maybe Gdk.Display.Display)
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Display.Display'
eventGetDisplay :: a -> m (Maybe Display)
eventGetDisplay event :: a
event = IO (Maybe Display) -> m (Maybe Display)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Display) -> m (Maybe Display))
-> IO (Maybe Display) -> m (Maybe Display)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Display
result <- Ptr Event -> IO (Ptr Display)
gdk_event_get_display Ptr Event
event'
    Maybe Display
maybeResult <- Ptr Display -> (Ptr Display -> IO Display) -> IO (Maybe Display)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Display
result ((Ptr Display -> IO Display) -> IO (Maybe Display))
-> (Ptr Display -> IO Display) -> IO (Maybe Display)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Display
result' -> do
        Display
result'' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result'
        Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Maybe Display -> IO (Maybe Display)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Display
maybeResult

#if defined(ENABLE_OVERLOADING)
data EventGetDisplayMethodInfo
instance (signature ~ (m (Maybe Gdk.Display.Display)), MonadIO m, IsEvent a) => O.MethodInfo EventGetDisplayMethodInfo a signature where
    overloadedMethod = eventGetDisplay

#endif

-- method Event::get_drop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Drop" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_drop" gdk_event_get_drop :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.Drop.Drop)

-- | Gets the t'GI.Gdk.Objects.Drop.Drop' from a DND event.
eventGetDrop ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m (Maybe Gdk.Drop.Drop)
    -- ^ __Returns:__ the drop
eventGetDrop :: a -> m (Maybe Drop)
eventGetDrop event :: a
event = IO (Maybe Drop) -> m (Maybe Drop)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Drop) -> m (Maybe Drop))
-> IO (Maybe Drop) -> m (Maybe Drop)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Drop
result <- Ptr Event -> IO (Ptr Drop)
gdk_event_get_drop Ptr Event
event'
    Maybe Drop
maybeResult <- Ptr Drop -> (Ptr Drop -> IO Drop) -> IO (Maybe Drop)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Drop
result ((Ptr Drop -> IO Drop) -> IO (Maybe Drop))
-> (Ptr Drop -> IO Drop) -> IO (Maybe Drop)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Drop
result' -> do
        Drop
result'' <- ((ManagedPtr Drop -> Drop) -> Ptr Drop -> IO Drop
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drop -> Drop
Gdk.Drop.Drop) Ptr Drop
result'
        Drop -> IO Drop
forall (m :: * -> *) a. Monad m => a -> m a
return Drop
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Maybe Drop -> IO (Maybe Drop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drop
maybeResult

#if defined(ENABLE_OVERLOADING)
data EventGetDropMethodInfo
instance (signature ~ (m (Maybe Gdk.Drop.Drop)), MonadIO m, IsEvent a) => O.MethodInfo EventGetDropMethodInfo a signature where
    overloadedMethod = eventGetDrop

#endif

-- method Event::get_event_sequence
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "EventSequence" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_event_sequence" gdk_event_get_event_sequence :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.EventSequence.EventSequence)

-- | If /@event@/ if of type 'GI.Gdk.Enums.EventTypeTouchBegin', 'GI.Gdk.Enums.EventTypeTouchUpdate',
-- 'GI.Gdk.Enums.EventTypeTouchEnd' or 'GI.Gdk.Enums.EventTypeTouchCancel', returns the t'GI.Gdk.Structs.EventSequence.EventSequence'
-- to which the event belongs. Otherwise, return 'P.Nothing'.
eventGetEventSequence ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Gdk.EventSequence.EventSequence
    -- ^ __Returns:__ the event sequence that the event belongs to
eventGetEventSequence :: a -> m EventSequence
eventGetEventSequence event :: a
event = IO EventSequence -> m EventSequence
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EventSequence -> m EventSequence)
-> IO EventSequence -> m EventSequence
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr EventSequence
result <- Ptr Event -> IO (Ptr EventSequence)
gdk_event_get_event_sequence Ptr Event
event'
    Text -> Ptr EventSequence -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "eventGetEventSequence" Ptr EventSequence
result
    EventSequence
result' <- ((ManagedPtr EventSequence -> EventSequence)
-> Ptr EventSequence -> IO EventSequence
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr EventSequence -> EventSequence
Gdk.EventSequence.EventSequence) Ptr EventSequence
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    EventSequence -> IO EventSequence
forall (m :: * -> *) a. Monad m => a -> m a
return EventSequence
result'

#if defined(ENABLE_OVERLOADING)
data EventGetEventSequenceMethodInfo
instance (signature ~ (m Gdk.EventSequence.EventSequence), MonadIO m, IsEvent a) => O.MethodInfo EventGetEventSequenceMethodInfo a signature where
    overloadedMethod = eventGetEventSequence

#endif

-- method Event::get_event_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "EventType" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_event_type" gdk_event_get_event_type :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO CUInt

-- | Retrieves the type of the event.
eventGetEventType ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Gdk.Enums.EventType
    -- ^ __Returns:__ a t'GI.Gdk.Enums.EventType'
eventGetEventType :: a -> m EventType
eventGetEventType event :: a
event = IO EventType -> m EventType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EventType -> m EventType) -> IO EventType -> m EventType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CUInt
result <- Ptr Event -> IO CUInt
gdk_event_get_event_type Ptr Event
event'
    let result' :: EventType
result' = (Int -> EventType
forall a. Enum a => Int -> a
toEnum (Int -> EventType) -> (CUInt -> Int) -> CUInt -> EventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    EventType -> IO EventType
forall (m :: * -> *) a. Monad m => a -> m a
return EventType
result'

#if defined(ENABLE_OVERLOADING)
data EventGetEventTypeMethodInfo
instance (signature ~ (m Gdk.Enums.EventType), MonadIO m, IsEvent a) => O.MethodInfo EventGetEventTypeMethodInfo a signature where
    overloadedMethod = eventGetEventType

#endif

-- method Event::get_focus_in
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "focus_in"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for focus direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_focus_in" gdk_event_get_focus_in :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CInt ->                             -- focus_in : TBasicType TBoolean
    IO CInt

-- | Extracts whether this is a focus-in or focus-out event.
eventGetFocusIn ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetFocusIn :: a -> m (Bool, Bool)
eventGetFocusIn event :: a
event = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CInt
focusIn <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr Event -> Ptr CInt -> IO CInt
gdk_event_get_focus_in Ptr Event
event' Ptr CInt
focusIn
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CInt
focusIn' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
focusIn
    let focusIn'' :: Bool
focusIn'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
focusIn'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
focusIn
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
focusIn'')

#if defined(ENABLE_OVERLOADING)
data EventGetFocusInMethodInfo
instance (signature ~ (m ((Bool, Bool))), MonadIO m, IsEvent a) => O.MethodInfo EventGetFocusInMethodInfo a signature where
    overloadedMethod = eventGetFocusIn

#endif

-- method Event::get_grab_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the grab surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_grab_surface" gdk_event_get_grab_surface :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr (Ptr Gdk.Surface.Surface) ->        -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    IO CInt

-- | Extracts the grab surface from a grab broken event.
eventGetGrabSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Gdk.Surface.Surface))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetGrabSurface :: a -> m (Bool, Surface)
eventGetGrabSurface event :: a
event = IO (Bool, Surface) -> m (Bool, Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Surface) -> m (Bool, Surface))
-> IO (Bool, Surface) -> m (Bool, Surface)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr (Ptr Surface)
surface <- IO (Ptr (Ptr Surface))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gdk.Surface.Surface))
    CInt
result <- Ptr Event -> Ptr (Ptr Surface) -> IO CInt
gdk_event_get_grab_surface Ptr Event
event' Ptr (Ptr Surface)
surface
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Ptr Surface
surface' <- Ptr (Ptr Surface) -> IO (Ptr Surface)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Surface)
surface
    Surface
surface'' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
surface'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr (Ptr Surface) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Surface)
surface
    (Bool, Surface) -> IO (Bool, Surface)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Surface
surface'')

#if defined(ENABLE_OVERLOADING)
data EventGetGrabSurfaceMethodInfo
instance (signature ~ (m ((Bool, Gdk.Surface.Surface))), MonadIO m, IsEvent a) => O.MethodInfo EventGetGrabSurfaceMethodInfo a signature where
    overloadedMethod = eventGetGrabSurface

#endif

-- method Event::get_key_group
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the key group"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_key_group" gdk_event_get_key_group :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- group : TBasicType TUInt
    IO CInt

-- | Extracts the key group from an event.
eventGetKeyGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetKeyGroup :: a -> m (Bool, Word32)
eventGetKeyGroup event :: a
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
group <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gdk_event_get_key_group Ptr Event
event' Ptr Word32
group
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
group' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
group
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
group
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
group')

#if defined(ENABLE_OVERLOADING)
data EventGetKeyGroupMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetKeyGroupMethodInfo a signature where
    overloadedMethod = eventGetKeyGroup

#endif

-- method Event::get_key_is_modifier
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_modifier"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_key_is_modifier" gdk_event_get_key_is_modifier :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CInt ->                             -- is_modifier : TBasicType TBoolean
    IO CInt

-- | Extracts whether the event is a key event for
-- a modifier key.
eventGetKeyIsModifier ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetKeyIsModifier :: a -> m (Bool, Bool)
eventGetKeyIsModifier event :: a
event = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CInt
isModifier <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr Event -> Ptr CInt -> IO CInt
gdk_event_get_key_is_modifier Ptr Event
event' Ptr CInt
isModifier
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CInt
isModifier' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isModifier
    let isModifier'' :: Bool
isModifier'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
isModifier'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
isModifier
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
isModifier'')

#if defined(ENABLE_OVERLOADING)
data EventGetKeyIsModifierMethodInfo
instance (signature ~ (m ((Bool, Bool))), MonadIO m, IsEvent a) => O.MethodInfo EventGetKeyIsModifierMethodInfo a signature where
    overloadedMethod = eventGetKeyIsModifier

#endif

-- method Event::get_keycode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keycode"
--           , argType = TBasicType TUInt16
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the keycode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_keycode" gdk_event_get_keycode :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word16 ->                           -- keycode : TBasicType TUInt16
    IO CInt

-- | Extracts the hardware keycode from an event.
-- 
-- Also see 'GI.Gdk.Objects.Event.eventGetScancode'.
eventGetKeycode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word16))
    -- ^ __Returns:__ 'P.True' if the event delivered a hardware keycode
eventGetKeycode :: a -> m (Bool, Word16)
eventGetKeycode event :: a
event = IO (Bool, Word16) -> m (Bool, Word16)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word16) -> m (Bool, Word16))
-> IO (Bool, Word16) -> m (Bool, Word16)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word16
keycode <- IO (Ptr Word16)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word16)
    CInt
result <- Ptr Event -> Ptr Word16 -> IO CInt
gdk_event_get_keycode Ptr Event
event' Ptr Word16
keycode
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word16
keycode' <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
keycode
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
keycode
    (Bool, Word16) -> IO (Bool, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word16
keycode')

#if defined(ENABLE_OVERLOADING)
data EventGetKeycodeMethodInfo
instance (signature ~ (m ((Bool, Word16))), MonadIO m, IsEvent a) => O.MethodInfo EventGetKeycodeMethodInfo a signature where
    overloadedMethod = eventGetKeycode

#endif

-- method Event::get_keyval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the keyval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_keyval" gdk_event_get_keyval :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- keyval : TBasicType TUInt
    IO CInt

-- | Extracts the keyval from an event.
eventGetKeyval ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the event delivered a key symbol
eventGetKeyval :: a -> m (Bool, Word32)
eventGetKeyval event :: a
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
keyval <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gdk_event_get_keyval Ptr Event
event' Ptr Word32
keyval
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
keyval' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
keyval
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
keyval
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
keyval')

#if defined(ENABLE_OVERLOADING)
data EventGetKeyvalMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetKeyvalMethodInfo a signature where
    overloadedMethod = eventGetKeyval

#endif

-- method Event::get_motion_history
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent of type %GDK_MOTION_NOTIFY"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gdk" , name = "TimeCoord" }))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_motion_history" gdk_event_get_motion_history :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr (GList (Ptr Gdk.TimeCoord.TimeCoord)))

-- | Retrieves the history of the /@event@/ motion, as a list of time and
-- coordinates.
eventGetMotionHistory ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@ of type 'GI.Gdk.Enums.EventTypeMotionNotify'
    -> m [Gdk.TimeCoord.TimeCoord]
    -- ^ __Returns:__ a list
    --   of time and coordinates
eventGetMotionHistory :: a -> m [TimeCoord]
eventGetMotionHistory event :: a
event = IO [TimeCoord] -> m [TimeCoord]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TimeCoord] -> m [TimeCoord])
-> IO [TimeCoord] -> m [TimeCoord]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr (GList (Ptr TimeCoord))
result <- Ptr Event -> IO (Ptr (GList (Ptr TimeCoord)))
gdk_event_get_motion_history Ptr Event
event'
    [Ptr TimeCoord]
result' <- Ptr (GList (Ptr TimeCoord)) -> IO [Ptr TimeCoord]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TimeCoord))
result
    [TimeCoord]
result'' <- (Ptr TimeCoord -> IO TimeCoord)
-> [Ptr TimeCoord] -> IO [TimeCoord]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr TimeCoord -> TimeCoord)
-> Ptr TimeCoord -> IO TimeCoord
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr TimeCoord -> TimeCoord
Gdk.TimeCoord.TimeCoord) [Ptr TimeCoord]
result'
    Ptr (GList (Ptr TimeCoord)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TimeCoord))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    [TimeCoord] -> IO [TimeCoord]
forall (m :: * -> *) a. Monad m => a -> m a
return [TimeCoord]
result''

#if defined(ENABLE_OVERLOADING)
data EventGetMotionHistoryMethodInfo
instance (signature ~ (m [Gdk.TimeCoord.TimeCoord]), MonadIO m, IsEvent a) => O.MethodInfo EventGetMotionHistoryMethodInfo a signature where
    overloadedMethod = eventGetMotionHistory

#endif

-- method Event::get_pad_axis_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the axis index"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the axis value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_pad_axis_value" gdk_event_get_pad_axis_value :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- index : TBasicType TUInt
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Extracts the information from a pad event.
eventGetPadAxisValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32, Double))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetPadAxisValue :: a -> m (Bool, Word32, Double)
eventGetPadAxisValue event :: a
event = IO (Bool, Word32, Double) -> m (Bool, Word32, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Double) -> m (Bool, Word32, Double))
-> IO (Bool, Word32, Double) -> m (Bool, Word32, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
index <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr Word32 -> Ptr CDouble -> IO CInt
gdk_event_get_pad_axis_value Ptr Event
event' Ptr Word32
index Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
index' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
index
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
index
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Word32, Double) -> IO (Bool, Word32, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
index', Double
value'')

#if defined(ENABLE_OVERLOADING)
data EventGetPadAxisValueMethodInfo
instance (signature ~ (m ((Bool, Word32, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetPadAxisValueMethodInfo a signature where
    overloadedMethod = eventGetPadAxisValue

#endif

-- method Event::get_pad_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_pad_button" gdk_event_get_pad_button :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- button : TBasicType TUInt
    IO CInt

-- | Extracts information about the pressed button from
-- a pad event.
eventGetPadButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetPadButton :: a -> m (Bool, Word32)
eventGetPadButton event :: a
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
button <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gdk_event_get_pad_button Ptr Event
event' Ptr Word32
button
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
button' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
button
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
button
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
button')

#if defined(ENABLE_OVERLOADING)
data EventGetPadButtonMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetPadButtonMethodInfo a signature where
    overloadedMethod = eventGetPadButton

#endif

-- method Event::get_pad_group_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the group"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_pad_group_mode" gdk_event_get_pad_group_mode :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- group : TBasicType TUInt
    Ptr Word32 ->                           -- mode : TBasicType TUInt
    IO CInt

-- | Extracts group and mode information from a pad event.
eventGetPadGroupMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32, Word32))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetPadGroupMode :: a -> m (Bool, Word32, Word32)
eventGetPadGroupMode event :: a
event = IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32))
-> IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
group <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
mode <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> Ptr Word32 -> IO CInt
gdk_event_get_pad_group_mode Ptr Event
event' Ptr Word32
group Ptr Word32
mode
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
group' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
group
    Word32
mode' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
mode
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
group
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
mode
    (Bool, Word32, Word32) -> IO (Bool, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
group', Word32
mode')

#if defined(ENABLE_OVERLOADING)
data EventGetPadGroupModeMethodInfo
instance (signature ~ (m ((Bool, Word32, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetPadGroupModeMethodInfo a signature where
    overloadedMethod = eventGetPadGroupMode

#endif

-- method Event::get_pointer_emulated
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_pointer_emulated" gdk_event_get_pointer_emulated :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO CInt

-- | Returns whether this event is an \'emulated\' pointer event (typically
-- from a touch event), as opposed to a real one.
eventGetPointerEmulated ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this event is emulated
eventGetPointerEmulated :: a -> m Bool
eventGetPointerEmulated event :: a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr Event -> IO CInt
gdk_event_get_pointer_emulated Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EventGetPointerEmulatedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEvent a) => O.MethodInfo EventGetPointerEmulatedMethodInfo a signature where
    overloadedMethod = eventGetPointerEmulated

#endif

-- method Event::get_root_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_root"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to put root window x coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_root"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to put root window y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_root_coords" gdk_event_get_root_coords :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- x_root : TBasicType TDouble
    Ptr CDouble ->                          -- y_root : TBasicType TDouble
    IO CInt

-- | Extract the root window relative x\/y coordinates from an event.
eventGetRootCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' if the event delivered root window coordinates
eventGetRootCoords :: a -> m (Bool, Double, Double)
eventGetRootCoords event :: a
event = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CDouble
xRoot <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
yRoot <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> Ptr CDouble -> IO CInt
gdk_event_get_root_coords Ptr Event
event' Ptr CDouble
xRoot Ptr CDouble
yRoot
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
xRoot' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xRoot
    let xRoot'' :: Double
xRoot'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
xRoot'
    CDouble
yRoot' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
yRoot
    let yRoot'' :: Double
yRoot'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
yRoot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
xRoot
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
yRoot
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
xRoot'', Double
yRoot'')

#if defined(ENABLE_OVERLOADING)
data EventGetRootCoordsMethodInfo
instance (signature ~ (m ((Bool, Double, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetRootCoordsMethodInfo a signature where
    overloadedMethod = eventGetRootCoords

#endif

-- method Event::get_scancode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_scancode" gdk_event_get_scancode :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO Int32

-- | Gets the keyboard low-level scancode of a key event.
-- 
-- This is usually hardware_keycode. On Windows this is the high
-- word of WM_KEY{DOWN,UP} lParam which contains the scancode and
-- some extended flags.
eventGetScancode ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Int32
    -- ^ __Returns:__ The associated keyboard scancode or 0
eventGetScancode :: a -> m Int32
eventGetScancode event :: a
event = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int32
result <- Ptr Event -> IO Int32
gdk_event_get_scancode Ptr Event
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data EventGetScancodeMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsEvent a) => O.MethodInfo EventGetScancodeMethodInfo a signature where
    overloadedMethod = eventGetScancode

#endif

-- method Event::get_scroll_deltas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delta_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for X delta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "delta_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for Y delta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_scroll_deltas" gdk_event_get_scroll_deltas :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- delta_x : TBasicType TDouble
    Ptr CDouble ->                          -- delta_y : TBasicType TDouble
    IO CInt

-- | Retrieves the scroll deltas from a @/GdkEvent/@
eventGetScrollDeltas ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' if the event contains smooth scroll information
eventGetScrollDeltas :: a -> m (Bool, Double, Double)
eventGetScrollDeltas event :: a
event = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CDouble
deltaX <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
deltaY <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> Ptr CDouble -> IO CInt
gdk_event_get_scroll_deltas Ptr Event
event' Ptr CDouble
deltaX Ptr CDouble
deltaY
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
deltaX' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
deltaX
    let deltaX'' :: Double
deltaX'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
deltaX'
    CDouble
deltaY' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
deltaY
    let deltaY'' :: Double
deltaY'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
deltaY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
deltaX
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
deltaY
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
deltaX'', Double
deltaY'')

#if defined(ENABLE_OVERLOADING)
data EventGetScrollDeltasMethodInfo
instance (signature ~ (m ((Bool, Double, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetScrollDeltasMethodInfo a signature where
    overloadedMethod = eventGetScrollDeltas

#endif

-- method Event::get_scroll_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ScrollDirection" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the scroll direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_scroll_direction" gdk_event_get_scroll_direction :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CUInt ->                            -- direction : TInterface (Name {namespace = "Gdk", name = "ScrollDirection"})
    IO CInt

-- | Extracts the scroll direction from an event.
eventGetScrollDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Gdk.Enums.ScrollDirection))
    -- ^ __Returns:__ 'P.True' if the event delivered a scroll direction
eventGetScrollDirection :: a -> m (Bool, ScrollDirection)
eventGetScrollDirection event :: a
event = IO (Bool, ScrollDirection) -> m (Bool, ScrollDirection)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, ScrollDirection) -> m (Bool, ScrollDirection))
-> IO (Bool, ScrollDirection) -> m (Bool, ScrollDirection)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CUInt
direction <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Event -> Ptr CUInt -> IO CInt
gdk_event_get_scroll_direction Ptr Event
event' Ptr CUInt
direction
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CUInt
direction' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
direction
    let direction'' :: ScrollDirection
direction'' = (Int -> ScrollDirection
forall a. Enum a => Int -> a
toEnum (Int -> ScrollDirection)
-> (CUInt -> Int) -> CUInt -> ScrollDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
direction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
direction
    (Bool, ScrollDirection) -> IO (Bool, ScrollDirection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', ScrollDirection
direction'')

#if defined(ENABLE_OVERLOADING)
data EventGetScrollDirectionMethodInfo
instance (signature ~ (m ((Bool, Gdk.Enums.ScrollDirection))), MonadIO m, IsEvent a) => O.MethodInfo EventGetScrollDirectionMethodInfo a signature where
    overloadedMethod = eventGetScrollDirection

#endif

-- method Event::get_seat
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Seat" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_seat" gdk_event_get_seat :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.Seat.Seat)

-- | Returns the t'GI.Gdk.Objects.Seat.Seat' this event was generated for.
eventGetSeat ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Gdk.Seat.Seat
    -- ^ __Returns:__ The t'GI.Gdk.Objects.Seat.Seat' of this event
eventGetSeat :: a -> m Seat
eventGetSeat event :: a
event = IO Seat -> m Seat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Seat -> m Seat) -> IO Seat -> m Seat
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Seat
result <- Ptr Event -> IO (Ptr Seat)
gdk_event_get_seat Ptr Event
event'
    Text -> Ptr Seat -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "eventGetSeat" Ptr Seat
result
    Seat
result' <- ((ManagedPtr Seat -> Seat) -> Ptr Seat -> IO Seat
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Seat -> Seat
Gdk.Seat.Seat) Ptr Seat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Seat -> IO Seat
forall (m :: * -> *) a. Monad m => a -> m a
return Seat
result'

#if defined(ENABLE_OVERLOADING)
data EventGetSeatMethodInfo
instance (signature ~ (m Gdk.Seat.Seat), MonadIO m, IsEvent a) => O.MethodInfo EventGetSeatMethodInfo a signature where
    overloadedMethod = eventGetSeat

#endif

-- method Event::get_source_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Device" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_source_device" gdk_event_get_source_device :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.Device.Device)

-- | This function returns the hardware (slave) t'GI.Gdk.Objects.Device.Device' that has
-- triggered the event, falling back to the virtual (master) device
-- (as in 'GI.Gdk.Objects.Event.eventGetDevice') if the event wasn’t caused by
-- interaction with a hardware device. This may happen for example
-- in synthesized crossing events after a t'GI.Gdk.Objects.Surface.Surface' updates its
-- geometry or a grab is acquired\/released.
-- 
-- If the event does not contain a device field, this function will
-- return 'P.Nothing'.
eventGetSourceDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m (Maybe Gdk.Device.Device)
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Device.Device', or 'P.Nothing'.
eventGetSourceDevice :: a -> m (Maybe Device)
eventGetSourceDevice event :: a
event = IO (Maybe Device) -> m (Maybe Device)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Device) -> m (Maybe Device))
-> IO (Maybe Device) -> m (Maybe Device)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Device
result <- Ptr Event -> IO (Ptr Device)
gdk_event_get_source_device Ptr Event
event'
    Maybe Device
maybeResult <- Ptr Device -> (Ptr Device -> IO Device) -> IO (Maybe Device)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Device
result ((Ptr Device -> IO Device) -> IO (Maybe Device))
-> (Ptr Device -> IO Device) -> IO (Maybe Device)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Device
result' -> do
        Device
result'' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
result'
        Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Maybe Device -> IO (Maybe Device)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Device
maybeResult

#if defined(ENABLE_OVERLOADING)
data EventGetSourceDeviceMethodInfo
instance (signature ~ (m (Maybe Gdk.Device.Device)), MonadIO m, IsEvent a) => O.MethodInfo EventGetSourceDeviceMethodInfo a signature where
    overloadedMethod = eventGetSourceDevice

#endif

-- method Event::get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_state" gdk_event_get_state :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CUInt ->                            -- state : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    IO CInt

-- | If the event contains a “state” field, puts that field in /@state@/.
-- 
-- Otherwise stores an empty state (0).
-- /@event@/ may be 'P.Nothing', in which case it’s treated
-- as if the event had no state field.
eventGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@ or 'P.Nothing'
    -> m ((Bool, [Gdk.Flags.ModifierType]))
    -- ^ __Returns:__ 'P.True' if there was a state field in the event
eventGetState :: a -> m (Bool, [ModifierType])
eventGetState event :: a
event = IO (Bool, [ModifierType]) -> m (Bool, [ModifierType])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [ModifierType]) -> m (Bool, [ModifierType]))
-> IO (Bool, [ModifierType]) -> m (Bool, [ModifierType])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CUInt
state <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Event -> Ptr CUInt -> IO CInt
gdk_event_get_state Ptr Event
event' Ptr CUInt
state
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CUInt
state' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
state
    let state'' :: [ModifierType]
state'' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
state'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
state
    (Bool, [ModifierType]) -> IO (Bool, [ModifierType])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [ModifierType]
state'')

#if defined(ENABLE_OVERLOADING)
data EventGetStateMethodInfo
instance (signature ~ (m ((Bool, [Gdk.Flags.ModifierType]))), MonadIO m, IsEvent a) => O.MethodInfo EventGetStateMethodInfo a signature where
    overloadedMethod = eventGetState

#endif

-- method Event::get_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_surface" gdk_event_get_surface :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO (Ptr Gdk.Surface.Surface)

-- | Extracts the t'GI.Gdk.Objects.Surface.Surface' associated with an event.
eventGetSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Gdk.Surface.Surface
    -- ^ __Returns:__ The t'GI.Gdk.Objects.Surface.Surface' associated with the event
eventGetSurface :: a -> m Surface
eventGetSurface event :: a
event = IO Surface -> m Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Surface
result <- Ptr Event -> IO (Ptr Surface)
gdk_event_get_surface Ptr Event
event'
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "eventGetSurface" Ptr Surface
result
    Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data EventGetSurfaceMethodInfo
instance (signature ~ (m Gdk.Surface.Surface), MonadIO m, IsEvent a) => O.MethodInfo EventGetSurfaceMethodInfo a signature where
    overloadedMethod = eventGetSurface

#endif

-- method Event::get_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_time" gdk_event_get_time :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO Word32

-- | Returns the time stamp from /@event@/, if there is one; otherwise
-- returns 'GI.Gdk.Constants.CURRENT_TIME'. If /@event@/ is 'P.Nothing', returns 'GI.Gdk.Constants.CURRENT_TIME'.
eventGetTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Word32
    -- ^ __Returns:__ time stamp field from /@event@/
eventGetTime :: a -> m Word32
eventGetTime event :: a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr Event -> IO Word32
gdk_event_get_time Ptr Event
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data EventGetTimeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsEvent a) => O.MethodInfo EventGetTimeMethodInfo a signature where
    overloadedMethod = eventGetTime

#endif

-- method Event::get_touch_emulating_pointer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "emulating"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for information"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_touch_emulating_pointer" gdk_event_get_touch_emulating_pointer :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CInt ->                             -- emulating : TBasicType TBoolean
    IO CInt

-- | Extracts whether a touch event is emulating a pointer event.
eventGetTouchEmulatingPointer ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetTouchEmulatingPointer :: a -> m (Bool, Bool)
eventGetTouchEmulatingPointer event :: a
event = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CInt
emulating <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr Event -> Ptr CInt -> IO CInt
gdk_event_get_touch_emulating_pointer Ptr Event
event' Ptr CInt
emulating
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CInt
emulating' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
emulating
    let emulating'' :: Bool
emulating'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
emulating'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
emulating
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
emulating'')

#if defined(ENABLE_OVERLOADING)
data EventGetTouchEmulatingPointerMethodInfo
instance (signature ~ (m ((Bool, Bool))), MonadIO m, IsEvent a) => O.MethodInfo EventGetTouchEmulatingPointerMethodInfo a signature where
    overloadedMethod = eventGetTouchEmulatingPointer

#endif

-- method Event::get_touchpad_angle_delta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delta"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for angle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_touchpad_angle_delta" gdk_event_get_touchpad_angle_delta :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- delta : TBasicType TDouble
    IO CInt

-- | Extracts the angle from a touchpad event.
eventGetTouchpadAngleDelta ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetTouchpadAngleDelta :: a -> m (Bool, Double)
eventGetTouchpadAngleDelta event :: a
event = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CDouble
delta <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> IO CInt
gdk_event_get_touchpad_angle_delta Ptr Event
event' Ptr CDouble
delta
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
delta' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
delta
    let delta'' :: Double
delta'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
delta'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
delta
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
delta'')

#if defined(ENABLE_OVERLOADING)
data EventGetTouchpadAngleDeltaMethodInfo
instance (signature ~ (m ((Bool, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetTouchpadAngleDeltaMethodInfo a signature where
    overloadedMethod = eventGetTouchpadAngleDelta

#endif

-- method Event::get_touchpad_deltas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for x"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for y"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_touchpad_deltas" gdk_event_get_touchpad_deltas :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- dx : TBasicType TDouble
    Ptr CDouble ->                          -- dy : TBasicType TDouble
    IO CInt

-- | Extracts delta information from a touchpad event.
eventGetTouchpadDeltas ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetTouchpadDeltas :: a -> m (Bool, Double, Double)
eventGetTouchpadDeltas event :: a
event = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CDouble
dx <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
dy <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> Ptr CDouble -> IO CInt
gdk_event_get_touchpad_deltas Ptr Event
event' Ptr CDouble
dx Ptr CDouble
dy
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
dx' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dx
    let dx'' :: Double
dx'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
dx'
    CDouble
dy' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dy
    let dy'' :: Double
dy'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
dy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
dx
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
dy
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
dx'', Double
dy'')

#if defined(ENABLE_OVERLOADING)
data EventGetTouchpadDeltasMethodInfo
instance (signature ~ (m ((Bool, Double, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetTouchpadDeltasMethodInfo a signature where
    overloadedMethod = eventGetTouchpadDeltas

#endif

-- method Event::get_touchpad_gesture_n_fingers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_fingers"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the number of fingers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_touchpad_gesture_n_fingers" gdk_event_get_touchpad_gesture_n_fingers :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Word32 ->                           -- n_fingers : TBasicType TUInt
    IO CInt

-- | Extracts the number of fingers from a touchpad event.
eventGetTouchpadGestureNFingers ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetTouchpadGestureNFingers :: a -> m (Bool, Word32)
eventGetTouchpadGestureNFingers event :: a
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Word32
nFingers <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gdk_event_get_touchpad_gesture_n_fingers Ptr Event
event' Ptr Word32
nFingers
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
nFingers' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nFingers
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nFingers
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
nFingers')

#if defined(ENABLE_OVERLOADING)
data EventGetTouchpadGestureNFingersMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m, IsEvent a) => O.MethodInfo EventGetTouchpadGestureNFingersMethodInfo a signature where
    overloadedMethod = eventGetTouchpadGestureNFingers

#endif

-- method Event::get_touchpad_gesture_phase
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface
--                 Name { namespace = "Gdk" , name = "TouchpadGesturePhase" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the gesture phase"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_touchpad_gesture_phase" gdk_event_get_touchpad_gesture_phase :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CUInt ->                            -- phase : TInterface (Name {namespace = "Gdk", name = "TouchpadGesturePhase"})
    IO CInt

-- | Extracts the touchpad gesture phase from a touchpad event.
eventGetTouchpadGesturePhase ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Gdk.Enums.TouchpadGesturePhase))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetTouchpadGesturePhase :: a -> m (Bool, TouchpadGesturePhase)
eventGetTouchpadGesturePhase event :: a
event = IO (Bool, TouchpadGesturePhase) -> m (Bool, TouchpadGesturePhase)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TouchpadGesturePhase) -> m (Bool, TouchpadGesturePhase))
-> IO (Bool, TouchpadGesturePhase)
-> m (Bool, TouchpadGesturePhase)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CUInt
phase <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Event -> Ptr CUInt -> IO CInt
gdk_event_get_touchpad_gesture_phase Ptr Event
event' Ptr CUInt
phase
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CUInt
phase' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
phase
    let phase'' :: TouchpadGesturePhase
phase'' = (Int -> TouchpadGesturePhase
forall a. Enum a => Int -> a
toEnum (Int -> TouchpadGesturePhase)
-> (CUInt -> Int) -> CUInt -> TouchpadGesturePhase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
phase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
phase
    (Bool, TouchpadGesturePhase) -> IO (Bool, TouchpadGesturePhase)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', TouchpadGesturePhase
phase'')

#if defined(ENABLE_OVERLOADING)
data EventGetTouchpadGesturePhaseMethodInfo
instance (signature ~ (m ((Bool, Gdk.Enums.TouchpadGesturePhase))), MonadIO m, IsEvent a) => O.MethodInfo EventGetTouchpadGesturePhaseMethodInfo a signature where
    overloadedMethod = eventGetTouchpadGesturePhase

#endif

-- method Event::get_touchpad_scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for scale"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_get_touchpad_scale" gdk_event_get_touchpad_scale :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- scale : TBasicType TDouble
    IO CInt

-- | Extracts the scale from a touchpad event.
eventGetTouchpadScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetTouchpadScale :: a -> m (Bool, Double)
eventGetTouchpadScale event :: a
event = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr CDouble
scale <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> IO CInt
gdk_event_get_touchpad_scale Ptr Event
event' Ptr CDouble
scale
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CDouble
scale' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
scale
    let scale'' :: Double
scale'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
scale'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
scale
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
scale'')

#if defined(ENABLE_OVERLOADING)
data EventGetTouchpadScaleMethodInfo
instance (signature ~ (m ((Bool, Double))), MonadIO m, IsEvent a) => O.MethodInfo EventGetTouchpadScaleMethodInfo a signature where
    overloadedMethod = eventGetTouchpadScale

#endif

-- method Event::is_scroll_stop_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_is_scroll_stop_event" gdk_event_is_scroll_stop_event :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO CInt

-- | Check whether a scroll event is a stop scroll event. Scroll sequences
-- with smooth scroll information may provide a stop scroll event once the
-- interaction with the device finishes, e.g. by lifting a finger. This
-- stop scroll event is the signal that a widget may trigger kinetic
-- scrolling based on the current velocity.
-- 
-- Stop scroll events always have a a delta of 0\/0.
eventIsScrollStopEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event is a scroll stop event
eventIsScrollStopEvent :: a -> m Bool
eventIsScrollStopEvent event :: a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr Event -> IO CInt
gdk_event_is_scroll_stop_event Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EventIsScrollStopEventMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEvent a) => O.MethodInfo EventIsScrollStopEventMethodInfo a signature where
    overloadedMethod = eventIsScrollStopEvent

#endif

-- method Event::is_sent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_is_sent" gdk_event_is_sent :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO CInt

-- | Returns whether the event was sent explicitly.
eventIsSent ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was sent explicitly
eventIsSent :: a -> m Bool
eventIsSent event :: a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr Event -> IO CInt
gdk_event_is_sent Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EventIsSentMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEvent a) => O.MethodInfo EventIsSentMethodInfo a signature where
    overloadedMethod = eventIsSent

#endif

-- method Event::set_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_set_coords" gdk_event_set_coords :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    IO ()

-- | /No description available in the introspection data./
eventSetCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -> Double
    -> Double
    -> m ()
eventSetCoords :: a -> Double -> Double -> m ()
eventSetCoords event :: a
event x :: Double
x y :: Double
y = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr Event -> CDouble -> CDouble -> IO ()
gdk_event_set_coords Ptr Event
event' CDouble
x' CDouble
y'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetCoordsMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m, IsEvent a) => O.MethodInfo EventSetCoordsMethodInfo a signature where
    overloadedMethod = eventSetCoords

#endif

-- method Event::set_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_set_device" gdk_event_set_device :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO ()

-- | Sets the device for /@event@/ to /@device@/. The event must
-- have been allocated by GTK+, for instance, by
-- 'GI.Gdk.Objects.Event.eventCopy'.
eventSetDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a, Gdk.Device.IsDevice b) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> b
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m ()
eventSetDevice :: a -> b -> m ()
eventSetDevice event :: a
event device :: b
device = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    Ptr Event -> Ptr Device -> IO ()
gdk_event_set_device Ptr Event
event' Ptr Device
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetDeviceMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsEvent a, Gdk.Device.IsDevice b) => O.MethodInfo EventSetDeviceMethodInfo a signature where
    overloadedMethod = eventSetDevice

#endif

-- method Event::set_device_tool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tool"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DeviceTool" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tool to set on the event, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_set_device_tool" gdk_event_set_device_tool :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.DeviceTool.DeviceTool ->        -- tool : TInterface (Name {namespace = "Gdk", name = "DeviceTool"})
    IO ()

-- | Sets the device tool for this event, should be rarely used.
eventSetDeviceTool ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a, Gdk.DeviceTool.IsDeviceTool b) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> Maybe (b)
    -- ^ /@tool@/: tool to set on the event, or 'P.Nothing'
    -> m ()
eventSetDeviceTool :: a -> Maybe b -> m ()
eventSetDeviceTool event :: a
event tool :: Maybe b
tool = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr DeviceTool
maybeTool <- case Maybe b
tool of
        Nothing -> Ptr DeviceTool -> IO (Ptr DeviceTool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DeviceTool
forall a. Ptr a
nullPtr
        Just jTool :: b
jTool -> do
            Ptr DeviceTool
jTool' <- b -> IO (Ptr DeviceTool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jTool
            Ptr DeviceTool -> IO (Ptr DeviceTool)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DeviceTool
jTool'
    Ptr Event -> Ptr DeviceTool -> IO ()
gdk_event_set_device_tool Ptr Event
event' Ptr DeviceTool
maybeTool
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
tool b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetDeviceToolMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsEvent a, Gdk.DeviceTool.IsDeviceTool b) => O.MethodInfo EventSetDeviceToolMethodInfo a signature where
    overloadedMethod = eventSetDeviceTool

#endif

-- method Event::set_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDisplay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_set_display" gdk_event_set_display :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    IO ()

-- | Sets the display that an event is associated with.
eventSetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a, Gdk.Display.IsDisplay b) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> b
    -- ^ /@display@/: a t'GI.Gdk.Objects.Display.Display'
    -> m ()
eventSetDisplay :: a -> b -> m ()
eventSetDisplay event :: a
event display :: b
display = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Display
display' <- b -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
display
    Ptr Event -> Ptr Display -> IO ()
gdk_event_set_display Ptr Event
event' Ptr Display
display'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
display
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetDisplayMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsEvent a, Gdk.Display.IsDisplay b) => O.MethodInfo EventSetDisplayMethodInfo a signature where
    overloadedMethod = eventSetDisplay

#endif

-- method Event::set_keyval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_set_keyval" gdk_event_set_keyval :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Word32 ->                               -- keyval : TBasicType TUInt
    IO ()

-- | /No description available in the introspection data./
eventSetKeyval ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -> Word32
    -> m ()
eventSetKeyval :: a -> Word32 -> m ()
eventSetKeyval event :: a
event keyval :: Word32
keyval = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Event -> Word32 -> IO ()
gdk_event_set_keyval Ptr Event
event' Word32
keyval
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetKeyvalMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsEvent a) => O.MethodInfo EventSetKeyvalMethodInfo a signature where
    overloadedMethod = eventSetKeyval

#endif

-- method Event::set_source_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_set_source_device" gdk_event_set_source_device :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO ()

-- | Sets the slave device for /@event@/ to /@device@/.
-- 
-- The event must have been allocated by GTK+,
-- for instance by 'GI.Gdk.Objects.Event.eventCopy'.
eventSetSourceDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a, Gdk.Device.IsDevice b) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@
    -> b
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m ()
eventSetSourceDevice :: a -> b -> m ()
eventSetSourceDevice event :: a
event device :: b
device = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    Ptr Event -> Ptr Device -> IO ()
gdk_event_set_source_device Ptr Event
event' Ptr Device
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetSourceDeviceMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsEvent a, Gdk.Device.IsDevice b) => O.MethodInfo EventSetSourceDeviceMethodInfo a signature where
    overloadedMethod = eventSetSourceDevice

#endif

-- method Event::triggers_context_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GdkEvent, currently only button events are meaningful values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_event_triggers_context_menu" gdk_event_triggers_context_menu :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gdk", name = "Event"})
    IO CInt

-- | This function returns whether a t'GI.Gdk.Structs.EventButton.EventButton' should trigger a
-- context menu, according to platform conventions. The right mouse
-- button always triggers context menus. Additionally, if
-- 'GI.Gdk.Objects.Keymap.keymapGetModifierMask' returns a non-0 mask for
-- 'GI.Gdk.Enums.ModifierIntentContextMenu', then the left mouse button will
-- also trigger a context menu if this modifier is pressed.
-- 
-- This function should always be used instead of simply checking for
-- event->button == 'GI.Gdk.Constants.BUTTON_SECONDARY'.
eventTriggersContextMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @/GdkEvent/@, currently only button events are meaningful values
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event should trigger a context menu.
eventTriggersContextMenu :: a -> m Bool
eventTriggersContextMenu event :: a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr Event -> IO CInt
gdk_event_triggers_context_menu Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EventTriggersContextMenuMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsEvent a) => O.MethodInfo EventTriggersContextMenuMethodInfo a signature where
    overloadedMethod = eventTriggersContextMenu

#endif