{-# LANGUAGE ScopedTypeVariables #-} -- -*-haskell-*- #include #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' and not exported by Gtk.hs. -- 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 'propertyChanged' 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 \"\" 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_}