{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GdkEvent@s are immutable data structures, created by GDK to
-- represent windowing system events.
-- 
-- In GTK applications the events are handled automatically by toplevel
-- widgets and passed on to the event controllers of appropriate widgets,
-- so using @GdkEvent@ and its related API is rarely needed.

#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                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Gdk.Objects.Event#g:method:ref"), [triggersContextMenu]("GI.Gdk.Objects.Event#g:method:triggersContextMenu"), [unref]("GI.Gdk.Objects.Event#g:method:unref").
-- 
-- ==== Getters
-- [getAxes]("GI.Gdk.Objects.Event#g:method:getAxes"), [getAxis]("GI.Gdk.Objects.Event#g:method:getAxis"), [getDevice]("GI.Gdk.Objects.Event#g:method:getDevice"), [getDeviceTool]("GI.Gdk.Objects.Event#g:method:getDeviceTool"), [getDisplay]("GI.Gdk.Objects.Event#g:method:getDisplay"), [getEventSequence]("GI.Gdk.Objects.Event#g:method:getEventSequence"), [getEventType]("GI.Gdk.Objects.Event#g:method:getEventType"), [getHistory]("GI.Gdk.Objects.Event#g:method:getHistory"), [getModifierState]("GI.Gdk.Objects.Event#g:method:getModifierState"), [getPointerEmulated]("GI.Gdk.Objects.Event#g:method:getPointerEmulated"), [getPosition]("GI.Gdk.Objects.Event#g:method:getPosition"), [getSeat]("GI.Gdk.Objects.Event#g:method:getSeat"), [getSurface]("GI.Gdk.Objects.Event#g:method:getSurface"), [getTime]("GI.Gdk.Objects.Event#g:method:getTime").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveEventMethod                      ,
#endif

-- ** getAxes #method:getAxes#

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


-- ** getAxis #method:getAxis#

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


-- ** 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                         ,


-- ** getEventSequence #method:getEventSequence#

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


-- ** getEventType #method:getEventType#

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


-- ** getHistory #method:getHistory#

#if defined(ENABLE_OVERLOADING)
    EventGetHistoryMethodInfo               ,
#endif
    eventGetHistory                         ,


-- ** getModifierState #method:getModifierState#

#if defined(ENABLE_OVERLOADING)
    EventGetModifierStateMethodInfo         ,
#endif
    eventGetModifierState                   ,


-- ** getPointerEmulated #method:getPointerEmulated#

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


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    EventGetPositionMethodInfo              ,
#endif
    eventGetPosition                        ,


-- ** getSeat #method:getSeat#

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


-- ** getSurface #method:getSurface#

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


-- ** getTime #method:getTime#

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


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    EventRefMethodInfo                      ,
#endif
    eventRef                                ,


-- ** triggersContextMenu #method:triggersContextMenu#

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


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    EventUnrefMethodInfo                    ,
#endif
    eventUnref                              ,




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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 Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Enums as Cairo.Enums
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.String as GLib.String
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.Interfaces.Paintable as Gdk.Paintable
import {-# SOURCE #-} qualified GI.Gdk.Objects.AppLaunchContext as Gdk.AppLaunchContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.CairoContext as Gdk.CairoContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import {-# SOURCE #-} qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import {-# SOURCE #-} qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
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.DrawContext as Gdk.DrawContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import {-# SOURCE #-} qualified GI.Gdk.Objects.GLContext as Gdk.GLContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import {-# SOURCE #-} qualified GI.Gdk.Objects.Seat as Gdk.Seat
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import {-# SOURCE #-} qualified GI.Gdk.Objects.VulkanContext as Gdk.VulkanContext
import {-# SOURCE #-} qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import {-# SOURCE #-} qualified GI.Gdk.Structs.DmabufFormats as Gdk.DmabufFormats
import {-# SOURCE #-} qualified GI.Gdk.Structs.EventSequence as Gdk.EventSequence
import {-# SOURCE #-} qualified GI.Gdk.Structs.FrameTimings as Gdk.FrameTimings
import {-# SOURCE #-} qualified GI.Gdk.Structs.KeymapKey as Gdk.KeymapKey
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import {-# SOURCE #-} qualified GI.Gdk.Structs.TimeCoord as Gdk.TimeCoord
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon
import qualified GI.Gio.Objects.AppLaunchContext as Gio.AppLaunchContext
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Pango.Enums as Pango.Enums

#else
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.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

#endif

-- | Memory-managed wrapper type.
newtype Event = Event (SP.ManagedPtr Event)
    deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq)

instance SP.ManagedPtrNewtype Event where
    toManagedPtr :: Event -> ManagedPtr Event
toManagedPtr (Event ManagedPtr Event
p) = ManagedPtr Event
p

foreign import ccall "gdk_event_get_type"
    c_gdk_event_get_type :: IO B.Types.GType

instance B.Types.TypedObject Event where
    glibType :: IO GType
glibType = IO GType
c_gdk_event_get_type

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

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

-- | Cast to `Event`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toEvent :: (MIO.MonadIO m, IsEvent o) => o -> m Event
toEvent :: forall (m :: * -> *) o. (MonadIO m, IsEvent o) => o -> m Event
toEvent = IO Event -> m Event
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Event -> Event
Event

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveEventMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveEventMethod "ref" o = EventRefMethodInfo
    ResolveEventMethod "triggersContextMenu" o = EventTriggersContextMenuMethodInfo
    ResolveEventMethod "unref" o = EventUnrefMethodInfo
    ResolveEventMethod "getAxes" o = EventGetAxesMethodInfo
    ResolveEventMethod "getAxis" o = EventGetAxisMethodInfo
    ResolveEventMethod "getDevice" o = EventGetDeviceMethodInfo
    ResolveEventMethod "getDeviceTool" o = EventGetDeviceToolMethodInfo
    ResolveEventMethod "getDisplay" o = EventGetDisplayMethodInfo
    ResolveEventMethod "getEventSequence" o = EventGetEventSequenceMethodInfo
    ResolveEventMethod "getEventType" o = EventGetEventTypeMethodInfo
    ResolveEventMethod "getHistory" o = EventGetHistoryMethodInfo
    ResolveEventMethod "getModifierState" o = EventGetModifierStateMethodInfo
    ResolveEventMethod "getPointerEmulated" o = EventGetPointerEmulatedMethodInfo
    ResolveEventMethod "getPosition" o = EventGetPositionMethodInfo
    ResolveEventMethod "getSeat" o = EventGetSeatMethodInfo
    ResolveEventMethod "getSurface" o = EventGetSurfaceMethodInfo
    ResolveEventMethod "getTime" o = EventGetTimeMethodInfo
    ResolveEventMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveEventMethod t Event, O.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveEventMethod t Event, O.OverloadedMethod info Event p, R.HasField t Event p) => R.HasField t Event p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveEventMethod t Event, O.OverloadedMethodInfo info Event) => OL.IsLabel t (O.MethodProxy info Event) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

foreign import ccall "gdk_event_ref" _Event_copy_gdk_event_ref :: Ptr a -> IO (Ptr a)

foreign import ccall "gdk_event_unref" _Event_free_gdk_event_unref :: Ptr a -> IO ()

instance BoxedPtr Event where
    boxedPtrCopy :: Event -> IO Event
boxedPtrCopy = \Event
p -> Event -> (Ptr Event -> IO Event) -> IO Event
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Event
p (Ptr Event -> IO (Ptr Event)
forall a. Ptr a -> IO (Ptr a)
_Event_copy_gdk_event_ref (Ptr Event -> IO (Ptr Event))
-> (Ptr Event -> IO Event) -> Ptr Event -> IO Event
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr Event -> Event
Event)
    boxedPtrFree :: Event -> IO ()
boxedPtrFree = \Event
p -> Event -> (Ptr Event -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Event
p Ptr Event -> IO ()
forall a. Ptr a -> IO ()
_Event_free_gdk_event_unref


-- 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--              , argCallbackUserData = 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.
-- 
-- To find out which axes are used, use 'GI.Gdk.Objects.DeviceTool.deviceToolGetAxes'
-- on the device tool returned by 'GI.Gdk.Objects.Event.eventGetDeviceTool'.
eventGetAxes ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m ((Bool, [Double]))
    -- ^ __Returns:__ 'P.True' on success, otherwise 'P.False'
eventGetAxes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Bool, [Double])
eventGetAxes a
event = IO (Bool, [Double]) -> m (Bool, [Double])
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    axes <- callocMem :: IO (Ptr (Ptr CDouble))
    nAxes <- allocMem :: IO (Ptr Word32)
    result <- gdk_event_get_axes event' axes nAxes
    nAxes' <- peek nAxes
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    axes' <- peek axes
    axes'' <- (unpackMapStorableArrayWithLength realToFrac nAxes') axes'
    touchManagedPtr event
    freeMem axes
    freeMem nAxes
    return (result', axes'')

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

instance O.OverloadedMethodInfo EventGetAxesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetAxes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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.
-- 
-- To find out which axes are used, use 'GI.Gdk.Objects.DeviceTool.deviceToolGetAxes'
-- on the device tool returned by 'GI.Gdk.Objects.Event.eventGetDeviceTool'.
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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> AxisUse -> m (Bool, Double)
eventGetAxis a
event AxisUse
axisUse = IO (Bool, Double) -> m (Bool, Double)
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    let 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
    value <- allocMem :: IO (Ptr CDouble)
    result <- gdk_event_get_axis event' axisUse' value
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    value' <- peek value
    let value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    touchManagedPtr event
    freeMem value
    return (result', value'')

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

instance O.OverloadedMethodInfo EventGetAxisMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetAxis",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetAxis"
        })


#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
--           , argCallbackUserData = 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)

-- | Returns the device of an event.
eventGetDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@.
    -> m (Maybe Gdk.Device.Device)
    -- ^ __Returns:__ a @GdkDevice@
eventGetDevice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Maybe Device)
eventGetDevice a
event = IO (Maybe Device) -> m (Maybe Device)
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_device event'
    maybeResult <- convertIfNonNull result $ \Ptr Device
result' -> do
        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'
        return result''
    touchManagedPtr event
    return maybeResult

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

instance O.OverloadedMethodInfo EventGetDeviceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetDevice",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v: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
--           , argCallbackUserData = 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)

-- | Returns a @GdkDeviceTool@ representing the tool that
-- caused the event.
-- 
-- If the was not generated by a device that supports
-- different tools (such as a tablet), this function will
-- return 'P.Nothing'.
-- 
-- Note: the @GdkDeviceTool@ 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 (Maybe Gdk.DeviceTool.DeviceTool)
    -- ^ __Returns:__ The current device tool
eventGetDeviceTool :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Maybe DeviceTool)
eventGetDeviceTool a
event = IO (Maybe DeviceTool) -> m (Maybe DeviceTool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DeviceTool) -> m (Maybe DeviceTool))
-> IO (Maybe DeviceTool) -> m (Maybe DeviceTool)
forall a b. (a -> b) -> a -> b
$ do
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_device_tool event'
    maybeResult <- convertIfNonNull result $ \Ptr DeviceTool
result' -> do
        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'
        return result''
    touchManagedPtr event
    return maybeResult

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

instance O.OverloadedMethodInfo EventGetDeviceToolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetDeviceTool",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v: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
--           , argCallbackUserData = 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 display associated to the /@event@/.
eventGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m (Maybe Gdk.Display.Display)
    -- ^ __Returns:__ a @GdkDisplay@
eventGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Maybe Display)
eventGetDisplay a
event = IO (Maybe Display) -> m (Maybe Display)
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_display event'
    maybeResult <- convertIfNonNull result $ \Ptr Display
result' -> do
        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'
        return result''
    touchManagedPtr event
    return maybeResult

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

instance O.OverloadedMethodInfo EventGetDisplayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetDisplay",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetDisplay"
        })


#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
--           , argCallbackUserData = 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)

-- | Returns the event sequence to which the event belongs.
-- 
-- Related touch events are connected in a sequence. Other
-- events typically don\'t have event sequence information.
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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m EventSequence
eventGetEventSequence a
event = IO EventSequence -> m EventSequence
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_event_sequence event'
    checkUnexpectedReturnNULL "eventGetEventSequence" result
    result' <- (newBoxed Gdk.EventSequence.EventSequence) result
    touchManagedPtr event
    return result'

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

instance O.OverloadedMethodInfo EventGetEventSequenceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetEventSequence",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v: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
--           , argCallbackUserData = 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 @GdkEvent@Type
eventGetEventType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m EventType
eventGetEventType a
event = IO EventType -> m EventType
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_event_type event'
    let 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
    touchManagedPtr event
    return result'

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

instance O.OverloadedMethodInfo EventGetEventTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetEventType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetEventType"
        })


#endif

-- method Event::get_history
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a motion or scroll event"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_n_coords"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Return location for the length of the returned array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "out_n_coords"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "Return location for the length of the returned array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TCArray
--                  False
--                  (-1)
--                  1
--                  (TInterface Name { namespace = "Gdk" , name = "TimeCoord" }))
-- throws : False
-- Skip return : False

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

-- | Retrieves the history of the device that /@event@/ is for, as a list of
-- time and coordinates.
-- 
-- The history includes positions that are not delivered as separate events
-- to the application because they occurred in the same frame as /@event@/.
-- 
-- Note that only motion and scroll events record history, and motion
-- events do it only if one of the mouse buttons is down, or the device
-- has a tool.
eventGetHistory ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a motion or scroll event
    -> m (Maybe [Gdk.TimeCoord.TimeCoord])
    -- ^ __Returns:__ an
    --   array of time and coordinates
eventGetHistory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Maybe [TimeCoord])
eventGetHistory a
event = IO (Maybe [TimeCoord]) -> m (Maybe [TimeCoord])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [TimeCoord]) -> m (Maybe [TimeCoord]))
-> IO (Maybe [TimeCoord]) -> m (Maybe [TimeCoord])
forall a b. (a -> b) -> a -> b
$ do
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    outNCoords <- allocMem :: IO (Ptr Word32)
    result <- gdk_event_get_history event' outNCoords
    outNCoords' <- peek outNCoords
    maybeResult <- convertIfNonNull result $ \Ptr TimeCoord
result' -> do
        result'' <- (Int -> Word32 -> Ptr TimeCoord -> IO [Ptr TimeCoord]
forall a b. Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength Int
104 Word32
outNCoords') Ptr TimeCoord
result'
        result''' <- mapM (newPtr Gdk.TimeCoord.TimeCoord) result''
        freeMem result'
        return result'''
    touchManagedPtr event
    freeMem outNCoords
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data EventGetHistoryMethodInfo
instance (signature ~ (m (Maybe [Gdk.TimeCoord.TimeCoord])), MonadIO m, IsEvent a) => O.OverloadedMethod EventGetHistoryMethodInfo a signature where
    overloadedMethod = eventGetHistory

instance O.OverloadedMethodInfo EventGetHistoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetHistory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetHistory"
        })


#endif

-- method Event::get_modifier_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`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ModifierType" })
-- throws : False
-- Skip return : False

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

-- | Returns the modifier state field of an event.
eventGetModifierState ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m [Gdk.Flags.ModifierType]
    -- ^ __Returns:__ the modifier state of /@event@/
eventGetModifierState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m [ModifierType]
eventGetModifierState a
event = IO [ModifierType] -> m [ModifierType]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ModifierType] -> m [ModifierType])
-> IO [ModifierType] -> m [ModifierType]
forall a b. (a -> b) -> a -> b
$ do
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_modifier_state event'
    let result' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    touchManagedPtr event
    return result'

#if defined(ENABLE_OVERLOADING)
data EventGetModifierStateMethodInfo
instance (signature ~ (m [Gdk.Flags.ModifierType]), MonadIO m, IsEvent a) => O.OverloadedMethod EventGetModifierStateMethodInfo a signature where
    overloadedMethod = eventGetModifierState

instance O.OverloadedMethodInfo EventGetModifierStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetModifierState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetModifierState"
        })


#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
--           , argCallbackUserData = 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.
-- 
-- Emulated pointer events typically originate from a touch events.
eventGetPointerEmulated ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this event is emulated
eventGetPointerEmulated :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m Bool
eventGetPointerEmulated a
event = IO Bool -> m Bool
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_pointer_emulated event'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr event
    return result'

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

instance O.OverloadedMethodInfo EventGetPointerEmulatedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetPointerEmulated",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetPointerEmulated"
        })


#endif

-- method Event::get_position
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , 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
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , 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
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | Extract the event surface relative x\/y coordinates from an event.
-- 
-- This position is in <http://developer.gnome.org/gdk/stable/coordinates.html surface coordinates>.
eventGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m ((Bool, Double, Double))
eventGetPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Bool, Double, Double)
eventGetPosition a
event = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    x <- allocMem :: IO (Ptr CDouble)
    y <- allocMem :: IO (Ptr CDouble)
    result <- gdk_event_get_position event' x y
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    x' <- peek x
    let x'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'
    y' <- peek y
    let y'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'
    touchManagedPtr event
    freeMem x
    freeMem y
    return (result', x'', y'')

#if defined(ENABLE_OVERLOADING)
data EventGetPositionMethodInfo
instance (signature ~ (m ((Bool, Double, Double))), MonadIO m, IsEvent a) => O.OverloadedMethod EventGetPositionMethodInfo a signature where
    overloadedMethod = eventGetPosition

instance O.OverloadedMethodInfo EventGetPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetPosition"
        })


#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
--           , argCallbackUserData = 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 seat that originated the event.
eventGetSeat ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m (Maybe Gdk.Seat.Seat)
    -- ^ __Returns:__ a @GdkSeat@.
eventGetSeat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Maybe Seat)
eventGetSeat a
event = IO (Maybe Seat) -> m (Maybe Seat)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Seat) -> m (Maybe Seat))
-> IO (Maybe Seat) -> m (Maybe Seat)
forall a b. (a -> b) -> a -> b
$ do
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_seat event'
    maybeResult <- convertIfNonNull result $ \Ptr Seat
result' -> do
        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'
        return result''
    touchManagedPtr event
    return maybeResult

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

instance O.OverloadedMethodInfo EventGetSeatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetSeat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetSeat"
        })


#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
--           , argCallbackUserData = 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 surface associated with an event.
eventGetSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m (Maybe Gdk.Surface.Surface)
    -- ^ __Returns:__ The @GdkSurface@ associated with the event
eventGetSurface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m (Maybe Surface)
eventGetSurface a
event = IO (Maybe Surface) -> m (Maybe Surface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Surface) -> m (Maybe Surface))
-> IO (Maybe Surface) -> m (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ do
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_surface event'
    maybeResult <- convertIfNonNull result $ \Ptr Surface
result' -> do
        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'
        return result''
    touchManagedPtr event
    return maybeResult

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

instance O.OverloadedMethodInfo EventGetSurfaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetSurface",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v: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
--           , argCallbackUserData = 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 timestamp of /@event@/.
-- 
-- Not all events have timestamps. In that case, this function
-- returns 'GI.Gdk.Constants.CURRENT_TIME'.
eventGetTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m Word32
    -- ^ __Returns:__ timestamp field from /@event@/
eventGetTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m Word32
eventGetTime a
event = IO Word32 -> m Word32
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_get_time event'
    touchManagedPtr event
    return result

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

instance O.OverloadedMethodInfo EventGetTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventGetTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventGetTime"
        })


#endif

-- method Event::ref
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Event" })
-- throws : False
-- Skip return : False

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

-- | Increase the ref count of /@event@/.
eventRef ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m Event
    -- ^ __Returns:__ /@event@/
eventRef :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m Event
eventRef a
event = IO Event -> m Event
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_ref event'
    checkUnexpectedReturnNULL "eventRef" result
    result' <- (wrapPtr Event) result
    touchManagedPtr event
    return result'

#if defined(ENABLE_OVERLOADING)
data EventRefMethodInfo
instance (signature ~ (m Event), MonadIO m, IsEvent a) => O.OverloadedMethod EventRefMethodInfo a signature where
    overloadedMethod = eventRef

instance O.OverloadedMethodInfo EventRefMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventRef"
        })


#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
--           , argCallbackUserData = 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

-- | Returns whether a @GdkEvent@ should trigger a context menu,
-- according to platform conventions.
-- 
-- The right mouse button typically triggers context menus.
-- 
-- 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m Bool
eventTriggersContextMenu a
event = IO Bool -> m Bool
forall a. IO a -> m a
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
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    result <- gdk_event_triggers_context_menu event'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr event
    return result'

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

instance O.OverloadedMethodInfo EventTriggersContextMenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventTriggersContextMenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventTriggersContextMenu"
        })


#endif

-- method Event::unref
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Decrease the ref count of /@event@/.
-- 
-- If the last reference is dropped, the structure is freed.
eventUnref ::
    (B.CallStack.HasCallStack, MonadIO m, IsEvent a) =>
    a
    -- ^ /@event@/: a @GdkEvent@
    -> m ()
eventUnref :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEvent a) =>
a -> m ()
eventUnref a
event = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    event' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
B.ManagedPtr.disownManagedPtr a
event
    gdk_event_unref event'
    touchManagedPtr event
    return ()

#if defined(ENABLE_OVERLOADING)
data EventUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m, IsEvent a) => O.OverloadedMethod EventUnrefMethodInfo a signature where
    overloadedMethod = eventUnref

instance O.OverloadedMethodInfo EventUnrefMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Event.eventUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Event.html#v:eventUnref"
        })


#endif