{-# LINE 1 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LINE 4 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LINE 6 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
module Graphics.UI.Gtk.Gdk.EventM (
HasCoordinates,
HasRootCoordinates,
HasModifier,
HasTime,
EventM,
EAny,
EKey,
EButton,
EScroll,
EMotion,
EExpose,
EVisibility,
ECrossing,
EFocus,
EConfigure,
EProperty,
EProximity,
EWindowState,
{-# LINE 124 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
EOwnerChange,
{-# LINE 126 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 127 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
EGrabBroken,
{-# LINE 129 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventWindow,
eventSent,
eventCoordinates,
eventRootCoordinates,
eventModifier,
eventModifierAll,
eventModifierMouse,
eventTime,
eventKeyVal,
eventKeyName,
eventHardwareKeycode,
eventKeyboardGroup,
MouseButton(..),
eventButton,
Click(..),
eventClick,
ScrollDirection(..),
eventScrollDirection,
eventIsHint,
{-# LINE 151 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventRequestMotions,
{-# LINE 153 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventArea,
{-# LINE 155 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventRegion,
{-# LINE 157 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
VisibilityState(..),
eventVisibilityState,
CrossingMode(..),
eventCrossingMode,
NotifyType(..),
eventNotifyType,
eventCrossingFocus,
eventFocusIn,
eventPosition,
eventSize,
eventProperty,
WindowState(..),
eventWindowStateChanged,
eventWindowState,
{-# LINE 172 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
OwnerChange(..),
eventChangeReason,
eventSelection,
eventSelectionTime,
{-# LINE 177 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 178 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventKeyboardGrab,
eventImplicit,
eventGrabWindow,
{-# LINE 182 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
Modifier(..),
TimeStamp,
currentTime,
tryEvent,
stopEvent,
) where
import Prelude hiding (catch)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Flags
import System.Glib.GObject ( makeNewGObject )
import Graphics.UI.Gtk.Gdk.Keys (KeyVal, KeyCode, keyName)
{-# LINE 198 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
import Graphics.UI.Gtk.Gdk.Region (Region, makeNewRegion)
{-# LINE 200 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
import Graphics.UI.Gtk.Gdk.Enums (Modifier(..), VisibilityState(..),
CrossingMode(..), NotifyType(..), WindowState(..), ScrollDirection(..),
{-# LINE 203 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
OwnerChange(..)
{-# LINE 205 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
)
import Graphics.UI.Gtk.General.Enums (MouseButton(..), Click(..))
import Graphics.UI.Gtk.General.Structs (Rectangle(..))
import Graphics.UI.Gtk.General.DNDTypes (Atom(..), SelectionTag)
import Graphics.UI.Gtk.Types ( DrawWindow, mkDrawWindow )
import Data.List (isPrefixOf)
import Control.Monad.Reader ( ReaderT, ask, runReaderT )
import Control.Monad.Trans ( liftIO )
import Control.Monad ( liftM )
{-# LINE 216 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
import Control.Exception ( Handler(..)
, PatternMatchFail(..)
, catches, throw )
import System.IO.Error (isUserError, ioeGetErrorString)
{-# LINE 224 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
type EventM t = ReaderT (Ptr t) IO
data EAny
data EKey
data EButton
data EScroll
data EMotion
data EExpose
data EVisibility
data ECrossing
data EFocus
data EConfigure
data EProperty
data EProximity
data EWindowState
{-# LINE 270 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
data EOwnerChange
{-# LINE 273 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 276 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
data EGrabBroken
{-# LINE 279 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventWindow :: EventM any DrawWindow
eventWindow :: forall any. EventM any DrawWindow
eventWindow = do
Ptr any
ptr <- ReaderT (Ptr any) IO (Ptr any)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO DrawWindow -> EventM any DrawWindow
forall a. IO a -> ReaderT (Ptr any) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DrawWindow -> EventM any DrawWindow)
-> IO DrawWindow -> EventM any DrawWindow
forall a b. (a -> b) -> a -> b
$ (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow ((\Ptr any
hsc_ptr -> Ptr any -> Int -> IO (Ptr DrawWindow)
forall b. Ptr b -> Int -> IO (Ptr DrawWindow)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr any
hsc_ptr Int
4) Ptr any
ptr)
{-# LINE 286 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventSent :: EventM any Bool
eventSent :: forall any. EventM any Bool
eventSent = do
Ptr any
ptr <- ReaderT (Ptr any) IO (Ptr any)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Bool -> EventM any Bool
forall a. IO a -> ReaderT (Ptr any) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM any Bool) -> IO Bool -> EventM any Bool
forall a b. (a -> b) -> a -> b
$ (\Ptr any
hsc_ptr -> Ptr any -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr any
hsc_ptr Int
8) Ptr any
ptr
{-# LINE 293 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
class HasCoordinates a
instance HasCoordinates EButton
instance HasCoordinates EScroll
instance HasCoordinates EMotion
instance HasCoordinates ECrossing
eventCoordinates :: HasCoordinates t => EventM t (Double, Double)
eventCoordinates :: forall t. HasCoordinates t => EventM t (Double, Double)
eventCoordinates = do
Ptr t
ptr <- ReaderT (Ptr t) IO (Ptr t)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Double, Double) -> EventM t (Double, Double)
forall a. IO a -> ReaderT (Ptr t) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> EventM t (Double, Double))
-> IO (Double, Double) -> EventM t (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
(Int32
ty :: Int32) <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr t -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr t
ptr)
{-# LINE 306 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
if ty `elem` [ 4,
{-# LINE 307 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
5,
{-# LINE 308 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
6,
{-# LINE 309 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
7] then do
{-# LINE 310 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 311 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 312 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else if ty `elem` [ 31 ] then do
{-# LINE 314 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 315 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 316 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else if ty `elem` [ 3 ] then do
{-# LINE 318 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 319 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 320 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else if ty `elem` [ 10,
{-# LINE 322 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
11] then do
{-# LINE 323 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
{-# LINE 324 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 28) ptr
{-# LINE 325 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else error ("eventCoordinates: none for event type "++show ty)
class HasRootCoordinates a
instance HasRootCoordinates EButton
instance HasRootCoordinates EScroll
instance HasRootCoordinates EMotion
instance HasRootCoordinates ECrossing
eventRootCoordinates :: HasRootCoordinates t => EventM t (Double, Double)
eventRootCoordinates :: forall t. HasRootCoordinates t => EventM t (Double, Double)
eventRootCoordinates = do
Ptr t
ptr <- ReaderT (Ptr t) IO (Ptr t)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Double, Double) -> EventM t (Double, Double)
forall a. IO a -> ReaderT (Ptr t) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> EventM t (Double, Double))
-> IO (Double, Double) -> EventM t (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
(Int32
ty :: Int32) <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr t -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr t
ptr)
{-# LINE 341 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
if ty `elem` [ 4,
{-# LINE 342 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
5,
{-# LINE 343 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
6,
{-# LINE 344 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
7] then do
{-# LINE 345 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr
{-# LINE 346 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 56) ptr
{-# LINE 347 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else if ty `elem` [ 31 ] then do
{-# LINE 349 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 44) ptr
{-# LINE 350 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 52) ptr
{-# LINE 351 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else if ty `elem` [ 3 ] then do
{-# LINE 353 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr
{-# LINE 354 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 56) ptr
{-# LINE 355 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else if ty `elem` [ 10,
{-# LINE 357 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
11] then do
{-# LINE 358 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(x :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
{-# LINE 359 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Double) <- (\hsc_ptr -> peekByteOff hsc_ptr 44) ptr
{-# LINE 360 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (realToFrac x, realToFrac y)
else error ("eventRootCoordinates: none for event type "++show ty)
class HasModifier a
instance HasModifier EKey
instance HasModifier EButton
instance HasModifier EScroll
instance HasModifier EMotion
instance HasModifier ECrossing
eventModifier :: HasModifier t => EventM t [Modifier]
eventModifier :: forall t. HasModifier t => EventM t [Modifier]
eventModifier = Word32 -> ReaderT (Ptr t) IO [Modifier]
forall {m :: * -> *} {b} {a}.
(MonadReader (Ptr b) m, MonadIO m, Flags a) =>
Word32 -> m [a]
eM Word32
defModMask
eventModifierAll :: HasModifier t => EventM t [Modifier]
eventModifierAll :: forall t. HasModifier t => EventM t [Modifier]
eventModifierAll = Word32 -> ReaderT (Ptr t) IO [Modifier]
forall {m :: * -> *} {b} {a}.
(MonadReader (Ptr b) m, MonadIO m, Flags a) =>
Word32 -> m [a]
eM Word32
allModMask
eventModifierMouse :: HasModifier t => EventM t [Modifier]
eventModifierMouse :: forall t. HasModifier t => EventM t [Modifier]
eventModifierMouse = Word32 -> ReaderT (Ptr t) IO [Modifier]
forall {m :: * -> *} {b} {a}.
(MonadReader (Ptr b) m, MonadIO m, Flags a) =>
Word32 -> m [a]
eM Word32
mouseModMask
allModMask :: Word32
allModMask = -Word32
1
foreign import ccall safe "gtk_accelerator_get_default_mod_mask"
defModMask :: Word32
{-# LINE 394 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
mouseModMask :: Word32
mouseModMask = Word32
256
{-# LINE 396 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
512
{-# LINE 397 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
1024
{-# LINE 398 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
2048
{-# LINE 399 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
4096
{-# LINE 400 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eM :: Word32 -> m [a]
eM Word32
mask = do
Ptr b
ptr <- m (Ptr b)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO [a] -> m [a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> m [a]) -> IO [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ do
(Int32
ty :: Int32) <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr b -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr)
{-# LINE 405 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
if ty `elem` [ 8,
{-# LINE 406 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
9] then do
{-# LINE 407 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(modif ::Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 408 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (toFlags (fromIntegral (modif .&. mask)))
else if ty `elem` [ 4,
{-# LINE 410 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
5,
{-# LINE 411 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
6,
{-# LINE 412 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
7] then do
{-# LINE 413 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(modif ::Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
{-# LINE 414 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (toFlags (fromIntegral (modif .&. mask)))
else if ty `elem` [ 31 ] then do
{-# LINE 416 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(modif ::Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
{-# LINE 417 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (toFlags (fromIntegral (modif .&. mask)))
else if ty `elem` [ 3 ] then do
{-# LINE 419 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(modif ::Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
{-# LINE 420 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (toFlags (fromIntegral (modif .&. mask)))
else if ty `elem` [ 10,
{-# LINE 422 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
11] then do
{-# LINE 423 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(modif ::Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 64) ptr
{-# LINE 424 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (toFlags (fromIntegral (modif .&. mask)))
else error ("eventModifiers: none for event type "++show ty)
class HasTime a
instance HasTime EKey
instance HasTime EButton
instance HasTime EScroll
instance HasTime EMotion
instance HasTime ECrossing
instance HasTime EProperty
instance HasTime EProximity
{-# LINE 436 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
instance HasTime EOwnerChange
{-# LINE 438 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
type TimeStamp = Word32
currentTime :: TimeStamp
currentTime :: Word32
currentTime = Word32
0
{-# LINE 448 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventTime :: HasTime t => EventM t TimeStamp
eventTime :: forall t. HasTime t => EventM t Word32
eventTime = do
Ptr t
ptr <- ReaderT (Ptr t) IO (Ptr t)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Word32 -> EventM t Word32
forall a. IO a -> ReaderT (Ptr t) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> EventM t Word32) -> IO Word32 -> EventM t Word32
forall a b. (a -> b) -> a -> b
$ do
(Int32
ty :: Int32) <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr t -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr t
ptr)
{-# LINE 455 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
if ty `elem` [ 8,
{-# LINE 456 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
9] then do
{-# LINE 457 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 458 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
else if ty `elem` [ 4,
{-# LINE 460 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
5,
{-# LINE 461 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
6,
{-# LINE 462 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
7] then do
{-# LINE 463 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 464 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
else if ty `elem` [ 31 ] then do
{-# LINE 466 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 467 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
else if ty `elem` [ 3 ] then do
{-# LINE 469 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 470 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
else if ty `elem` [ 10,
{-# LINE 472 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
11] then do
{-# LINE 473 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 474 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
else if ty `elem` [ 16 ] then do
{-# LINE 476 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 477 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
else if ty `elem` [ 20,
{-# LINE 479 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
21] then do
{-# LINE 480 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 481 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
{-# LINE 483 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
else if ty `elem` [ 34 ] then do
{-# LINE 484 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(time :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 485 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral time)
{-# LINE 487 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
else error ("eventModifiers: none for event type "++show ty)
eventKeyVal :: EventM EKey KeyVal
eventKeyVal :: EventM EKey Word32
eventKeyVal = ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EKey) IO (Ptr EKey)
-> (Ptr EKey -> EventM EKey Word32) -> EventM EKey Word32
forall a b.
ReaderT (Ptr EKey) IO a
-> (a -> ReaderT (Ptr EKey) IO b) -> ReaderT (Ptr EKey) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EKey
ptr -> IO Word32 -> EventM EKey Word32
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> EventM EKey Word32)
-> IO Word32 -> EventM EKey Word32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
((\Ptr EKey
hsc_ptr -> Ptr EKey -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EKey
hsc_ptr Int
20) Ptr EKey
ptr :: IO Word32)
{-# LINE 493 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventKeyName :: EventM EKey DefaultGlibString
eventKeyName :: EventM EKey DefaultGlibString
eventKeyName = (Word32 -> DefaultGlibString)
-> EventM EKey Word32 -> EventM EKey DefaultGlibString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> DefaultGlibString
keyName (EventM EKey Word32 -> EventM EKey DefaultGlibString)
-> EventM EKey Word32 -> EventM EKey DefaultGlibString
forall a b. (a -> b) -> a -> b
$ EventM EKey Word32
eventKeyVal
eventHardwareKeycode :: EventM EKey KeyCode
eventHardwareKeycode :: EventM EKey Word16
eventHardwareKeycode = ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EKey) IO (Ptr EKey)
-> (Ptr EKey -> EventM EKey Word16) -> EventM EKey Word16
forall a b.
ReaderT (Ptr EKey) IO a
-> (a -> ReaderT (Ptr EKey) IO b) -> ReaderT (Ptr EKey) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EKey
ptr -> IO Word16 -> EventM EKey Word16
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> EventM EKey Word16)
-> IO Word16 -> EventM EKey Word16
forall a b. (a -> b) -> a -> b
$ (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
((\Ptr EKey
hsc_ptr -> Ptr EKey -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EKey
hsc_ptr Int
32) Ptr EKey
ptr :: IO Word16)
{-# LINE 502 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventKeyboardGroup :: EventM EKey Word8
eventKeyboardGroup :: EventM EKey Word8
eventKeyboardGroup = ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EKey) IO (Ptr EKey)
-> (Ptr EKey -> EventM EKey Word8) -> EventM EKey Word8
forall a b.
ReaderT (Ptr EKey) IO a
-> (a -> ReaderT (Ptr EKey) IO b) -> ReaderT (Ptr EKey) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EKey
ptr -> IO Word8 -> EventM EKey Word8
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> EventM EKey Word8) -> IO Word8 -> EventM EKey Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> IO Word8 -> IO Word8
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
((\Ptr EKey
hsc_ptr -> Ptr EKey -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EKey
hsc_ptr Int
34) Ptr EKey
ptr :: IO Word8)
{-# LINE 507 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventButton :: EventM EButton MouseButton
eventButton :: EventM EButton MouseButton
eventButton = ReaderT (Ptr EButton) IO (Ptr EButton)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EButton) IO (Ptr EButton)
-> (Ptr EButton -> EventM EButton MouseButton)
-> EventM EButton MouseButton
forall a b.
ReaderT (Ptr EButton) IO a
-> (a -> ReaderT (Ptr EButton) IO b) -> ReaderT (Ptr EButton) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EButton
ptr -> IO MouseButton -> EventM EButton MouseButton
forall a. IO a -> ReaderT (Ptr EButton) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MouseButton -> EventM EButton MouseButton)
-> IO MouseButton -> EventM EButton MouseButton
forall a b. (a -> b) -> a -> b
$ (Word32 -> MouseButton) -> IO Word32 -> IO MouseButton
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> MouseButton
forall a. Enum a => Int -> a
toEnum (Int -> MouseButton) -> (Word32 -> Int) -> Word32 -> MouseButton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr EButton
hsc_ptr -> Ptr EButton -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EButton
hsc_ptr Int
40) Ptr EButton
ptr :: IO Word32)
{-# LINE 512 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventClick :: EventM EButton Click
eventClick :: EventM EButton Click
eventClick = do
Ptr EButton
ptr <- ReaderT (Ptr EButton) IO (Ptr EButton)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Click -> EventM EButton Click
forall a. IO a -> ReaderT (Ptr EButton) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Click -> EventM EButton Click)
-> IO Click -> EventM EButton Click
forall a b. (a -> b) -> a -> b
$ do
(Int32
ty :: Int32) <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr EButton -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr EButton
ptr)
{-# LINE 519 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
case ty of
4 -> return SingleClick
{-# LINE 521 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
5 -> return DoubleClick
{-# LINE 522 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
6 -> return TripleClick
{-# LINE 523 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
7 -> return ReleaseClick
{-# LINE 524 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
_ -> error ("eventClick: non for event type "++show ty)
eventScrollDirection :: EventM EScroll ScrollDirection
eventScrollDirection :: EventM EScroll ScrollDirection
eventScrollDirection = ReaderT (Ptr EScroll) IO (Ptr EScroll)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EScroll) IO (Ptr EScroll)
-> (Ptr EScroll -> EventM EScroll ScrollDirection)
-> EventM EScroll ScrollDirection
forall a b.
ReaderT (Ptr EScroll) IO a
-> (a -> ReaderT (Ptr EScroll) IO b) -> ReaderT (Ptr EScroll) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EScroll
ptr -> IO ScrollDirection -> EventM EScroll ScrollDirection
forall a. IO a -> ReaderT (Ptr EScroll) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScrollDirection -> EventM EScroll ScrollDirection)
-> IO ScrollDirection -> EventM EScroll ScrollDirection
forall a b. (a -> b) -> a -> b
$ (Word32 -> ScrollDirection) -> IO Word32 -> IO ScrollDirection
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ScrollDirection
forall a. Enum a => Int -> a
toEnum (Int -> ScrollDirection)
-> (Word32 -> Int) -> Word32 -> ScrollDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr EScroll
hsc_ptr -> Ptr EScroll -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EScroll
hsc_ptr Int
36) Ptr EScroll
ptr :: IO Word32)
{-# LINE 530 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventIsHint :: EventM EMotion Bool
eventIsHint :: EventM EMotion Bool
eventIsHint = ReaderT (Ptr EMotion) IO (Ptr EMotion)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EMotion) IO (Ptr EMotion)
-> (Ptr EMotion -> EventM EMotion Bool) -> EventM EMotion Bool
forall a b.
ReaderT (Ptr EMotion) IO a
-> (a -> ReaderT (Ptr EMotion) IO b) -> ReaderT (Ptr EMotion) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EMotion
ptr -> IO Bool -> EventM EMotion Bool
forall a. IO a -> ReaderT (Ptr EMotion) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EMotion Bool) -> IO Bool -> EventM EMotion Bool
forall a b. (a -> b) -> a -> b
$ (Int16 -> Bool) -> IO Int16 -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int16 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
((\Ptr EMotion
hsc_ptr -> Ptr EMotion -> Int -> IO Int16
forall b. Ptr b -> Int -> IO Int16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EMotion
hsc_ptr Int
40) Ptr EMotion
ptr :: IO Int16)
{-# LINE 536 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 538 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventRequestMotions :: EventM EMotion ()
eventRequestMotions :: EventM EMotion ()
eventRequestMotions = ReaderT (Ptr EMotion) IO (Ptr EMotion)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EMotion) IO (Ptr EMotion)
-> (Ptr EMotion -> EventM EMotion ()) -> EventM EMotion ()
forall a b.
ReaderT (Ptr EMotion) IO a
-> (a -> ReaderT (Ptr EMotion) IO b) -> ReaderT (Ptr EMotion) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EMotion
ptr -> IO () -> EventM EMotion ()
forall a. IO a -> ReaderT (Ptr EMotion) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM EMotion ()) -> IO () -> EventM EMotion ()
forall a b. (a -> b) -> a -> b
$
Ptr EMotion -> IO ()
gdk_event_request_motions Ptr EMotion
ptr
foreign import ccall "gdk_event_request_motions"
gdk_event_request_motions :: Ptr EMotion -> IO ()
{-# LINE 561 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventArea :: EventM EExpose Rectangle
eventArea :: EventM EExpose Rectangle
eventArea = ReaderT (Ptr EExpose) IO (Ptr EExpose)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EExpose) IO (Ptr EExpose)
-> (Ptr EExpose -> EventM EExpose Rectangle)
-> EventM EExpose Rectangle
forall a b.
ReaderT (Ptr EExpose) IO a
-> (a -> ReaderT (Ptr EExpose) IO b) -> ReaderT (Ptr EExpose) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EExpose
ptr -> IO Rectangle -> EventM EExpose Rectangle
forall a. IO a -> ReaderT (Ptr EExpose) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> EventM EExpose Rectangle)
-> IO Rectangle -> EventM EExpose Rectangle
forall a b. (a -> b) -> a -> b
$
((\Ptr EExpose
hsc_ptr -> Ptr EExpose -> Int -> IO Rectangle
forall b. Ptr b -> Int -> IO Rectangle
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EExpose
hsc_ptr Int
12) Ptr EExpose
ptr :: IO Rectangle)
{-# LINE 566 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 568 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventRegion :: EventM EExpose Region
eventRegion :: EventM EExpose Region
eventRegion = ReaderT (Ptr EExpose) IO (Ptr EExpose)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EExpose) IO (Ptr EExpose)
-> (Ptr EExpose -> EventM EExpose Region) -> EventM EExpose Region
forall a b.
ReaderT (Ptr EExpose) IO a
-> (a -> ReaderT (Ptr EExpose) IO b) -> ReaderT (Ptr EExpose) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EExpose
ptr -> IO Region -> EventM EExpose Region
forall a. IO a -> ReaderT (Ptr EExpose) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Region -> EventM EExpose Region)
-> IO Region -> EventM EExpose Region
forall a b. (a -> b) -> a -> b
$ do
(Ptr Region
reg_ :: Ptr Region) <- (\Ptr EExpose
hsc_ptr -> Ptr EExpose -> Int -> IO (Ptr Region)
forall b. Ptr b -> Int -> IO (Ptr Region)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EExpose
hsc_ptr Int
28) Ptr EExpose
ptr
{-# LINE 573 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
reg_ <- gdk_region_copy reg_
Ptr Region -> IO Region
makeNewRegion Ptr Region
reg_
foreign import ccall "gdk_region_copy"
gdk_region_copy :: Ptr Region -> IO (Ptr Region)
{-# LINE 579 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventVisibilityState :: EventM EVisibility VisibilityState
eventVisibilityState :: EventM EVisibility VisibilityState
eventVisibilityState = ReaderT (Ptr EVisibility) IO (Ptr EVisibility)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EVisibility) IO (Ptr EVisibility)
-> (Ptr EVisibility -> EventM EVisibility VisibilityState)
-> EventM EVisibility VisibilityState
forall a b.
ReaderT (Ptr EVisibility) IO a
-> (a -> ReaderT (Ptr EVisibility) IO b)
-> ReaderT (Ptr EVisibility) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EVisibility
ptr -> IO VisibilityState -> EventM EVisibility VisibilityState
forall a. IO a -> ReaderT (Ptr EVisibility) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VisibilityState -> EventM EVisibility VisibilityState)
-> IO VisibilityState -> EventM EVisibility VisibilityState
forall a b. (a -> b) -> a -> b
$ (Word32 -> VisibilityState) -> IO Word32 -> IO VisibilityState
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> VisibilityState
forall a. Enum a => Int -> a
toEnum (Int -> VisibilityState)
-> (Word32 -> Int) -> Word32 -> VisibilityState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr EVisibility
hsc_ptr -> Ptr EVisibility -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EVisibility
hsc_ptr Int
12) Ptr EVisibility
ptr :: IO Word32)
{-# LINE 584 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventCrossingMode :: EventM ECrossing CrossingMode
eventCrossingMode :: EventM ECrossing CrossingMode
eventCrossingMode = ReaderT (Ptr ECrossing) IO (Ptr ECrossing)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr ECrossing) IO (Ptr ECrossing)
-> (Ptr ECrossing -> EventM ECrossing CrossingMode)
-> EventM ECrossing CrossingMode
forall a b.
ReaderT (Ptr ECrossing) IO a
-> (a -> ReaderT (Ptr ECrossing) IO b)
-> ReaderT (Ptr ECrossing) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ECrossing
ptr -> IO CrossingMode -> EventM ECrossing CrossingMode
forall a. IO a -> ReaderT (Ptr ECrossing) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CrossingMode -> EventM ECrossing CrossingMode)
-> IO CrossingMode -> EventM ECrossing CrossingMode
forall a b. (a -> b) -> a -> b
$ (Word32 -> CrossingMode) -> IO Word32 -> IO CrossingMode
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> CrossingMode
forall a. Enum a => Int -> a
toEnum (Int -> CrossingMode) -> (Word32 -> Int) -> Word32 -> CrossingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr ECrossing
hsc_ptr -> Ptr ECrossing -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ECrossing
hsc_ptr Int
52) Ptr ECrossing
ptr :: IO Word32)
{-# LINE 589 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventNotifyType :: EventM ECrossing NotifyType
eventNotifyType :: EventM ECrossing NotifyType
eventNotifyType = ReaderT (Ptr ECrossing) IO (Ptr ECrossing)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr ECrossing) IO (Ptr ECrossing)
-> (Ptr ECrossing -> EventM ECrossing NotifyType)
-> EventM ECrossing NotifyType
forall a b.
ReaderT (Ptr ECrossing) IO a
-> (a -> ReaderT (Ptr ECrossing) IO b)
-> ReaderT (Ptr ECrossing) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ECrossing
ptr -> IO NotifyType -> EventM ECrossing NotifyType
forall a. IO a -> ReaderT (Ptr ECrossing) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NotifyType -> EventM ECrossing NotifyType)
-> IO NotifyType -> EventM ECrossing NotifyType
forall a b. (a -> b) -> a -> b
$ (Word32 -> NotifyType) -> IO Word32 -> IO NotifyType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> NotifyType
forall a. Enum a => Int -> a
toEnum (Int -> NotifyType) -> (Word32 -> Int) -> Word32 -> NotifyType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr ECrossing
hsc_ptr -> Ptr ECrossing -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ECrossing
hsc_ptr Int
56) Ptr ECrossing
ptr :: IO Word32)
{-# LINE 594 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventCrossingFocus :: EventM ECrossing Bool
eventCrossingFocus :: EventM ECrossing Bool
eventCrossingFocus = ReaderT (Ptr ECrossing) IO (Ptr ECrossing)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr ECrossing) IO (Ptr ECrossing)
-> (Ptr ECrossing -> EventM ECrossing Bool)
-> EventM ECrossing Bool
forall a b.
ReaderT (Ptr ECrossing) IO a
-> (a -> ReaderT (Ptr ECrossing) IO b)
-> ReaderT (Ptr ECrossing) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ECrossing
ptr -> IO Bool -> EventM ECrossing Bool
forall a. IO a -> ReaderT (Ptr ECrossing) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM ECrossing Bool)
-> IO Bool -> EventM ECrossing Bool
forall a b. (a -> b) -> a -> b
$ (Int32 -> Bool) -> IO Int32 -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int32 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
((\Ptr ECrossing
hsc_ptr -> Ptr ECrossing -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ECrossing
hsc_ptr Int
60) Ptr ECrossing
ptr :: IO Int32)
{-# LINE 599 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventFocusIn :: EventM EFocus Bool
eventFocusIn :: EventM EFocus Bool
eventFocusIn = ReaderT (Ptr EFocus) IO (Ptr EFocus)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EFocus) IO (Ptr EFocus)
-> (Ptr EFocus -> EventM EFocus Bool) -> EventM EFocus Bool
forall a b.
ReaderT (Ptr EFocus) IO a
-> (a -> ReaderT (Ptr EFocus) IO b) -> ReaderT (Ptr EFocus) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EFocus
ptr -> IO Bool -> EventM EFocus Bool
forall a. IO a -> ReaderT (Ptr EFocus) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EFocus Bool) -> IO Bool -> EventM EFocus Bool
forall a b. (a -> b) -> a -> b
$ (Int16 -> Bool) -> IO Int16 -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int16 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
((\Ptr EFocus
hsc_ptr -> Ptr EFocus -> Int -> IO Int16
forall b. Ptr b -> Int -> IO Int16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EFocus
hsc_ptr Int
10) Ptr EFocus
ptr :: IO Int16)
{-# LINE 604 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventPosition :: EventM EConfigure (Int,Int)
eventPosition :: EventM EConfigure (Int, Int)
eventPosition = ReaderT (Ptr EConfigure) IO (Ptr EConfigure)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EConfigure) IO (Ptr EConfigure)
-> (Ptr EConfigure -> EventM EConfigure (Int, Int))
-> EventM EConfigure (Int, Int)
forall a b.
ReaderT (Ptr EConfigure) IO a
-> (a -> ReaderT (Ptr EConfigure) IO b)
-> ReaderT (Ptr EConfigure) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EConfigure
ptr -> IO (Int, Int) -> EventM EConfigure (Int, Int)
forall a. IO a -> ReaderT (Ptr EConfigure) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> EventM EConfigure (Int, Int))
-> IO (Int, Int) -> EventM EConfigure (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
(Int32
x :: Int32) <- (\Ptr EConfigure
hsc_ptr -> Ptr EConfigure -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EConfigure
hsc_ptr Int
12) Ptr EConfigure
ptr
{-# LINE 609 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 610 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral x, fromIntegral y)
eventSize :: EventM EConfigure (Int,Int)
eventSize :: EventM EConfigure (Int, Int)
eventSize = ReaderT (Ptr EConfigure) IO (Ptr EConfigure)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EConfigure) IO (Ptr EConfigure)
-> (Ptr EConfigure -> EventM EConfigure (Int, Int))
-> EventM EConfigure (Int, Int)
forall a b.
ReaderT (Ptr EConfigure) IO a
-> (a -> ReaderT (Ptr EConfigure) IO b)
-> ReaderT (Ptr EConfigure) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EConfigure
ptr -> IO (Int, Int) -> EventM EConfigure (Int, Int)
forall a. IO a -> ReaderT (Ptr EConfigure) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> EventM EConfigure (Int, Int))
-> IO (Int, Int) -> EventM EConfigure (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
(Int32
x :: Int32) <- (\Ptr EConfigure
hsc_ptr -> Ptr EConfigure -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EConfigure
hsc_ptr Int
20) Ptr EConfigure
ptr
{-# LINE 616 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
(y :: Int32) <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 617 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
return (fromIntegral x, fromIntegral y)
eventProperty :: EventM EProperty Atom
eventProperty :: EventM EProperty Atom
eventProperty = ReaderT (Ptr EProperty) IO (Ptr EProperty)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EProperty) IO (Ptr EProperty)
-> (Ptr EProperty -> EventM EProperty Atom)
-> EventM EProperty Atom
forall a b.
ReaderT (Ptr EProperty) IO a
-> (a -> ReaderT (Ptr EProperty) IO b)
-> ReaderT (Ptr EProperty) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EProperty
ptr -> IO Atom -> EventM EProperty Atom
forall a. IO a -> ReaderT (Ptr EProperty) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Atom -> EventM EProperty Atom)
-> IO Atom -> EventM EProperty Atom
forall a b. (a -> b) -> a -> b
$ (Ptr () -> Atom) -> IO (Ptr ()) -> IO Atom
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr () -> Atom
Atom
((\Ptr EProperty
hsc_ptr -> Ptr EProperty -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EProperty
hsc_ptr Int
12) Ptr EProperty
ptr :: IO (Ptr ()))
{-# LINE 622 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventWindowStateChanged :: EventM EWindowState [WindowState]
eventWindowStateChanged :: EventM EWindowState [WindowState]
eventWindowStateChanged = ReaderT (Ptr EWindowState) IO (Ptr EWindowState)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EWindowState) IO (Ptr EWindowState)
-> (Ptr EWindowState -> EventM EWindowState [WindowState])
-> EventM EWindowState [WindowState]
forall a b.
ReaderT (Ptr EWindowState) IO a
-> (a -> ReaderT (Ptr EWindowState) IO b)
-> ReaderT (Ptr EWindowState) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EWindowState
ptr -> IO [WindowState] -> EventM EWindowState [WindowState]
forall a. IO a -> ReaderT (Ptr EWindowState) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WindowState] -> EventM EWindowState [WindowState])
-> IO [WindowState] -> EventM EWindowState [WindowState]
forall a b. (a -> b) -> a -> b
$ (Word32 -> [WindowState]) -> IO Word32 -> IO [WindowState]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [WindowState]
forall a. Flags a => Int -> [a]
toFlags (Int -> [WindowState])
-> (Word32 -> Int) -> Word32 -> [WindowState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr EWindowState
hsc_ptr -> Ptr EWindowState -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EWindowState
hsc_ptr Int
12) Ptr EWindowState
ptr :: IO Word32)
{-# LINE 627 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventWindowState :: EventM EWindowState [WindowState]
eventWindowState :: EventM EWindowState [WindowState]
eventWindowState = ReaderT (Ptr EWindowState) IO (Ptr EWindowState)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EWindowState) IO (Ptr EWindowState)
-> (Ptr EWindowState -> EventM EWindowState [WindowState])
-> EventM EWindowState [WindowState]
forall a b.
ReaderT (Ptr EWindowState) IO a
-> (a -> ReaderT (Ptr EWindowState) IO b)
-> ReaderT (Ptr EWindowState) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EWindowState
ptr -> IO [WindowState] -> EventM EWindowState [WindowState]
forall a. IO a -> ReaderT (Ptr EWindowState) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WindowState] -> EventM EWindowState [WindowState])
-> IO [WindowState] -> EventM EWindowState [WindowState]
forall a b. (a -> b) -> a -> b
$ (Word32 -> [WindowState]) -> IO Word32 -> IO [WindowState]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [WindowState]
forall a. Flags a => Int -> [a]
toFlags (Int -> [WindowState])
-> (Word32 -> Int) -> Word32 -> [WindowState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr EWindowState
hsc_ptr -> Ptr EWindowState -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EWindowState
hsc_ptr Int
16) Ptr EWindowState
ptr :: IO Word32)
{-# LINE 632 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 634 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventChangeReason :: EventM EOwnerChange OwnerChange
eventChangeReason :: EventM EOwnerChange OwnerChange
eventChangeReason = ReaderT (Ptr EOwnerChange) IO (Ptr EOwnerChange)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EOwnerChange) IO (Ptr EOwnerChange)
-> (Ptr EOwnerChange -> EventM EOwnerChange OwnerChange)
-> EventM EOwnerChange OwnerChange
forall a b.
ReaderT (Ptr EOwnerChange) IO a
-> (a -> ReaderT (Ptr EOwnerChange) IO b)
-> ReaderT (Ptr EOwnerChange) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EOwnerChange
ptr -> IO OwnerChange -> EventM EOwnerChange OwnerChange
forall a. IO a -> ReaderT (Ptr EOwnerChange) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OwnerChange -> EventM EOwnerChange OwnerChange)
-> IO OwnerChange -> EventM EOwnerChange OwnerChange
forall a b. (a -> b) -> a -> b
$ (Word32 -> OwnerChange) -> IO Word32 -> IO OwnerChange
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> OwnerChange
forall a. Enum a => Int -> a
toEnum (Int -> OwnerChange) -> (Word32 -> Int) -> Word32 -> OwnerChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((\Ptr EOwnerChange
hsc_ptr -> Ptr EOwnerChange -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EOwnerChange
hsc_ptr Int
16) Ptr EOwnerChange
ptr :: IO Word32)
{-# LINE 638 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventSelection :: EventM EOwnerChange SelectionTag
eventSelection :: EventM EOwnerChange Atom
eventSelection = ReaderT (Ptr EOwnerChange) IO (Ptr EOwnerChange)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EOwnerChange) IO (Ptr EOwnerChange)
-> (Ptr EOwnerChange -> EventM EOwnerChange Atom)
-> EventM EOwnerChange Atom
forall a b.
ReaderT (Ptr EOwnerChange) IO a
-> (a -> ReaderT (Ptr EOwnerChange) IO b)
-> ReaderT (Ptr EOwnerChange) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EOwnerChange
ptr -> IO Atom -> EventM EOwnerChange Atom
forall a. IO a -> ReaderT (Ptr EOwnerChange) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Atom -> EventM EOwnerChange Atom)
-> IO Atom -> EventM EOwnerChange Atom
forall a b. (a -> b) -> a -> b
$ (Ptr () -> Atom) -> IO (Ptr ()) -> IO Atom
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr () -> Atom
Atom
((\Ptr EOwnerChange
hsc_ptr -> Ptr EOwnerChange -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EOwnerChange
hsc_ptr Int
20) Ptr EOwnerChange
ptr :: IO (Ptr ()))
{-# LINE 643 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventSelectionTime :: EventM EOwnerChange TimeStamp
eventSelectionTime :: EventM EOwnerChange Word32
eventSelectionTime = ReaderT (Ptr EOwnerChange) IO (Ptr EOwnerChange)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EOwnerChange) IO (Ptr EOwnerChange)
-> (Ptr EOwnerChange -> EventM EOwnerChange Word32)
-> EventM EOwnerChange Word32
forall a b.
ReaderT (Ptr EOwnerChange) IO a
-> (a -> ReaderT (Ptr EOwnerChange) IO b)
-> ReaderT (Ptr EOwnerChange) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EOwnerChange
ptr -> IO Word32 -> EventM EOwnerChange Word32
forall a. IO a -> ReaderT (Ptr EOwnerChange) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> EventM EOwnerChange Word32)
-> IO Word32 -> EventM EOwnerChange Word32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
((\Ptr EOwnerChange
hsc_ptr -> Ptr EOwnerChange -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EOwnerChange
hsc_ptr Int
28) Ptr EOwnerChange
ptr :: IO (Word32))
{-# LINE 648 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 649 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 651 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventKeyboardGrab :: EventM EGrabBroken Bool
eventKeyboardGrab :: EventM EGrabBroken Bool
eventKeyboardGrab = ReaderT (Ptr EGrabBroken) IO (Ptr EGrabBroken)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EGrabBroken) IO (Ptr EGrabBroken)
-> (Ptr EGrabBroken -> EventM EGrabBroken Bool)
-> EventM EGrabBroken Bool
forall a b.
ReaderT (Ptr EGrabBroken) IO a
-> (a -> ReaderT (Ptr EGrabBroken) IO b)
-> ReaderT (Ptr EGrabBroken) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EGrabBroken
ptr -> IO Bool -> EventM EGrabBroken Bool
forall a. IO a -> ReaderT (Ptr EGrabBroken) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EGrabBroken Bool)
-> IO Bool -> EventM EGrabBroken Bool
forall a b. (a -> b) -> a -> b
$ (Int32 -> Bool) -> IO Int32 -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int32 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
((\Ptr EGrabBroken
hsc_ptr -> Ptr EGrabBroken -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EGrabBroken
hsc_ptr Int
12) Ptr EGrabBroken
ptr :: IO Int32)
{-# LINE 656 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventImplicit :: EventM EGrabBroken Bool
eventImplicit :: EventM EGrabBroken Bool
eventImplicit = ReaderT (Ptr EGrabBroken) IO (Ptr EGrabBroken)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EGrabBroken) IO (Ptr EGrabBroken)
-> (Ptr EGrabBroken -> EventM EGrabBroken Bool)
-> EventM EGrabBroken Bool
forall a b.
ReaderT (Ptr EGrabBroken) IO a
-> (a -> ReaderT (Ptr EGrabBroken) IO b)
-> ReaderT (Ptr EGrabBroken) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EGrabBroken
ptr -> IO Bool -> EventM EGrabBroken Bool
forall a. IO a -> ReaderT (Ptr EGrabBroken) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EGrabBroken Bool)
-> IO Bool -> EventM EGrabBroken Bool
forall a b. (a -> b) -> a -> b
$ (Int32 -> Bool) -> IO Int32 -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int32 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
((\Ptr EGrabBroken
hsc_ptr -> Ptr EGrabBroken -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EGrabBroken
hsc_ptr Int
16) Ptr EGrabBroken
ptr :: IO Int32)
{-# LINE 661 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
eventGrabWindow :: EventM EGrabBroken (Maybe DrawWindow)
eventGrabWindow :: EventM EGrabBroken (Maybe DrawWindow)
eventGrabWindow = do
Ptr EGrabBroken
ptr <- ReaderT (Ptr EGrabBroken) IO (Ptr EGrabBroken)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Maybe DrawWindow) -> EventM EGrabBroken (Maybe DrawWindow)
forall a. IO a -> ReaderT (Ptr EGrabBroken) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DrawWindow) -> EventM EGrabBroken (Maybe DrawWindow))
-> IO (Maybe DrawWindow) -> EventM EGrabBroken (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$ (IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow) ((\Ptr EGrabBroken
hsc_ptr -> Ptr EGrabBroken -> Int -> IO (Ptr DrawWindow)
forall b. Ptr b -> Int -> IO (Ptr DrawWindow)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EGrabBroken
hsc_ptr Int
4) Ptr EGrabBroken
ptr)
{-# LINE 668 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
{-# LINE 669 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
tryEvent :: EventM any () -> EventM any Bool
tryEvent :: forall any. EventM any () -> EventM any Bool
tryEvent EventM any ()
act = do
Ptr any
ptr <- ReaderT (Ptr any) IO (Ptr any)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Bool -> EventM any Bool
forall a. IO a -> ReaderT (Ptr any) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM any Bool) -> IO Bool -> EventM any Bool
forall a b. (a -> b) -> a -> b
$ (EventM any Bool -> Ptr any -> IO Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM any ()
act EventM any () -> EventM any Bool -> EventM any Bool
forall a b.
ReaderT (Ptr any) IO a
-> ReaderT (Ptr any) IO b -> ReaderT (Ptr any) IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> EventM any Bool
forall a. a -> ReaderT (Ptr any) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Ptr any
ptr)
{-# LINE 678 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
`catches` [ (PatternMatchFail -> IO Bool) -> Handler Bool
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\ (PatternMatchFail [Char]
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
, (IOError -> IO Bool) -> Handler Bool
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\ IOError
e -> if IOError -> Bool
isUserError IOError
e Bool -> Bool -> Bool
&&
([Char]
"Pattern" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` IOError -> [Char]
ioeGetErrorString IOError
e Bool -> Bool -> Bool
||
[Char]
"mzero" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== IOError -> [Char]
ioeGetErrorString IOError
e)
then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else IOError -> IO Bool
forall a e. Exception e => e -> a
throw IOError
e) ]
{-# LINE 694 "Graphics/UI/Gtk/Gdk/EventM.hsc" #-}
stopEvent :: EventM any ()
stopEvent :: forall any. EventM any ()
stopEvent =
IO () -> ReaderT (Ptr any) IO ()
forall a. IO a -> ReaderT (Ptr any) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (Ptr any) IO ())
-> IO () -> ReaderT (Ptr any) IO ()
forall a b. (a -> b) -> a -> b
$ PatternMatchFail -> IO ()
forall a e. Exception e => e -> a
throw ([Char] -> PatternMatchFail
PatternMatchFail [Char]
"EventM.stopEvent called explicitly")