{-# OPTIONS_GHC -optc-D__HUGS__ #-}
{-# INCLUDE "HsXlib.h" #-}
{-# LINE 1 "Event.hsc" #-}
-----------------------------------------------------------------------------
{-# LINE 2 "Event.hsc" #-}
-- |
-- Module      :  Graphics.X11.Xlib.Event
-- Copyright   :  (c) Alastair Reid, 1999-2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of FFI declarations for interfacing with Xlib Events.
--
-----------------------------------------------------------------------------

module Graphics.X11.Xlib.Event(
        QueuedMode,
        queuedAlready,
        queuedAfterFlush,
        queuedAfterReading,
        XEvent,
        XEventPtr,
        allocaXEvent,
        get_EventType,
        get_Window,
        XKeyEvent,
        XKeyEventPtr,
        asKeyEvent,
        XButtonEvent,
        get_KeyEvent,
        get_ButtonEvent,
        get_MotionEvent,
        XMotionEvent,
        XExposeEvent,
        get_ExposeEvent,
        XMappingEvent,
        XConfigureEvent,
        get_ConfigureEvent,
        waitForEvent,
        gettimeofday_in_milliseconds,
        -- gettimeofday_in_milliseconds_internal,
        flush,
        sync,
        pending,
        eventsQueued,
        nextEvent,
        allowEvents,
        selectInput,
        sendEvent,
        windowEvent,
        checkWindowEvent,
        maskEvent,
        checkMaskEvent,
        checkTypedEvent,
        checkTypedWindowEvent,
        putBackEvent,
        peekEvent,
        refreshKeyboardMapping,

        ) where

import Graphics.X11.Types
import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Display( connectionNumber )

import Foreign


{-# LINE 68 "Event.hsc" #-}

{-# CFILES cbits/fdset.c #-}

----------------------------------------------------------------
-- Events
----------------------------------------------------------------

type   QueuedMode   = Int
queuedAlready	 :: QueuedMode
queuedAlready	 =  0
queuedAfterFlush	 :: QueuedMode
queuedAfterFlush	 =  2
queuedAfterReading	 :: QueuedMode
queuedAfterReading	 =  1

{-# LINE 81 "Event.hsc" #-}

-- Because of the way the corresponding C types are defined,
-- These "structs" are somewhat unusual - they omit fields which can
-- be found in more general structs.
-- For example, XAnyEvent omits type since it is in XEvent.
-- Therefore, to get the complete contents of an event one typically
-- writes:
--   do
--     ty <- get_XEvent e
--     (serial,send_event,display,window) <- get_XAnyEvent
--     window' <- get_XDestroyWindowEvent

newtype XEvent = XEvent XEventPtr
type XEventPtr = Ptr XEvent

allocaXEvent :: (XEventPtr -> IO a) -> IO a
allocaXEvent = allocaBytes (96)
{-# LINE 98 "Event.hsc" #-}

get_EventType :: XEventPtr -> IO EventType
get_EventType = (\hsc_ptr -> peekByteOff hsc_ptr 0)
{-# LINE 101 "Event.hsc" #-}

get_Window :: XEventPtr -> IO Window
get_Window = (\hsc_ptr -> peekByteOff hsc_ptr 16)
{-# LINE 104 "Event.hsc" #-}

-- %struct : XAnyEvent : XAnyEvent arg1
--   Int32     : serial            # # of last request processed by server
--   Bool      : send_event        # true if this came from a SendEvent request
--   Display   : display           # Display the event was read from
--   Window    : window            # window on which event was requested in event mask

type XKeyEvent =
	( Window    -- root window that the event occured on
	, Window    -- child window
	, Time      -- milliseconds
	, Int       -- pointer x, y coordinates in event window
	, Int       --
	, Int       -- coordinates relative to root
	, Int       --
	, Modifier  -- key or button mask
	, KeyCode   -- detail
	, Bool      -- same screen flag
	)

peekXKeyEvent :: Ptr XKeyEvent -> IO XKeyEvent
peekXKeyEvent p = do
	root		<- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
{-# LINE 127 "Event.hsc" #-}
	subwindow	<- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 128 "Event.hsc" #-}
	time		<- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
{-# LINE 129 "Event.hsc" #-}
	x		<- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
{-# LINE 130 "Event.hsc" #-}
	y		<- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
{-# LINE 131 "Event.hsc" #-}
	x_root		<- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
{-# LINE 132 "Event.hsc" #-}
	y_root		<- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
{-# LINE 133 "Event.hsc" #-}
	state		<- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
{-# LINE 134 "Event.hsc" #-}
	keycode		<- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
{-# LINE 135 "Event.hsc" #-}
	same_screen	<- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
{-# LINE 136 "Event.hsc" #-}
	return (root, subwindow, time, x, y, x_root, y_root,
		state, keycode, same_screen)

get_KeyEvent :: XEventPtr -> IO XKeyEvent
get_KeyEvent p = peekXKeyEvent (castPtr p)

type XKeyEventPtr   = Ptr XKeyEvent

asKeyEvent :: XEventPtr -> XKeyEventPtr
asKeyEvent = castPtr

type XButtonEvent =
	( Window    --	root window that the event occured on
	, Window    --	child window
	, Time      --	milliseconds
	, Int       --	pointer x, y coordinates in event window
	, Int
	, Int       --	coordinates relative to root
	, Int
	, Modifier  --	key or button mask
	, Button    --	detail
	, Bool      --	same screen flag
	)

peekXButtonEvent :: Ptr XButtonEvent -> IO XButtonEvent
peekXButtonEvent p = do
	root		<- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
{-# LINE 163 "Event.hsc" #-}
	subwindow	<- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 164 "Event.hsc" #-}
	time		<- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
{-# LINE 165 "Event.hsc" #-}
	x		<- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
{-# LINE 166 "Event.hsc" #-}
	y		<- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
{-# LINE 167 "Event.hsc" #-}
	x_root		<- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
{-# LINE 168 "Event.hsc" #-}
	y_root		<- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
{-# LINE 169 "Event.hsc" #-}
	state		<- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
{-# LINE 170 "Event.hsc" #-}
	button		<- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
{-# LINE 171 "Event.hsc" #-}
	same_screen	<- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
{-# LINE 172 "Event.hsc" #-}
	return (root, subwindow, time, x, y, x_root, y_root,
		state, button, same_screen)

get_ButtonEvent :: XEventPtr -> IO XButtonEvent
get_ButtonEvent p = peekXButtonEvent (castPtr p)

type XMotionEvent =
	( Window      -- root window that the event occured on
	, Window      -- child window
	, Time        -- milliseconds
	, Int         -- pointer x, y coordinates in event window
	, Int
	, Int         -- coordinates relative to root
	, Int
	, Modifier    -- key or button mask
	, NotifyMode  -- detail
	, Bool        -- same screen flag
	)

peekXMotionEvent :: Ptr XMotionEvent -> IO XMotionEvent
peekXMotionEvent p = do
	root		<- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
{-# LINE 194 "Event.hsc" #-}
	subwindow	<- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 195 "Event.hsc" #-}
	time		<- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
{-# LINE 196 "Event.hsc" #-}
	x		<- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
{-# LINE 197 "Event.hsc" #-}
	y		<- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
{-# LINE 198 "Event.hsc" #-}
	x_root		<- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
{-# LINE 199 "Event.hsc" #-}
	y_root		<- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
{-# LINE 200 "Event.hsc" #-}
	state		<- (\hsc_ptr -> peekByteOff hsc_ptr 48) p
{-# LINE 201 "Event.hsc" #-}
	is_hint		<- (\hsc_ptr -> peekByteOff hsc_ptr 52) p
{-# LINE 202 "Event.hsc" #-}
	same_screen	<- (\hsc_ptr -> peekByteOff hsc_ptr 56) p
{-# LINE 203 "Event.hsc" #-}
	return (root, subwindow, time, x, y, x_root, y_root,
		state, is_hint, same_screen)

get_MotionEvent :: XEventPtr -> IO XMotionEvent
get_MotionEvent p = peekXMotionEvent (castPtr p)

-- %struct : XCrossingEvent : XCrossingEvent arg1
--   Window       : root 	        # root window that the event occured on
--   Window       : subwindow 	# child window
--   Time         : time 		# milliseconds
--   Int          : x 		# pointer x, y coordinates in event window
--   Int          : y
--   Int          : x_root	 	# coordinates relative to root
--   Int          : y_root
--   NotifyMode   : mode
--   NotifyDetail : detail
--   Bool         : same_screen	# same screen flag
--   Bool         : focus		# boolean focus
--   Modifier     : state	        # key or button mask
--
-- %struct : XFocusChangeEvent : XFocusChangeEvent arg1
--   NotifyMode   : mode
--   NotifyDetail : detail
--
-- -- omitted: should be translated into bitmaps
-- -- PURE void	getKeymapEvent(event)
-- -- IN XEvent*	event
-- -- OUT Window	window	 	= ((XKeymapEvent*)event)->window
-- -- OUT array[32] Char key_vector 	= ((XKeymapEvent*)event)->key_vector
-- -- RESULT:

type XExposeEvent =
	( Position	-- x
	, Position	-- y
	, Dimension	-- width
	, Dimension	-- height
	, Int		-- count
	)

peekXExposeEvent :: Ptr XExposeEvent -> IO XExposeEvent
peekXExposeEvent p = do
	x	<- (\hsc_ptr -> peekByteOff hsc_ptr 20) p
{-# LINE 245 "Event.hsc" #-}
	y	<- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 246 "Event.hsc" #-}
	width	<- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
{-# LINE 247 "Event.hsc" #-}
	height	<- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
{-# LINE 248 "Event.hsc" #-}
	count	<- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
{-# LINE 249 "Event.hsc" #-}
	return (x, y, width, height, count)

get_ExposeEvent :: XEventPtr -> IO XExposeEvent
get_ExposeEvent p = peekXExposeEvent (castPtr p)

-- %struct : XGraphicsExposeEvent : XGraphicsExposeEvent arg1
--   Position	: x
--   Position	: y
--   Dimension	: width	 	.
--   Dimension	: height
--   Int		: count
--   Int		: major_code
--   Int		: minor_code
--
-- %struct : XCirculateEvent : XCirculateEvent arg1
--   Window	: window
--   Place		: place
--
-- %struct : XConfigureEvent : XConfigureEvent arg1
--   Window	: window
--   Position	: x
--   Position	: y
--   Dimension	: width
--   Dimension	: height
--   Dimension	: border_width
--   Window	: above
--   Bool	        : override_redirect
--
-- %struct : XCreateWindowEvent : XCreateWindowEvent arg1
--   Window	: window
--   Position	: x
--   Position	: y
--   Dimension	: width
--   Dimension	: height
--   Dimension	: border_width
--   Bool	        : override_redirect
--
-- %struct : XDestroyWindowEvent : XDestroyWindowEvent arg1
--   Window	: window
--
-- %struct : XGravityEvent : XGravityEvent arg1
--   Window	: window
--   Position	: x
--   Position	: y
--
-- %struct : XMapEvent : XMapEvent arg1
--   Bool	        : override_redirect

type XMappingEvent =
	( MappingRequest  -- request
	, KeyCode	  -- first_keycode
	, Int		  -- count
	)

withXMappingEvent :: XMappingEvent -> (Ptr XMappingEvent -> IO a) -> IO a
withXMappingEvent event_map f =
	allocaBytes (32) $ \ event_map_ptr -> do
{-# LINE 306 "Event.hsc" #-}
	pokeXMappingEvent event_map_ptr event_map
	f event_map_ptr

pokeXMappingEvent :: Ptr XMappingEvent -> XMappingEvent -> IO ()
pokeXMappingEvent p (request, first_keycode, count) = do
	(\hsc_ptr -> pokeByteOff hsc_ptr 20)		p request
{-# LINE 312 "Event.hsc" #-}
	(\hsc_ptr -> pokeByteOff hsc_ptr 24)	p first_keycode
{-# LINE 313 "Event.hsc" #-}
	(\hsc_ptr -> pokeByteOff hsc_ptr 28)		p count
{-# LINE 314 "Event.hsc" #-}

type XConfigureEvent =
	( Position
	, Position
	, Dimension
	, Dimension
	)

peekXConfigureEvent :: Ptr XConfigureEvent -> IO XConfigureEvent
peekXConfigureEvent p = do
	x	<- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 325 "Event.hsc" #-}
	y	<- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
{-# LINE 326 "Event.hsc" #-}
	width	<- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
{-# LINE 327 "Event.hsc" #-}
	height	<- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
{-# LINE 328 "Event.hsc" #-}
	return (x, y, width, height)

get_ConfigureEvent :: XEventPtr -> IO XConfigureEvent
get_ConfigureEvent p = peekXConfigureEvent (castPtr p)

-- %struct : XResizeRequestEvent : XResizeRequestEvent arg1
--   Dimension	: width
--   Dimension	: height
--

-- %struct : XReparentEvent : XReparentEvent arg1
--   Window	: window
--   Window	: parent
--   Position	: x
--   Position	: y
--   Bool	        : override_redirect
--
-- %struct : XUnmapEvent : XUnmapEvent arg1
--   Window	: window
--   Bool	        : from_configure
--
-- %struct : XVisibilityEvent : XVisibilityEvent arg1
--   Visibility	: state
--
-- %struct : XCirculateRequestEvent : XCirculateRequestEvent arg1
--   Place	        : place
--
-- -- omitted because valuemask looks tricky
-- -- %struct : XConfigureRequestEvent : XConfigureRequestEvent arg1
-- --   Window	 : window
-- --   Position	 : x
-- --   Position	 : y
-- --   Dimension	 : width
-- --   Dimension	 : height
-- --   Dimension	 : border_width
-- --   Window	 : above
-- --   StackingMethod : detail
-- --   ???	         : valuemask
--
-- %struct : XMapRequestEvent : XMapRequestEvent arg1
--   Window	: window
--
-- %struct : XColormapEvent : XColormapEvent arg1
--   Colormap		: colormap
--   Bool		        : new
--   ColormapNotification	: state
--
-- -- getClientMessageEvent omitted
-- -- getPropertyEvent omitted
-- -- getSelectionClearEvent omitted
-- -- getSelectionRequestEvent omitted
-- -- getSelectionEvent omitted

-- functions

-- The following is useful if you want to do a read with timeout.

-- | Reads an event with a timeout (in microseconds).
-- Returns True if timeout occurs.
waitForEvent :: Display -> Word32 -> IO Bool
waitForEvent display usecs =
	with (TimeVal (usecs `div` 1000000) (usecs `mod` 1000000)) $ \ tv_ptr ->
	allocaBytes (128) $ \ readfds ->
{-# LINE 391 "Event.hsc" #-}
	allocaBytes (128) $ \ nofds -> do
{-# LINE 392 "Event.hsc" #-}
	let fd = connectionNumber display
	fdZero readfds
	fdZero nofds
	fdSet fd readfds
	n <- select (fd+1) readfds nofds nofds tv_ptr
	return (n == 0)

newtype FdSet = FdSet (Ptr FdSet)

foreign import ccall unsafe "HsXlib.h" fdZero :: Ptr FdSet -> IO ()
foreign import ccall unsafe "HsXlib.h" fdSet :: Int -> Ptr FdSet -> IO ()

foreign import ccall unsafe "HsXlib.h" select ::
	Int -> Ptr FdSet -> Ptr FdSet -> Ptr FdSet -> Ptr TimeVal -> IO Int

-- | This function is somewhat compatible with Win32's @TimeGetTime()@
gettimeofday_in_milliseconds :: IO Integer
gettimeofday_in_milliseconds =
	alloca $ \ tv_ptr -> do
	rc <- gettimeofday tv_ptr nullPtr
	TimeVal sec usec <- peek tv_ptr
	return (toInteger sec * 1000 + toInteger usec `div` 1000)

data TimeVal = TimeVal Word32 Word32

instance Storable TimeVal where
	alignment _ = (4)
{-# LINE 419 "Event.hsc" #-}
	sizeOf _ = (8)
{-# LINE 420 "Event.hsc" #-}
	peek p = do
		sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 422 "Event.hsc" #-}
		usec <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 423 "Event.hsc" #-}
		return (TimeVal sec usec)
	poke p (TimeVal sec usec) = do
		(\hsc_ptr -> pokeByteOff hsc_ptr 0) p sec
{-# LINE 426 "Event.hsc" #-}
		(\hsc_ptr -> pokeByteOff hsc_ptr 4) p usec
{-# LINE 427 "Event.hsc" #-}

newtype TimeZone = TimeZone (Ptr TimeZone)

foreign import ccall unsafe "HsXlib.h"
	gettimeofday :: Ptr TimeVal -> Ptr TimeZone -> IO ()

-- | interface to the X11 library function @XFlush()@.
foreign import ccall unsafe "HsXlib.h XFlush"
	flush        :: Display ->               IO ()

-- | interface to the X11 library function @XSync()@.
foreign import ccall unsafe "HsXlib.h XSync"
	sync         :: Display -> Bool ->       IO ()

-- | interface to the X11 library function @XPending()@.
foreign import ccall unsafe "HsXlib.h XPending"
	pending      :: Display ->               IO Int

-- | interface to the X11 library function @XEventsQueued()@.
foreign import ccall unsafe "HsXlib.h XEventsQueued"
	eventsQueued :: Display -> QueuedMode -> IO Int

-- | interface to the X11 library function @XNextEvent()@.
foreign import ccall unsafe "HsXlib.h XNextEvent"
	nextEvent    :: Display -> XEventPtr  -> IO ()

-- | interface to the X11 library function @XAllowEvents()@.
foreign import ccall unsafe "HsXlib.h XAllowEvents"
	allowEvents  :: Display -> AllowEvents -> Time -> IO ()

-- ToDo: XFree(res1) after constructing result
-- %fun XGetMotionEvents :: Display -> Window -> Time -> Time -> IO ListXTimeCoord
-- %code res1 = XGetMotionEvents(arg1,arg2,arg3,arg4,&res1_size)

-- | interface to the X11 library function @XSelectInput()@.
foreign import ccall unsafe "HsXlib.h XSelectInput"
	selectInput :: Display -> Window -> EventMask -> IO ()

-- | interface to the X11 library function @XSendEvent()@.
sendEvent :: Display -> Window -> Bool -> EventMask -> XEventPtr -> IO ()
sendEvent display w propagate event_mask event_send =
	throwUnlessSuccess "sendEvent" $
		xSendEvent display w propagate event_mask event_send
foreign import ccall unsafe "HsXlib.h XSendEvent"
	xSendEvent :: Display -> Window -> Bool -> EventMask ->
		XEventPtr -> IO Status

-- | interface to the X11 library function @XWindowEvent()@.
foreign import ccall unsafe "HsXlib.h XWindowEvent"
	windowEvent :: Display -> Window -> EventMask -> XEventPtr -> IO ()

-- | interface to the X11 library function @XCheckWindowEvent()@.
foreign import ccall unsafe "HsXlib.h XCheckWindowEvent"
	checkWindowEvent :: Display -> Window -> EventMask ->
		XEventPtr -> IO Bool

-- | interface to the X11 library function @XMaskEvent()@.
foreign import ccall unsafe "HsXlib.h XMaskEvent"
	maskEvent :: Display -> EventMask -> XEventPtr -> IO ()

-- | interface to the X11 library function @XCheckMaskEvent()@.
foreign import ccall unsafe "HsXlib.h XCheckMaskEvent"
	checkMaskEvent :: Display -> EventMask -> XEventPtr -> IO Bool

-- | interface to the X11 library function @XCheckTypedEvent()@.
foreign import ccall unsafe "HsXlib.h XCheckTypedEvent"
	checkTypedEvent :: Display -> EventType -> XEventPtr -> IO Bool

-- | interface to the X11 library function @XCheckTypedWindowEvent()@.
foreign import ccall unsafe "HsXlib.h XCheckTypedWindowEvent"
	checkTypedWindowEvent :: Display -> Window -> EventType ->
		XEventPtr -> IO Bool

-- | interface to the X11 library function @XPutBackEvent()@.
foreign import ccall unsafe "HsXlib.h XPutBackEvent"
	putBackEvent :: Display -> XEventPtr -> IO ()

-- | interface to the X11 library function @XPeekEvent()@.
foreign import ccall unsafe "HsXlib.h XPeekEvent"
	peekEvent :: Display -> XEventPtr -> IO ()

-- XFilterEvent omitted (can't find documentation)
-- XIfEvent omitted (can't pass predicates (yet))
-- XCheckIfEvent omitted (can't pass predicates (yet))
-- XPeekIfEvent omitted (can't pass predicates (yet))

-- | interface to the X11 library function @XRefreshKeyboardMapping()@.
refreshKeyboardMapping :: XMappingEvent -> IO ()
refreshKeyboardMapping event_map =
	withXMappingEvent event_map $ \ event_map_ptr ->
	xRefreshKeyboardMapping event_map_ptr
foreign import ccall unsafe "HsXlib.h XRefreshKeyboardMapping"
	xRefreshKeyboardMapping :: Ptr XMappingEvent -> IO ()

-- XSynchronize omitted (returns C function)
-- XSetAfterFunction omitted (can't pass functions (yet))

----------------------------------------------------------------
-- End
----------------------------------------------------------------
