Permalink
Browse files

Add notify event handling

  • Loading branch information...
mathstuf committed Mar 11, 2012
1 parent 0d76a86 commit d5d894fa07d219ce07e875aab0e19e7fc25c97d7
Showing with 163 additions and 1 deletion.
  1. +22 −0 Graphics/X11/Types.hsc
  2. +141 −1 Graphics/X11/Xlib/Extras.hsc
View
@@ -30,6 +30,10 @@ module Graphics.X11.Types
KeyCode,
SizeID,
SubpixelOrder,
+ Connection,
+ RROutput,
+ RRCrtc,
+ RRMode,
-- * Enumeration types
-- | These types were introduced to make function types clearer.
@@ -426,6 +430,9 @@ module Graphics.X11.Types
colormapChangeMask,
ownerGrabButtonMask,
rrScreenChangeNotifyMask,
+ rrCrtcChangeNotifyMask,
+ rrOutputChangeNotifyMask,
+ rrOutputPropertyNotifyMask,
-- ** Event types
EventType,
@@ -462,6 +469,11 @@ module Graphics.X11.Types
colormapNotify,
clientMessage,
mappingNotify,
+ rrScreenChangeNotify,
+ rrNotify,
+ rrNotifyCrtcChange,
+ rrNotifyOutputChange,
+ rrNotifyOutputProperty,
lASTEvent,
-- ** Modifiers
@@ -1269,6 +1281,9 @@ type EventMask = Mask
, colormapChangeMask = ColormapChangeMask
, ownerGrabButtonMask = OwnerGrabButtonMask
, rrScreenChangeNotifyMask = RRScreenChangeNotifyMask
+ , rrCrtcChangeNotifyMask = RRCrtcChangeNotifyMask
+ , rrOutputChangeNotifyMask = RROutputChangeNotifyMask
+ , rrOutputPropertyNotifyMask = RROutputPropertyNotifyMask
}
type EventType = Word32
@@ -1308,6 +1323,9 @@ type EventType = Word32
, mappingNotify = MappingNotify
, rrScreenChangeNotify = RRScreenChangeNotify
, rrNotify = RRNotify
+ , rrNotifyCrtcChange = RRNotify_CrtcChange
+ , rrNotifyOutputChange = RRNotify_OutputChange
+ , rrNotifyOutputProperty=RRNotify_OutputProperty
, lASTEvent = LASTEvent
}
@@ -1742,6 +1760,10 @@ type Rotation = #{type Rotation}
type Reflection = #{type Rotation}
type SizeID = #{type SizeID}
type SubpixelOrder = #{type SubpixelOrder}
+type Connection = #{type Connection}
+type RROutput = #{type RROutput}
+type RRCrtc = #{type RRCrtc}
+type RRMode = #{type RRMode}
#{enum Rotation,
, xRR_Rotate_0 = RR_Rotate_0
@@ -13,7 +13,9 @@
module Graphics.X11.Xlib.Extras where
+import Data.Maybe
import Data.Typeable ( Typeable )
+import Graphics.X11.Xrandr
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Misc
@@ -229,6 +231,55 @@ data Event
, ev_mwidth :: !CInt
, ev_mheight :: !CInt
}
+ | RRNotifyEvent
+ { ev_event_type :: !EventType
+ , ev_serial :: !CULong
+ , ev_send_event :: !Bool
+ , ev_event_display :: Display
+ , ev_window :: !Window
+ , ev_subtype :: !CInt
+ }
+ | RRCrtcChangeNotifyEvent
+ { ev_event_type :: !EventType
+ , ev_serial :: !CULong
+ , ev_send_event :: !Bool
+ , ev_event_display :: Display
+ , ev_window :: !Window
+ , ev_subtype :: !CInt
+ , ev_crtc :: !RRCrtc
+ , ev_rr_mode :: !RRMode
+ , ev_rotation :: !Rotation
+ , ev_x :: !CInt
+ , ev_y :: !CInt
+ , ev_rr_width :: !CUInt
+ , ev_rr_height :: !CUInt
+ }
+ | RROutputChangeNotifyEvent
+ { ev_event_type :: !EventType
+ , ev_serial :: !CULong
+ , ev_send_event :: !Bool
+ , ev_event_display :: Display
+ , ev_window :: !Window
+ , ev_subtype :: !CInt
+ , ev_output :: !RROutput
+ , ev_crtc :: !RRCrtc
+ , ev_rr_mode :: !RRMode
+ , ev_rotation :: !Rotation
+ , ev_connection :: !Connection
+ , ev_subpixel_order :: !SubpixelOrder
+ }
+ | RROutputPropertyNotifyEvent
+ { ev_event_type :: !EventType
+ , ev_serial :: !CULong
+ , ev_send_event :: !Bool
+ , ev_event_display :: Display
+ , ev_window :: !Window
+ , ev_subtype :: !CInt
+ , ev_output :: !RROutput
+ , ev_property :: !Atom
+ , ev_timestamp :: !Time
+ , ev_rr_state :: !CInt
+ }
deriving ( Show, Typeable )
@@ -282,6 +333,9 @@ getEvent p = do
serial <- #{peek XAnyEvent, serial} p
send_event <- #{peek XAnyEvent, send_event} p
display <- fmap Display (#{peek XAnyEvent, display} p)
+ rrData <- xrrQueryExtension display
+ let rrHasExtension = isJust rrData
+ let rrEventBase = fromIntegral $ fst $ fromMaybe (0, 0) rrData
case () of
-------------------------
@@ -633,7 +687,8 @@ getEvent p = do
-------------------------
-- RRScreenChangeNotify
-------------------------
- | type_ == propertyNotify -> do
+ | rrHasExtension &&
+ type_ == rrEventBase + rrScreenChangeNotify -> do
window <- #{peek XRRScreenChangeNotifyEvent, window } p
root <- #{peek XRRScreenChangeNotifyEvent, root } p
timestamp <- #{peek XRRScreenChangeNotifyEvent, timestamp } p
@@ -663,6 +718,91 @@ getEvent p = do
, ev_mheight = mheight
}
+ -------------------------
+ -- RRNotify
+ -------------------------
+ | rrHasExtension &&
+ type_ == rrEventBase + rrNotify -> do
+ window <- #{peek XRRNotifyEvent, window } p
+ subtype <- #{peek XRRNotifyEvent, subtype } p
+ let subtype_ = fromIntegral subtype_
+ case () of
+ _ | subtype_ == rrNotifyCrtcChange -> do
+ crtc <- #{peek XRRCrtcChangeNotifyEvent, crtc } p
+ mode <- #{peek XRRCrtcChangeNotifyEvent, mode } p
+ rotation <- #{peek XRRCrtcChangeNotifyEvent, rotation } p
+ x <- #{peek XRRCrtcChangeNotifyEvent, x } p
+ y <- #{peek XRRCrtcChangeNotifyEvent, y } p
+ width <- #{peek XRRCrtcChangeNotifyEvent, width } p
+ height <- #{peek XRRCrtcChangeNotifyEvent, height } p
+ return $ RRCrtcChangeNotifyEvent
+ { ev_event_type = type_
+ , ev_serial = serial
+ , ev_send_event = send_event
+ , ev_event_display = display
+ , ev_window = window
+ , ev_subtype = subtype
+ , ev_crtc = crtc
+ , ev_rr_mode = mode
+ , ev_rotation = rotation
+ , ev_x = x
+ , ev_y = y
+ , ev_rr_width = width
+ , ev_rr_height = height
+ }
+
+ | subtype_ == rrNotifyOutputChange -> do
+ output <- #{peek XRROutputChangeNotifyEvent, output } p
+ crtc <- #{peek XRROutputChangeNotifyEvent, crtc } p
+ mode <- #{peek XRROutputChangeNotifyEvent, mode } p
+ rotation <- #{peek XRROutputChangeNotifyEvent, rotation } p
+ connection <- #{peek XRROutputChangeNotifyEvent, connection } p
+ subpixel_order <- #{peek XRROutputChangeNotifyEvent, subpixel_order } p
+ return $ RROutputChangeNotifyEvent
+ { ev_event_type = type_
+ , ev_serial = serial
+ , ev_send_event = send_event
+ , ev_event_display = display
+ , ev_window = window
+ , ev_subtype = subtype
+ , ev_output = output
+ , ev_crtc = crtc
+ , ev_rr_mode = mode
+ , ev_rotation = rotation
+ , ev_connection = connection
+ , ev_subpixel_order = subpixel_order
+ }
+
+ | subtype_ == rrNotifyOutputProperty -> do
+ output <- #{peek XRROutputPropertyNotifyEvent, output } p
+ property <- #{peek XRROutputPropertyNotifyEvent, property } p
+ timestamp <- #{peek XRROutputPropertyNotifyEvent, timestamp } p
+ state <- #{peek XRROutputPropertyNotifyEvent, state } p
+ return $ RROutputPropertyNotifyEvent
+ { ev_event_type = type_
+ , ev_serial = serial
+ , ev_send_event = send_event
+ , ev_event_display = display
+ , ev_window = window
+ , ev_subtype = subtype
+ , ev_output = output
+ , ev_property = property
+ , ev_timestamp = timestamp
+ , ev_rr_state = state
+ }
+
+ -- We don't handle this event specifically, so return the generic
+ -- RRNotifyEvent.
+ | otherwise -> do
+ return $ RRNotifyEvent
+ { ev_event_type = type_
+ , ev_serial = serial
+ , ev_send_event = send_event
+ , ev_event_display = display
+ , ev_window = window
+ , ev_subtype = subtype
+ }
+
-- We don't handle this event specifically, so return the generic
-- AnyEvent.
| otherwise -> do

0 comments on commit d5d894f

Please sign in to comment.