1{-# LANGUAGE DeriveDataTypeable #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Graphics.X11.Xlib.Event 5-- Copyright : (c) Alastair Reid, 1999-2003 6-- License : BSD-style (see the file libraries/base/LICENSE) 7-- 8-- Maintainer : libraries@haskell.org 9-- Stability : provisional 10-- Portability : portable 11-- 12-- A collection of FFI declarations for interfacing with Xlib Events. 13-- 14----------------------------------------------------------------------------- 15 16module Graphics.X11.Xlib.Event( 17 QueuedMode, 18 queuedAlready, 19 queuedAfterFlush, 20 queuedAfterReading, 21 XEvent(..), 22 XEventPtr, 23 allocaXEvent, 24 get_EventType, 25 get_Window, 26 XKeyEvent, 27 XKeyEventPtr, 28 asKeyEvent, 29 XButtonEvent, 30 get_KeyEvent, 31 get_ButtonEvent, 32 get_MotionEvent, 33 XMotionEvent, 34 XExposeEvent, 35 get_ExposeEvent, 36 XMappingEvent, 37 XConfigureEvent, 38 get_ConfigureEvent, 39 waitForEvent, 40 gettimeofday_in_milliseconds, 41 -- gettimeofday_in_milliseconds_internal, 42 flush, 43 sync, 44 pending, 45 eventsQueued, 46 nextEvent, 47 allowEvents, 48 selectInput, 49 sendEvent, 50 windowEvent, 51 checkWindowEvent, 52 maskEvent, 53 checkMaskEvent, 54 checkTypedEvent, 55 checkTypedWindowEvent, 56 putBackEvent, 57 peekEvent, 58 refreshKeyboardMapping, 59 60 ) where 61 62import Graphics.X11.Types 63import Graphics.X11.Xlib.Types 64import Graphics.X11.Xlib.Display( connectionNumber ) 65 66import Foreign 67import Foreign.C.Types 68 69#if __GLASGOW_HASKELL__ 70import Data.Data 71#endif 72 73#include "HsXlib.h" 74 75{-# CFILES cbits/fdset.c #-} 76 77---------------------------------------------------------------- 78-- Events 79---------------------------------------------------------------- 80 81type QueuedMode = CInt 82#{enum QueuedMode, 83 , queuedAlready = QueuedAlready 84 , queuedAfterFlush = QueuedAfterFlush 85 , queuedAfterReading = QueuedAfterReading 86 } 87 88-- Because of the way the corresponding C types are defined, 89-- These "structs" are somewhat unusual - they omit fields which can 90-- be found in more general structs. 91-- For example, XAnyEvent omits type since it is in XEvent. 92-- Therefore, to get the complete contents of an event one typically 93-- writes: 94-- do 95-- ty <- get_XEvent e 96-- (serial,send_event,display,window) <- get_XAnyEvent 97-- window' <- get_XDestroyWindowEvent 98 99newtype XEvent = XEvent XEventPtr 100#if __GLASGOW_HASKELL__ 101 deriving (Eq, Ord, Show, Typeable, Data) 102#else 103 deriving (Eq, Ord, Show) 104#endif 105type XEventPtr = Ptr XEvent 106 107allocaXEvent :: (XEventPtr -> IO a) -> IO a 108allocaXEvent = allocaBytes #{size XEvent} 109 110get_EventType :: XEventPtr -> IO EventType 111get_EventType = #{peek XEvent,type} 112 113get_Window :: XEventPtr -> IO Window 114get_Window = #{peek XAnyEvent,window} 115 116-- %struct : XAnyEvent : XAnyEvent arg1 117-- Int32 : serial # # of last request processed by server 118-- Bool : send_event # true if this came from a SendEvent request 119-- Display : display # Display the event was read from 120-- Window : window # window on which event was requested in event mask 121 122type XKeyEvent = 123 ( Window -- root window that the event occured on 124 , Window -- child window 125 , Time -- milliseconds 126 , CInt -- pointer x, y coordinates in event window 127 , CInt -- 128 , CInt -- coordinates relative to root 129 , CInt -- 130 , Modifier -- key or button mask 131 , KeyCode -- detail 132 , Bool -- same screen flag 133 ) 134 135peekXKeyEvent :: Ptr XKeyEvent -> IO XKeyEvent 136peekXKeyEvent p = do 137 root <- #{peek XKeyEvent,root} p 138 subwindow <- #{peek XKeyEvent,subwindow} p 139 time <- #{peek XKeyEvent,time} p 140 x <- #{peek XKeyEvent,x} p 141 y <- #{peek XKeyEvent,y} p 142 x_root <- #{peek XKeyEvent,x_root} p 143 y_root <- #{peek XKeyEvent,y_root} p 144 state <- (#{peek XKeyEvent,state} p) :: IO CUInt 145 keycode <- (#{peek XKeyEvent,keycode} p) :: IO CUInt 146 same_screen <- #{peek XKeyEvent,same_screen} p 147 return (root, subwindow, time, x, y, x_root, y_root, 148 fromIntegral state, fromIntegral keycode, same_screen) 149 150get_KeyEvent :: XEventPtr -> IO XKeyEvent 151get_KeyEvent p = peekXKeyEvent (castPtr p) 152 153type XKeyEventPtr = Ptr XKeyEvent 154 155asKeyEvent :: XEventPtr -> XKeyEventPtr 156asKeyEvent = castPtr 157 158type XButtonEvent = 159 ( Window -- root window that the event occured on 160 , Window -- child window 161 , Time -- milliseconds 162 , CInt -- pointer x, y coordinates in event window 163 , CInt 164 , CInt -- coordinates relative to root 165 , CInt 166 , Modifier -- key or button mask 167 , Button -- detail 168 , Bool -- same screen flag 169 ) 170 171peekXButtonEvent :: Ptr XButtonEvent -> IO XButtonEvent 172peekXButtonEvent p = do 173 root <- #{peek XButtonEvent,root} p 174 subwindow <- #{peek XButtonEvent,subwindow} p 175 time <- #{peek XButtonEvent,time} p 176 x <- #{peek XButtonEvent,x} p 177 y <- #{peek XButtonEvent,y} p 178 x_root <- #{peek XButtonEvent,x_root} p 179 y_root <- #{peek XButtonEvent,y_root} p 180 state <- #{peek XButtonEvent,state} p 181 button <- #{peek XButtonEvent,button} p 182 same_screen <- #{peek XButtonEvent,same_screen} p 183 return (root, subwindow, time, x, y, x_root, y_root, 184 state, button, same_screen) 185 186get_ButtonEvent :: XEventPtr -> IO XButtonEvent 187get_ButtonEvent p = peekXButtonEvent (castPtr p) 188 189type XMotionEvent = 190 ( Window -- root window that the event occured on 191 , Window -- child window 192 , Time -- milliseconds 193 , CInt -- pointer x, y coordinates in event window 194 , CInt 195 , CInt -- coordinates relative to root 196 , CInt 197 , Modifier -- key or button mask 198 , NotifyMode -- detail 199 , Bool -- same screen flag 200 ) 201 202peekXMotionEvent :: Ptr XMotionEvent -> IO XMotionEvent 203peekXMotionEvent p = do 204 root <- #{peek XMotionEvent,root} p 205 subwindow <- #{peek XMotionEvent,subwindow} p 206 time <- #{peek XMotionEvent,time} p 207 x <- #{peek XMotionEvent,x} p 208 y <- #{peek XMotionEvent,y} p 209 x_root <- #{peek XMotionEvent,x_root} p 210 y_root <- #{peek XMotionEvent,y_root} p 211 state <- #{peek XMotionEvent,state} p 212 is_hint <- #{peek XMotionEvent,is_hint} p 213 same_screen <- #{peek XMotionEvent,same_screen} p 214 return (root, subwindow, time, x, y, x_root, y_root, 215 state, is_hint, same_screen) 216 217get_MotionEvent :: XEventPtr -> IO XMotionEvent 218get_MotionEvent p = peekXMotionEvent (castPtr p) 219 220-- %struct : XCrossingEvent : XCrossingEvent arg1 221-- Window : root # root window that the event occured on 222-- Window : subwindow # child window 223-- Time : time # milliseconds 224-- Int : x # pointer x, y coordinates in event window 225-- Int : y 226-- Int : x_root # coordinates relative to root 227-- Int : y_root 228-- NotifyMode : mode 229-- NotifyDetail : detail 230-- Bool : same_screen # same screen flag 231-- Bool : focus # boolean focus 232-- Modifier : state # key or button mask 233-- 234-- %struct : XFocusChangeEvent : XFocusChangeEvent arg1 235-- NotifyMode : mode 236-- NotifyDetail : detail 237-- 238-- -- omitted: should be translated into bitmaps 239-- -- PURE void getKeymapEvent(event) 240-- -- IN XEvent* event 241-- -- OUT Window window = ((XKeymapEvent*)event)->window 242-- -- OUT array[32] Char key_vector = ((XKeymapEvent*)event)->key_vector 243-- -- RESULT: 244 245type XExposeEvent = 246 ( Position -- x 247 , Position -- y 248 , Dimension -- width 249 , Dimension -- height 250 , CInt -- count 251 ) 252 253peekXExposeEvent :: Ptr XExposeEvent -> IO XExposeEvent 254peekXExposeEvent p = do 255 x <- #{peek XExposeEvent,x} p 256 y <- #{peek XExposeEvent,y} p 257 width <- #{peek XExposeEvent,width} p 258 height <- #{peek XExposeEvent,height} p 259 count <- #{peek XExposeEvent,count} p 260 return (x, y, width, height, count) 261 262get_ExposeEvent :: XEventPtr -> IO XExposeEvent 263get_ExposeEvent p = peekXExposeEvent (castPtr p) 264 265-- %struct : XGraphicsExposeEvent : XGraphicsExposeEvent arg1 266-- Position : x 267-- Position : y 268-- Dimension : width . 269-- Dimension : height 270-- Int : count 271-- Int : major_code 272-- Int : minor_code 273-- 274-- %struct : XCirculateEvent : XCirculateEvent arg1 275-- Window : window 276-- Place : place 277-- 278-- %struct : XConfigureEvent : XConfigureEvent arg1 279-- Window : window 280-- Position : x 281-- Position : y 282-- Dimension : width 283-- Dimension : height 284-- Dimension : border_width 285-- Window : above 286-- Bool : override_redirect 287-- 288-- %struct : XCreateWindowEvent : XCreateWindowEvent arg1 289-- Window : window 290-- Position : x 291-- Position : y 292-- Dimension : width 293-- Dimension : height 294-- Dimension : border_width 295-- Bool : override_redirect 296-- 297-- %struct : XDestroyWindowEvent : XDestroyWindowEvent arg1 298-- Window : window 299-- 300-- %struct : XGravityEvent : XGravityEvent arg1 301-- Window : window 302-- Position : x 303-- Position : y 304-- 305-- %struct : XMapEvent : XMapEvent arg1 306-- Bool : override_redirect 307 308type XMappingEvent = 309 ( MappingRequest -- request 310 , KeyCode -- first_keycode 311 , CInt -- count 312 ) 313 314withXMappingEvent :: XMappingEvent -> (Ptr XMappingEvent -> IO a) -> IO a 315withXMappingEvent event_map f = 316 allocaBytes #{size XMappingEvent} $ \ event_map_ptr -> do 317 pokeXMappingEvent event_map_ptr event_map 318 f event_map_ptr 319 320pokeXMappingEvent :: Ptr XMappingEvent -> XMappingEvent -> IO () 321pokeXMappingEvent p (request, first_keycode, count) = do 322 #{poke XMappingEvent,request} p request 323 #{poke XMappingEvent,first_keycode} p first_keycode 324 #{poke XMappingEvent,count} p count 325 326type XConfigureEvent = 327 ( Position 328 , Position 329 , Dimension 330 , Dimension 331 ) 332 333peekXConfigureEvent :: Ptr XConfigureEvent -> IO XConfigureEvent 334peekXConfigureEvent p = do 335 x <- #{peek XConfigureEvent,x} p 336 y <- #{peek XConfigureEvent,y} p 337 width <- #{peek XConfigureEvent,width} p 338 height <- #{peek XConfigureEvent,height} p 339 return (x, y, width, height) 340 341get_ConfigureEvent :: XEventPtr -> IO XConfigureEvent 342get_ConfigureEvent p = peekXConfigureEvent (castPtr p) 343 344-- %struct : XResizeRequestEvent : XResizeRequestEvent arg1 345-- Dimension : width 346-- Dimension : height 347-- 348 349-- %struct : XReparentEvent : XReparentEvent arg1 350-- Window : window 351-- Window : parent 352-- Position : x 353-- Position : y 354-- Bool : override_redirect 355-- 356-- %struct : XUnmapEvent : XUnmapEvent arg1 357-- Window : window 358-- Bool : from_configure 359-- 360-- %struct : XVisibilityEvent : XVisibilityEvent arg1 361-- Visibility : state 362-- 363-- %struct : XCirculateRequestEvent : XCirculateRequestEvent arg1 364-- Place : place 365-- 366-- -- omitted because valuemask looks tricky 367-- -- %struct : XConfigureRequestEvent : XConfigureRequestEvent arg1 368-- -- Window : window 369-- -- Position : x 370-- -- Position : y 371-- -- Dimension : width 372-- -- Dimension : height 373-- -- Dimension : border_width 374-- -- Window : above 375-- -- StackingMethod : detail 376-- -- ??? : valuemask 377-- 378-- %struct : XMapRequestEvent : XMapRequestEvent arg1 379-- Window : window 380-- 381-- %struct : XColormapEvent : XColormapEvent arg1 382-- Colormap : colormap 383-- Bool : new 384-- ColormapNotification : state 385-- 386-- -- getClientMessageEvent omitted 387-- -- getPropertyEvent omitted 388-- -- getSelectionClearEvent omitted 389-- -- getSelectionRequestEvent omitted 390-- -- getSelectionEvent omitted 391-- -- xrrScreenChangeNotifyEvent omitted 392 393-- functions 394 395-- The following is useful if you want to do a read with timeout. 396 397-- | Reads an event with a timeout (in microseconds). 398-- Returns True if timeout occurs. 399waitForEvent :: Display -> Word32 -> IO Bool 400waitForEvent display usecs = 401 with (TimeVal (usecs `div` 1000000) (usecs `mod` 1000000)) $ \ tv_ptr -> 402 allocaBytes #{size fd_set} $ \ readfds -> 403 allocaBytes #{size fd_set} $ \ nofds -> do 404 let fd = connectionNumber display 405 fdZero readfds 406 fdZero nofds 407 fdSet (fromIntegral fd) readfds 408 n <- select ((fromIntegral fd)+1) readfds nofds nofds tv_ptr 409 return (n == 0) 410 411newtype FdSet = FdSet (Ptr FdSet) 412#if __GLASGOW_HASKELL__ 413 deriving (Eq, Ord, Show, Typeable, Data) 414#else 415 deriving (Eq, Ord, Show) 416#endif 417 418foreign import ccall unsafe "HsXlib.h" fdZero :: Ptr FdSet -> IO () 419foreign import ccall unsafe "HsXlib.h" fdSet :: CInt -> Ptr FdSet -> IO () 420 421foreign import ccall unsafe "HsXlib.h" select :: 422 CInt -> Ptr FdSet -> Ptr FdSet -> Ptr FdSet -> Ptr TimeVal -> IO CInt 423 424-- | This function is somewhat compatible with Win32's @TimeGetTime()@ 425gettimeofday_in_milliseconds :: IO Integer 426gettimeofday_in_milliseconds = 427 alloca $ \ tv_ptr -> do 428 _rc <- gettimeofday tv_ptr nullPtr 429 TimeVal sec usec <- peek tv_ptr 430 return (toInteger sec * 1000 + toInteger usec `div` 1000) 431 432data TimeVal = TimeVal Word32 Word32 433 434instance Storable TimeVal where 435 alignment _ = #{size int} 436 sizeOf _ = #{size struct timeval} 437 peek p = do 438 sec <- #{peek struct timeval,tv_sec} p 439 usec <- #{peek struct timeval,tv_usec} p 440 return (TimeVal sec usec) 441 poke p (TimeVal sec usec) = do 442 #{poke struct timeval,tv_sec} p sec 443 #{poke struct timeval,tv_usec} p usec 444 445newtype TimeZone = TimeZone (Ptr TimeZone) 446#if __GLASGOW_HASKELL__ 447 deriving (Eq, Ord, Show, Typeable, Data) 448#else 449 deriving (Eq, Ord, Show) 450#endif 451 452foreign import ccall unsafe "HsXlib.h" 453 gettimeofday :: Ptr TimeVal -> Ptr TimeZone -> IO () 454 455-- | interface to the X11 library function @XFlush()@. 456foreign import ccall unsafe "HsXlib.h XFlush" 457 flush :: Display -> IO () 458 459-- | interface to the X11 library function @XSync()@. 460foreign import ccall safe "HsXlib.h XSync" 461 sync :: Display -> Bool -> IO () 462 463-- | interface to the X11 library function @XPending()@. 464foreign import ccall unsafe "HsXlib.h XPending" 465 pending :: Display -> IO CInt 466 467-- | interface to the X11 library function @XEventsQueued()@. 468foreign import ccall unsafe "HsXlib.h XEventsQueued" 469 eventsQueued :: Display -> QueuedMode -> IO CInt 470 471-- | interface to the X11 library function @XNextEvent()@. 472foreign import ccall safe "HsXlib.h XNextEvent" 473 nextEvent :: Display -> XEventPtr -> IO () 474 475-- | interface to the X11 library function @XAllowEvents()@. 476foreign import ccall unsafe "HsXlib.h XAllowEvents" 477 allowEvents :: Display -> AllowEvents -> Time -> IO () 478 479-- ToDo: XFree(res1) after constructing result 480-- %fun XGetMotionEvents :: Display -> Window -> Time -> Time -> IO ListXTimeCoord 481-- %code res1 = XGetMotionEvents(arg1,arg2,arg3,arg4,&res1_size) 482 483-- | interface to the X11 library function @XSelectInput()@. 484foreign import ccall unsafe "HsXlib.h XSelectInput" 485 selectInput :: Display -> Window -> EventMask -> IO () 486 487-- | interface to the X11 library function @XSendEvent()@. 488sendEvent :: Display -> Window -> Bool -> EventMask -> XEventPtr -> IO () 489sendEvent display w propagate event_mask event_send = 490 throwIfZero "sendEvent" $ 491 xSendEvent display w propagate event_mask event_send 492foreign import ccall unsafe "HsXlib.h XSendEvent" 493 xSendEvent :: Display -> Window -> Bool -> EventMask -> 494 XEventPtr -> IO Status 495 496-- | interface to the X11 library function @XWindowEvent()@. 497foreign import ccall unsafe "HsXlib.h XWindowEvent" 498 windowEvent :: Display -> Window -> EventMask -> XEventPtr -> IO () 499 500-- | interface to the X11 library function @XCheckWindowEvent()@. 501foreign import ccall unsafe "HsXlib.h XCheckWindowEvent" 502 checkWindowEvent :: Display -> Window -> EventMask -> 503 XEventPtr -> IO Bool 504 505-- | interface to the X11 library function @XMaskEvent()@. 506foreign import ccall unsafe "HsXlib.h XMaskEvent" 507 maskEvent :: Display -> EventMask -> XEventPtr -> IO () 508 509-- | interface to the X11 library function @XCheckMaskEvent()@. 510foreign import ccall unsafe "HsXlib.h XCheckMaskEvent" 511 checkMaskEvent :: Display -> EventMask -> XEventPtr -> IO Bool 512 513-- | interface to the X11 library function @XCheckTypedEvent()@. 514foreign import ccall unsafe "HsXlib.h XCheckTypedEvent" 515 checkTypedEvent :: Display -> EventType -> XEventPtr -> IO Bool 516 517-- | interface to the X11 library function @XCheckTypedWindowEvent()@. 518foreign import ccall unsafe "HsXlib.h XCheckTypedWindowEvent" 519 checkTypedWindowEvent :: Display -> Window -> EventType -> 520 XEventPtr -> IO Bool 521 522-- | interface to the X11 library function @XPutBackEvent()@. 523foreign import ccall unsafe "HsXlib.h XPutBackEvent" 524 putBackEvent :: Display -> XEventPtr -> IO () 525 526-- | interface to the X11 library function @XPeekEvent()@. 527foreign import ccall unsafe "HsXlib.h XPeekEvent" 528 peekEvent :: Display -> XEventPtr -> IO () 529 530-- XFilterEvent omitted (can't find documentation) 531-- XIfEvent omitted (can't pass predicates (yet)) 532-- XCheckIfEvent omitted (can't pass predicates (yet)) 533-- XPeekIfEvent omitted (can't pass predicates (yet)) 534 535-- | interface to the X11 library function @XRefreshKeyboardMapping()@. 536refreshKeyboardMapping :: XMappingEvent -> IO () 537refreshKeyboardMapping event_map = 538 withXMappingEvent event_map $ \ event_map_ptr -> 539 xRefreshKeyboardMapping event_map_ptr 540foreign import ccall unsafe "HsXlib.h XRefreshKeyboardMapping" 541 xRefreshKeyboardMapping :: Ptr XMappingEvent -> IO () 542 543-- XSynchronize omitted (returns C function) 544-- XSetAfterFunction omitted (can't pass functions (yet)) 545 546---------------------------------------------------------------- 547-- End 548---------------------------------------------------------------- 549