File: Events.hsc

package info (click to toggle)
haskell-gtk 0.11.0-5
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 2,920 kB
  • ctags: 82
  • sloc: haskell: 1,929; ansic: 714; sh: 5; makefile: 3
file content (610 lines) | stat: -rw-r--r-- 23,698 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
{-# LANGUAGE ScopedTypeVariables #-}
-- -*-haskell-*-

#include <gtk/gtk.h>
#include "template-hsc-gtk2hs.h"

--  GIMP Toolkit (GTK) GDK Events
--
--  Author : Axel Simon
--
--  Created: 27 April 2001
--
--  Copyright (C) 2001-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users\@lists.sourceforge.net
-- Stability   : deprecated
-- Portability : portable (depends on GHC)
--
-- Definiton of a record that contains event information. Deprecated in
-- favor of 'Graphics.UI.Gtk.Gdk.EventM'.
--
module Graphics.UI.Gtk.Gdk.Events (
  Modifier(..),		-- a mask of control keys
  TimeStamp,
  currentTime,

  -- | Deprecated way of conveying event information.
  Event(..),		-- information in event callbacks from Gdk
  EventButton,
  EventScroll,
  EventMotion,
  EventExpose,
  EventKey,
  EventConfigure,
  EventCrossing,
  EventFocus,
  EventProperty,
  EventProximity,
  EventVisibility,
  EventWindowState,
  EventGrabBroken,

  marshExposeRect,

  -- selector functions
  marshalEvent,		-- convert a pointer to an event data structure
  -- used data structures
  VisibilityState(..),
  CrossingMode(..),
  NotifyType(..),
  WindowState(..),
  ScrollDirection(..),
  MouseButton(..),
  Click(..),
  Rectangle(..)
  ) where

import System.IO.Unsafe (unsafeInterleaveIO)
import System.Glib.FFI
import System.Glib.Flags
import System.Glib.GObject ( makeNewGObject )
import Graphics.UI.Gtk.Gdk.Keys		(KeyVal, keyvalToChar, keyvalName)
import Graphics.UI.Gtk.Gdk.Region       (Region, makeNewRegion)
import Graphics.UI.Gtk.Gdk.Enums	(Modifier(..),
                                         VisibilityState(..),
					 CrossingMode(..),
					 NotifyType(..),
					 WindowState(..),
					 ScrollDirection(..))
import Graphics.UI.Gtk.General.Enums	(MouseButton(..), Click(..))
import Graphics.UI.Gtk.General.Structs	(Rectangle(..))
import Graphics.UI.Gtk.Types ( DrawWindow, mkDrawWindow )

import Data.Bits ((.|.), (.&.), testBit, shiftL, shiftR)
import Data.Maybe (catMaybes)


-- | The time (in milliseconds) when an event happened. This is used mostly
-- for ordering events and responses to events.
--
type TimeStamp = Word32
-- TODO: make this a newtype

-- | Represents the current time, and can be used anywhere a time is expected.
currentTime :: TimeStamp
currentTime = #{const GDK_CURRENT_TIME}

-- Note on Event:
-- * 'Event' can communicate a small array of data to another widget. This
--   functionality is not bound as it can be done easier in Haskell.
--
-- * EventDND is not implemented as registering a DND source or sink
--   should be easier and sufficient for everything.
--
-- * EventProperty is not bound since it involves Atoms and its hard to see
--   how a Haskell application should extract the data. It should be possible
--   to connect directly to property-changed signals. If there is a need
--   to monitor a property for which there is no signal we could add
--   a trigger for just that property.
--
-- * EventSelection - I don\'t quite see how this works, so not bound.
--
-- * NoExpose - seems pointless: you copy from a drawable and this signal
--   tells you that it was up-to-date without redrawing. Maybe I'm missing
--   something.
--
-- * EventSetting informs about a change in setting that are shared among
--   several applications. They are probably not relevant to user defined
--   widgets. Anyway they don\'t make sense before GtkSettings isn\'t bound.
--
-- * Property is a TODO. These come from RC files which are useful for
--   custom widgets.

-- | An event that contains information on a button press.
type EventButton = Event

-- | An event that contains information on scrolling.
type EventScroll = Event

-- | An event that contains information on the movement of the mouse pointer.
type EventMotion = Event

-- | An area of the 'DrawWindow' needs redrawing.
type EventExpose = Event

-- | An event that contains information about a key press.
type EventKey = Event

-- | An event that contains the new size of a window.
type EventConfigure = Event

-- | Generated when the pointer enters or leaves a window.
type EventCrossing = Event

-- | An event that informs about a change of the input focus.
type EventFocus = Event

-- | An event that indicates a property of the window changed.
type EventProperty = Event

-- | An event that indicates that the pen of a graphics table is touching or
--   not touching the tablet.
type EventProximity = Event

-- | Parts of the window have been exposed or obscured.
type EventVisibility = Event

-- | The window state has changed.
type EventWindowState = Event

-- | A grab has been broken by unusual means.
type EventGrabBroken = Event

-- | Events that are delivered to a widget.
--
-- * Any given signal only emits one of these variants as described
--   in 'Graphics.UI.Gtk.Abstract.Widget.Widget'.
--   Many events share common attributes:
--
--   * The 'eventSent' attribute is @True@ if the event was not created by the
--      user but by another application.
--
--   * The 'eventTime' attribute contains a time in milliseconds when the event
--      happened.
--
--   * The 'eventX' and 'eventY' attributes contain the coordinates relative
--      to the 'Graphics.UI.Gtk.Abstract.Gdk.DrawWindow' associated with this
--      widget. The values can contain sub-pixel information if the input
--      device is a graphics tablet or the like.
--
--   * The 'eventModifier' attribute denotes what modifier key was pressed
--      during the event.
--
data Event =
  -- | An event that is not in one of the more specific categories below. This
  -- includes delete, destroy, map and unmap events. These events
  -- have no extra information associated with them.
  Event { eventSent :: Bool }
  -- | The expose event.
  --
  -- * A region of widget that receives this event needs to be redrawn.
  --   This event is the result of revealing part or all of a window
  --   or by the application calling functions like
  --   'Graphics.UI.Gtk.Abstract.Widget.widgetQueueDrawArea'.
  --
  | Expose {
    eventSent	:: Bool,
    -- | A bounding box denoting what needs to be updated. For a more
    -- detailed information on the area that needs redrawing, use the
    -- next field.
    eventArea	:: Rectangle,
    -- | A set of horizontal stripes that denote the invalid area.
    eventRegion      :: Region,

    -- | The number of contiguous 'Expose' events following this
    --   one. The only use for this is \"exposure compression\", i.e. 
    --   handling all contiguous 'Expose' events in one go, though Gdk
    --   performs some exposure compression so this is not normally needed.
    eventCount	:: Int }
  -- | Mouse motion.
  --
  -- * Captures the movement of the mouse cursor while it is within the area
  --   of the widget.
  --
  | Motion {
    eventSent	:: Bool,
    eventTime	:: TimeStamp,
    eventX,eventY	:: Double,
    eventModifier 	:: [Modifier],
    -- | Indicate if this event is only a hint of the motion.
    --
    -- * If the 'Graphics.UI.Gtk.Abstract.Widget.PointerMotionHintMask'
    --  is set with 'Data.Array.MArray.widgetAddEvents' then
    --   mouse positions are only generated each time
    --  'Graphics.UI.Gtk.Gdk.DrawWindow.drawWindowGetPointer'
    --   is called. In this case 'eventIsHint' is set to @True@.
    --
    eventIsHint	:: Bool,
    eventXRoot,
    eventYRoot	:: Double } 
  -- | A mouse button was pressed or released.
  --
  -- * This event is triggered if the mouse button was pressed or released
  --   while the mouse cursor was within the region of the widget.
  --
  | Button {
    eventSent	:: Bool,
    -- | The kind of button press, see 'Click'. Note that double clicks will
    --   trigger this event with 'eventClick' set to 'SingleClick',
    --   'ReleaseClick',
    --   'SingleClick', 'DoubleClick', 'ReleaseClick'. Triple clicks will
    --   produce this sequence followed by 'SingleClick', 'DoubleClick',
    --   'TripleClick', 'ReleaseClick'.
    eventClick	:: Click,
    -- | The time of the event in milliseconds.
    eventTime	:: TimeStamp,
    eventX,eventY	:: Double,
    eventModifier	:: [Modifier],
    -- | The button that was pressed.
    eventButton	:: MouseButton,
    -- | The coordinates of the click relative to the screen origin.
    eventXRoot,
    eventYRoot	:: Double }
  -- | A key was pressed while the widget had the input focus.
  --
  -- * If the widget has the current input focus (see
  --   'Graphics.UI.Gtk.Abstract.Widget.widgetSetCanFocus')
  --   it will receive key pressed events. Certain key combinations are of
  --   no interest to a normal widget like Alt-F to access the file menu.
  --   For all these keys, the handler must return @False@ to indicate that
  --   the key stroke should be propagated to the parent widget. At the
  --   top-level widget, keyboard shortcuts like Alt-F are turned into the
  --   corresponding signals.
  --
  | Key {
    -- | This flag is set if the key was released. This flag makes it possible
    --   to connect the same handler to
    --  'Graphics.UI.Gtk.Abstract.Widget.onKeyPress' and
    --  'Graphics.UI.Gtk.Abstract.Widget.onKeyRelease'.
    eventRelease	:: Bool,
    eventSent	:: Bool,
    eventTime	:: TimeStamp,
    eventModifier	:: [Modifier],
    -- | This flag is @True@ if Caps Lock is on while this key was pressed.
    eventWithCapsLock   :: Bool,
    -- | This flag is @True@ if Number Lock is on while this key was pressed.
    eventWithNumLock    :: Bool,
    -- | This flag is @True@ if Scroll Lock is on while this key was pressed.
    eventWithScrollLock :: Bool,
    -- | A number representing the key that was pressed or released. A more convenient
    --   interface is provided by the next two fields.
    eventKeyVal :: KeyVal,
    -- | A string representing the key that was pressed or released.
    --
    -- * This string contains a description of the key rather than what
    --   should appear on screen. For example, pressing "1" on the keypad
    --   results in "KP_1". Of particular interest are "F1" till "F12",
    --   for a complete list refer to \"<gdk/gdkkeysyms.h>\" where all
    --   possible values are defined. The corresponding strings are the
    --   constants without the GDK_ prefix.
    eventKeyName	:: String,
    -- | A character matching the key that was pressed.
    --
    -- * This entry can be used to build up a whole input string.
    --   The character is @Nothing@ if the key does not correspond to a simple
    --   unicode character.
    --
    eventKeyChar     :: Maybe Char }
  -- | Mouse cursor crossing event.
  --
  -- * This event indicates that the mouse cursor is hovering over this
  --   widget. It is used to set a widget into the pre-focus state where
  --   some GUI elements like buttons on a toolbar change their appearance.
  --
  | Crossing {
    eventSent	:: Bool,
    eventTime	:: TimeStamp,
    eventX,eventY	:: Double,
    eventXRoot,
    eventYRoot	:: Double,
    -- | This flag is false if the widget was entered, it is true when the
    --   widget the mouse cursor left the widget.
    eventLeaves :: Bool,
    -- | Kind of enter\/leave event.
    --
    -- * The mouse cursor might enter this widget because it grabs the mouse
    --   cursor for e.g. a modal dialog box.
    --
    eventCrossingMode	:: CrossingMode,
    -- | Information on from what level of the widget hierarchy the mouse
    --   cursor came.
    --
    -- * See 'NotifyType'.
    --
    eventNotifyType	:: NotifyType,
    eventModifier	:: [Modifier]}
  -- | Gaining or loosing input focus.
  --
  | Focus {
    eventSent	:: Bool,
    -- | This flag is @True@ if the widget receives the focus and @False@ if
    -- it just lost the input focus.
    eventInFocus	:: Bool}
  -- | The widget\'s size has changed.
  --
  -- * In response to this event the application can allocate resources that
  --   are specific to the size of the widget. It is emitted when the widget
  --   is shown the first time and on every resize.
  --
  | Configure {
    eventSent	:: Bool,
    -- | Position within the parent window.
    eventXParent	:: Int,
    -- | Position within the parent window.
    eventYParent	:: Int,
    eventWidth	:: Int,
    eventHeight	:: Int}
  -- | Change of visibility of a widget.
  | Visibility {
    eventSent	:: Bool,
    -- | Denote what portions of the widget is visible.
    eventVisible	:: VisibilityState }
  -- | Wheel movement of the mouse.
  --
  -- * This action denotes that the content of the widget should be scrolled.
  --   The event is triggered by the movement of the mouse wheel. Surrounding
  --   scroll bars are independant of this signal. Most mice do not have
  --   buttons for horizontal scrolling, hence 'eventDirection' will usually not
  --   contain 'ScrollLeft' and 'ScrollRight'. Mice with additional
  --   buttons may not work on X since only five buttons are supported
  --   (the three main buttons and two for the wheel).
  --
  -- * The handler of this signal should update the scroll bars that
  --   surround this widget which in turn tell this widget to update.
  --
  | Scroll {
    eventSent	:: Bool,
    eventTime	:: TimeStamp,
    eventX,eventY	:: Double,
    eventDirection	:: ScrollDirection,
    eventXRoot,
    eventYRoot	:: Double}
  -- | Indicate how the appearance of this window has changed.
  | WindowState {
    eventSent	:: Bool,
    -- | The mask indicates which flags have changed.
    eventWindowMask	:: [WindowState],
    -- | The state indicates the current state of the window.
    eventWindowState	:: [WindowState]} 
  -- | The state of the pen of a graphics tablet pen or touchscreen device.
  | Proximity {
    eventSent	:: Bool,
    eventTime	:: TimeStamp,
    -- | Whether the stylus has moved in or out of contact with the tablet.
    eventInContact     :: Bool
  } deriving Show

marshalEvent :: Ptr Event -> IO Event
marshalEvent ptr = do
  (eType::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr
  (case eType of
    #{const GDK_DELETE}         -> marshAny
    #{const GDK_DESTROY}        -> marshAny
    #{const GDK_EXPOSE}		-> marshExpose
    #{const GDK_MOTION_NOTIFY}	-> marshMotion
    #{const GDK_BUTTON_PRESS}	-> marshButton SingleClick
    #{const GDK_2BUTTON_PRESS}  -> marshButton DoubleClick
    #{const GDK_3BUTTON_PRESS}	-> marshButton TripleClick
    #{const GDK_BUTTON_RELEASE}	-> marshButton ReleaseClick
    #{const GDK_KEY_PRESS}	-> marshKey False
    #{const GDK_KEY_RELEASE}	-> marshKey True
    #{const GDK_ENTER_NOTIFY}	-> marshCrossing False
    #{const GDK_LEAVE_NOTIFY}	-> marshCrossing True
    #{const GDK_FOCUS_CHANGE}	-> marshFocus
    #{const GDK_CONFIGURE}	-> marshConfigure
    #{const GDK_MAP}            -> marshAny
    #{const GDK_UNMAP}          -> marshAny    
--    #{const GDK_PROPERTY_NOTIFY}-> marshProperty
    #{const GDK_PROXIMITY_IN}   -> marshProximity True
    #{const GDK_PROXIMITY_OUT}	-> marshProximity False
    #{const GDK_VISIBILITY_NOTIFY}-> marshVisibility
    #{const GDK_SCROLL}		-> marshScroll
    #{const GDK_WINDOW_STATE}	-> marshWindowState
    code			-> \_ -> fail $
      "marshalEvent: unhandled event type " ++ show code ++
      "\nplease report this as a bug to gtk2hs-devel@lists.sourceforge.net"
    ) ptr

marshAny ptr = do
  (sent   ::#gtk2hs_type gint8)	<- #{peek GdkEventAny, send_event} ptr
  return Event {
    eventSent = toBool sent
  }

marshExpose ptr = do
  (#{const GDK_EXPOSE}::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventExpose, send_event} ptr
  (area_   ::Rectangle)		<- #{peek GdkEventExpose, area} ptr
  (reg_   :: Ptr Region)	<- #{peek GdkEventExpose, region} ptr
  reg_ <- gdk_region_copy reg_
  region_ <- makeNewRegion reg_
  (count_  ::#gtk2hs_type gint)	<- #{peek GdkEventExpose, count} ptr
  return $ Expose {
    eventSent   = toBool sent_,
    eventArea   = area_,
    eventRegion = region_,
    eventCount  = fromIntegral count_}

foreign import ccall "gdk_region_copy"
  gdk_region_copy :: Ptr Region -> IO (Ptr Region)

marshExposeRect :: Ptr Event -> IO Rectangle
marshExposeRect ptr = do
  (#{const GDK_EXPOSE}::#gtk2hs_type GdkEventType) <- #{peek GdkEventAny,type} ptr
  (area_   ::Rectangle)		<- #{peek GdkEventExpose, area} ptr
  return area_

marshMotion ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventMotion, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventMotion, time} ptr
  (x_	   ::#gtk2hs_type gdouble)	<- #{peek GdkEventMotion, x} ptr
  (y_	   ::#gtk2hs_type gdouble)	<- #{peek GdkEventMotion, y} ptr
  (modif_  ::#gtk2hs_type guint)	<- #{peek GdkEventMotion, state} ptr
  (isHint_ ::#gtk2hs_type gint16)	<- #{peek GdkEventMotion, is_hint} ptr
  (xRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventMotion, x_root} ptr
  (yRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventMotion, y_root} ptr
  return $ Motion {
    eventSent   = toBool sent_,
    eventTime   = fromIntegral time_,
    eventX	   = realToFrac x_,
    eventY	   = realToFrac y_,
    eventModifier  = (toFlags . fromIntegral) modif_,
    eventIsHint = toBool isHint_,
    eventXRoot  = realToFrac xRoot_,
    eventYRoot  = realToFrac yRoot_}

marshButton but ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventButton, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventButton, time} ptr
  (x_	   ::#gtk2hs_type gdouble)	<- #{peek GdkEventButton, x} ptr
  (y_	   ::#gtk2hs_type gdouble)	<- #{peek GdkEventButton, y} ptr
  (modif_  ::#gtk2hs_type guint)	<- #{peek GdkEventButton, state} ptr
  (button_ ::#gtk2hs_type guint)	<- #{peek GdkEventButton, button} ptr
  (xRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventButton, x_root} ptr
  (yRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventButton, y_root} ptr
  return $ Button {
    eventClick  = but,
    eventSent   = toBool sent_,
    eventTime   = fromIntegral time_,
    eventX	   = realToFrac x_,
    eventY	   = realToFrac y_,
    eventModifier  = (toFlags . fromIntegral) modif_,
    eventButton = (toEnum.fromIntegral) button_,
    eventXRoot  = realToFrac xRoot_,
    eventYRoot  = realToFrac yRoot_}


marshKey up ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventKey, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventKey, time} ptr
  (modif_  ::#gtk2hs_type guint)	<- #{peek GdkEventKey, state} ptr
  (keyval_ ::#gtk2hs_type guint)	<- #{peek GdkEventKey, keyval} ptr
  
  (length_ ::#gtk2hs_type gint)	<- #{peek GdkEventKey, length} ptr
  keyChar <- keyvalToChar keyval_
  keyName <- unsafeInterleaveIO $ keyvalName keyval_
  return $ Key {
    eventRelease = up,
    eventSent = toBool sent_,
    eventTime   = fromIntegral time_,
    eventModifier  = (toFlags . fromIntegral) modif_,
    eventWithCapsLock = (modif_ .&. #{const GDK_LOCK_MASK})/=0,
    eventWithNumLock = (modif_ .&. #{const GDK_MOD2_MASK})/=0,
    eventWithScrollLock = (modif_ .&. #{const GDK_MOD3_MASK})/=0,
    eventKeyVal = keyval_,
    eventKeyName = keyName,
    eventKeyChar = keyChar }

marshCrossing leave ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventCrossing, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventCrossing, time} ptr
  (x_	   ::#gtk2hs_type gdouble)	<- #{peek GdkEventCrossing, x} ptr
  (y_	   ::#gtk2hs_type gdouble)	<- #{peek GdkEventCrossing, y} ptr
  (modif_  ::#gtk2hs_type guint)	<- #{peek GdkEventCrossing, state} ptr
  (xRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventCrossing, x_root} ptr
  (yRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventCrossing, y_root} ptr
  (cMode_  ::#gtk2hs_type GdkCrossingMode) 
				<- #{peek GdkEventCrossing, mode} ptr
  (nType_  ::#gtk2hs_type GdkNotifyType)
				<- #{peek GdkEventCrossing, detail} ptr  
  (modif_  ::#gtk2hs_type guint)	<- #{peek GdkEventCrossing, state} ptr
  return $ Crossing {
    eventSent   = toBool sent_,
    eventTime   = fromIntegral time_,
    eventX	   = realToFrac x_,
    eventY	   = realToFrac y_,
    eventXRoot  = realToFrac xRoot_,
    eventYRoot  = realToFrac yRoot_,
    eventLeaves = leave,
    eventCrossingMode  = (toEnum.fromIntegral) cMode_,
    eventNotifyType    = (toEnum.fromIntegral) nType_,
    eventModifier      = (toFlags . fromIntegral) modif_}


marshFocus ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventFocus, send_event} ptr
  (inFocus_::#gtk2hs_type gint16)	<- #{peek GdkEventFocus, in} ptr
  return $ Focus {
    eventSent   = toBool sent_,
    eventInFocus= toBool inFocus_}

marshConfigure ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventConfigure, send_event} ptr
  (xPar_   ::#gtk2hs_type gint)	<- #{peek GdkEventConfigure, x} ptr
  (yPar_   ::#gtk2hs_type gint)	<- #{peek GdkEventConfigure, y} ptr
  (width_  ::#gtk2hs_type gint)	<- #{peek GdkEventConfigure, width} ptr
  (height_ ::#gtk2hs_type gint)	<- #{peek GdkEventConfigure, height} ptr
  return $ Configure {
    eventSent   = toBool sent_,
    eventXParent   = fromIntegral xPar_,
    eventYParent   = fromIntegral yPar_,
    eventWidth  = fromIntegral width_,
    eventHeight = fromIntegral height_}

{-
marshProperty ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventProperty, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventProperty, time} ptr
  return $ Property {
    eventSent   = toBool sent_,
    eventTime   = fromIntegral time_}
-}

marshProximity contact ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventProximity, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventProximity, time} ptr
  return $ Proximity {
    eventSent   = toBool sent_,
    eventTime   = fromIntegral time_,
    eventInContact = contact}

marshVisibility ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventVisibility, send_event} ptr
  (state_  ::#gtk2hs_type GdkVisibilityState)
				<- #{peek GdkEventVisibility, state} ptr
  return $ Visibility {
    eventSent   = toBool sent_,
    eventVisible= (toEnum.fromIntegral) state_}

marshScroll ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventScroll, send_event} ptr
  (time_   ::#gtk2hs_type guint32)	<- #{peek GdkEventScroll, time} ptr
  (x_	  ::#gtk2hs_type gdouble)	<- #{peek GdkEventScroll, x} ptr
  (y_	  ::#gtk2hs_type gdouble)	<- #{peek GdkEventScroll, y} ptr
  (direc_  ::#gtk2hs_type GdkScrollDirection)
				<- #{peek GdkEventScroll, direction} ptr
  (xRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventScroll, x_root} ptr
  (yRoot_  ::#gtk2hs_type gdouble)	<- #{peek GdkEventScroll, y_root} ptr
  return $ Scroll {
    eventSent   = toBool sent_,
    eventTime   = fromIntegral time_,
    eventX	   = realToFrac x_,
    eventY	   = realToFrac y_,
    eventDirection  = (toEnum.fromIntegral) direc_,
    eventXRoot  = realToFrac xRoot_,
    eventYRoot  = realToFrac yRoot_}


marshWindowState ptr = do
  (sent_   ::#gtk2hs_type gint8)	<- #{peek GdkEventWindowState, send_event} ptr
  (wMask_  ::#gtk2hs_type GdkWindowState)
			<- #{peek GdkEventWindowState, changed_mask} ptr
  (wState_ ::#gtk2hs_type GdkWindowState)
			<- #{peek GdkEventWindowState, new_window_state} ptr
  return $ WindowState {
    eventSent   = toBool sent_,
    eventWindowMask  = (toFlags.fromIntegral) wMask_,
    eventWindowState = (toFlags.fromIntegral) wState_}