module X11Event(decodeEvent,lookupKeysym, Event(..),EnterLeave(..),Focus(..),InputDeviceDetail(..), Pressed(..),Keycode,Button,Hint) where import Numeric(showHex) import Data.Ix(inRange) import Data.Word import Data.Bits((.&.)) import AuxTypes(Modifiers,Detail,Mode,ClientData(..)) import X11Types import X11Utils default (Int) data ResponseCode = ErrorResponse | Reply -- 0, 1, not events | KEY_PRESS | KEY_RELEASE -- 2, 3 | BUTTON_PRESS | BUTTON_RELEASE -- 4, 5 | MOTION_NOTIFY -- 6 | ENTER_NOTIFY | LEAVE_NOTIFY -- 7, 8 | FOCUS_IN | FOCUS_OUT -- 9, 10 | KEYMAP_NOTIFY -- 11 | EXPOSE | GRAPHICS_EXPOSURE | NO_EXPOSURE -- 12, 13, 14 | VISIBILITY_NOTIFY -- 15 | CREATE_NOTIFY | DESTROY_NOTIFY -- 16, 17 | UNMAP_NOTIFY | MAP_NOTIFY -- 18, 19 | MAP_REQUEST -- 20 | REPARENT_NOTIFY -- 21 | CONFIGURE_NOTIFY | CONFIGURE_REQUEST -- 22, 23 | GRAVITY_NOTIFY -- 24 | RESIZE_REQUEST -- 25 | CIRCULATE_NOTIFY | CIRUCUATE_REQUEST -- 26, 27 | PROPERTY_NOTIFY -- 28 | SELECTION_CLEAR | SELECTION_REQUEST | SELECTION_NOTIFY -- 29, 30, 31 | COLORMAP_NOTIFY -- 32 | CLIENT_MESSAGE -- 33 | MAPPING_NOTIFY -- 34 deriving (Eq,Bounded,Enum,Show) data Event = Input {serial::Word16,detail::InputDeviceDetail,timeStamp::Word32, rootWindow,eventWindow::Window, rootPos,eventPos::Point, modifiers::[Modifiers]} | PointerWindow {serial::Word16,el::EnterLeave,elDetail::Detail,mode::Mode, timeStamp::Word32,rootWindow,eventWindow::Window, rootPos,eventPos::Point,hasFocus::Bool} | Focus {serial::Word16,focus::Focus,elDetail::Detail,mode::Mode, eventWindow::Window} | Expose {serial::Word16,window::Window,area::Rect,count::Word16} | NoExposure {serial::Word16,window::Window} | CreateNotify {serial::Word16,eventWindow,window::Window, area::Rect,borderWidth::Word16,overrideRedirect::Bool} | DestroyNotify {serial::Word16,eventWindow,window::Window} | MapNotify {serial::Word16,eventWindow,window::Window,overrideRedirect::Bool} | UnmapNotify {serial::Word16,eventWindow,window::Window,fromConfigure::Bool} | ReparentNotify {serial::Word16,eventWindow,window,parent::Window, pos::Point,overrideRedirect::Bool} | ConfigureNotify {serial::Word16,eventWindow,window::Window, area::Rect,borderWidth::Word16,overrideRedirect::Bool} | ClientMessage {serial::Word16,eventWindow::Window, ty::Atom,values::ClientData} | MappingNotify {serial::Word16,mdetail::MappingDetail} | OtherEvent Int String deriving Show data InputDeviceDetail = Key Pressed Keycode | Button Pressed Button | Motion Hint deriving Show data EnterLeave = Enter | Leave deriving Show data Focus = In | Out deriving Show data Pressed = Pressed | Released deriving Show type Button = Word8 type Hint = Bool data MappingDetail = Modifier | Keyboard Keycode Word8 | Pointer deriving Show decodeEvent r = case safeToEnum ErrorResponse ec of ErrorResponse -> OtherEvent ec "Unknown event" Reply -> OtherEvent ec "This is a reply, not an event" eventCode -> decodeEvent' r eventCode where ec = byte r 0 .&. 0x7f -- highest bit set for events from SendEvent decodeEvent' r eventCode = case eventCode of EXPOSE -> getFrom2 r $ Expose <$>get<*>get<*>get<*>get NO_EXPOSURE -> NoExposure serial window where window = Window (word32 r 4) -- Drawable !! DESTROY_NOTIFY -> getFrom2 r $ DestroyNotify <$> get <*> get <*> get MAP_NOTIFY -> mapNotify MapNotify UNMAP_NOTIFY -> mapNotify UnmapNotify KEY_PRESS -> keyEvent Pressed KEY_RELEASE -> keyEvent Released BUTTON_PRESS -> buttonEvent Pressed BUTTON_RELEASE -> buttonEvent Released MOTION_NOTIFY -> inputEvent (Motion hint) where hint = toEnum (byte r 1) ENTER_NOTIFY -> enterLeave Enter LEAVE_NOTIFY -> enterLeave Leave FOCUS_IN -> focus In FOCUS_OUT -> focus Out REPARENT_NOTIFY -> getFrom2 r $ ReparentNotify <$>get<*>get<*>get<*>get<*>get<*>get CREATE_NOTIFY -> getFrom2 r $ CreateNotify <$> get<*>get <*> get<*>get<*>get<*>get CONFIGURE_NOTIFY -> getFrom2 r $ ConfigureNotify <$>get<*>get <* unused 4<*>get<*>get<*>get<*>get CLIENT_MESSAGE -> getFrom1 r $ do fmt <- w8 ClientMessage <$> get <*> get <*> get <*> case fmt of 8 -> Byte <$> string8 20 16 -> Short <$> list 10 (fi<$>w16) 32 -> Long <$> list 5 (fi<$>w32) MAPPING_NOTIFY -> getFrom2 r $ do serial <- get req <- w8 MappingNotify serial <$> case req of 0 -> pure Modifier 1 -> Keyboard <$> get <*> get 2 -> pure Pointer _ -> OtherEvent (fromEnum eventCode) (show eventCode) where mapNotify f = f serial ew w ov where serial = word16 r 2 ew = Window (word32 r 4) w = Window (word32 r 8) ov = toEnum (byte r 9) enterLeave el = PointerWindow serial el detail mode timeStamp rootWindow eventWindow rootPos eventPos focus where detail = toEnum (byte r 1) mode = toEnum (byte r 30) focus = toEnum (byte r 31 .&. 1) focus f = Focus serial f detail mode window where detail = toEnum (byte r 1) serial = word16 r 2 window = Window $ word32 r 4 mode = toEnum (byte r 8) buttonEvent pressed = inputEvent (Button pressed button) where button = byte r 1 keyEvent pressed = inputEvent (Key pressed keyCode) where keyCode = KC (byte r 1) inputEvent detail = Input serial detail timeStamp rootWindow eventWindow --childWindow rootPos eventPos modifiers serial = word16 r 2 timeStamp = word32 r 4 rootWindow = Window (word32 r 8) eventWindow = Window (word32 r 12) --childWindow = word32 r 16 -- NOTE: Always 0 rootPos = word16x2 r 20 eventPos = word16x2 r 24 setOfKeyButMask = BitSet (word16 r 28) modifiers = fromBitSet setOfKeyButMask isSameScreen = byte r 30 instance FromX Rect where get = R <$> get <*> get <*> get <*> get instance FromX Window where get = Window <$> get instance FromX Atom where get = Atom <$> get instance FromX Keycode where get = KC <$> get getFrom1 r g = getFrom r $ unused 1 *> g getFrom2 r g = getFrom r $ unused 2 *> g --https://www.x.org/releases/X11R7.7/doc/xproto/x11protocol.html#keysym_encoding lookupKeysym (KS k) = case k of 0x0000 -> fn "NoSymbol" 0x0020 -> ("space"," ") 0x002c -> ("comma",",") 0x002e -> ("period",".") 0x00a0 -> ("nobreakspace"," ") 0xff08 -> ("BackSpace","\b") 0xff09 -> ("Tab","\t") 0xff0a -> ("LineFeed","\n") 0xff0d -> ("Return","\r") 0x0100ff0d -> ("Return","\r") -- hmm -- 0xff11 -> -- 0xff12 -> 0xff13 -> fn "Pause" -- 0xff18 -> -- 0xff19 -> -- 0xff1d -> -- 0xff26 -> 0xff1b -> ("Escape","\ESC") 0xff50 -> fn "Home" 0xff51 -> fn "Left" 0xff52 -> fn "Up" 0xff53 -> fn "Right" 0xff54 -> fn "Down" 0xff55 -> fn "Prior" 0xff56 -> fn "Next" 0xff57 -> fn "End" 0xff58 -> fn "Begin" 0xff63 -> fn "Insert" 0xff67 -> fn "Menu" 0xff7e -> fn "ModeSwitch" 0xff8d -> ("KP_Enter","\r") 0xffaa -> ("KP_Multiply","*") 0xffab -> ("KP_Add","+") 0xffad -> ("KP_Subtract","-") 0xffaf -> ("KP_Divide","/") 0xffb0 -> ("KP_0","0") 0xffb1 -> ("KP_1","1") 0xffb2 -> ("KP_2","2") 0xffb3 -> ("KP_3","3") 0xffb4 -> ("KP_4","4") 0xffb5 -> ("KP_5","5") 0xffb6 -> ("KP_6","6") 0xffb7 -> ("KP_7","7") 0xffb8 -> ("KP_8","8") 0xffb9 -> ("KP_9","9") 0xffe1 -> fn "Shift" -- Left 0xffe2 -> fn "Shift" -- Right 0xffe3 -> fn "Control" -- Left 0xffe4 -> fn "Control" -- Right 0xffe7 -> fn "LeftMeta" 0xffe8 -> fn "RightMeta" 0xffe9 -> fn "LeftAlt" 0xffea -> fn "RightAlt" 0xffeb -> fn "LeftSuper" 0xffec -> fn "RightSuper" 0xffed -> fn "LeftHyper" 0xffee -> fn "RightHyper" 0xffff -> ("Delete","\DEL") 0x00ffffff -> fn "VoidSymbol" _ | inRange (0x20,0x7e) k || inRange (0xa0,0xff) k -> char k -- Latin-1 | inRange (0x01000020,0x0110FFFF) k ->char (k-0x01000000) -- Unicode | inRange (0xffbe,0xffe0) k -> fn ("F"++show (k-0xffbd)) | otherwise -> fn (showHex k "") -- !! where fn k = (k,"") char k = dup [convEnum k] dup x = (x,x)