{-# LANGUAGE CPP #-}
module EncodeEvent(getNextEvent,motionCompress) where
import Event
import Xtypes
import XCallTypes
import StructFuns
import Xlib
import Marshall
import MyForeign
import qualified Foreign as F
import FudUTF8(decodeUTF8)
import Data.Maybe(fromMaybe)
#include "newstructfuns.h"
getNextEvent :: Display -> IO (WindowId, XEvent)
getNextEvent Display
d = do
CXEvent
ev <- IO CXEvent
newXEvent
Display -> CXEvent -> IO ()
xNextEvent Display
d CXEvent
ev
WindowId
window <- GET(XAnyEvent,WindowId,ev,window)
XEvent
fev <- CXEvent -> IO XEvent
encodeEvent CXEvent
ev
(WindowId, XEvent) -> IO (WindowId, XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowId
window,XEvent
fev)
checkWindowEvent :: Display -> WindowId -> [EventMask] -> IO (Maybe XEvent)
checkWindowEvent Display
d WindowId
w [EventMask]
evmask = do
CXEvent
ev <- IO CXEvent
newXEvent
Bool
found <- Display -> WindowId -> Int -> CXEvent -> IO Bool
xCheckWindowEvent Display
d WindowId
w ([EventMask] -> Int
forall a. ToC a => a -> Int
toC ([EventMask]
evmask::[EventMask])) CXEvent
ev
if Bool
found
then XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just (XEvent -> Maybe XEvent) -> IO XEvent -> IO (Maybe XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CXEvent -> IO XEvent
encodeEvent CXEvent
ev
else CXEvent -> IO ()
forall a. HasAddr a => a -> IO ()
freePtr CXEvent
ev IO () -> IO (Maybe XEvent) -> IO (Maybe XEvent)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe XEvent -> IO (Maybe XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XEvent
forall a. Maybe a
Nothing
motionCompress :: Display -> (WindowId, XEvent) -> IO (WindowId, XEvent)
motionCompress Display
d e :: (WindowId, XEvent)
e@(WindowId
w,fev :: XEvent
fev@MotionNotify{}) =
do Maybe XEvent
me <- Display -> WindowId -> [EventMask] -> IO (Maybe XEvent)
checkWindowEvent Display
d WindowId
w [EventMask
PointerMotionMask]
case Maybe XEvent
me of
Maybe XEvent
Nothing -> (WindowId, XEvent) -> IO (WindowId, XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowId, XEvent)
e
Just XEvent
fev' -> Display -> (WindowId, XEvent) -> IO (WindowId, XEvent)
motionCompress Display
d (WindowId
w,XEvent
fev')
motionCompress Display
_ (WindowId, XEvent)
e = (WindowId, XEvent) -> IO (WindowId, XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowId, XEvent)
e
encodeEvent :: CXEvent -> IO XEvent
encodeEvent CXEvent
ev = do
Int
evno <- GET(XAnyEvent,Int,ev,type)
case Int
evno :: Int of
#define X_KeyPress 2
#define X_KeyRelease 3
#define X_ButtonPress 4
#define X_ButtonRelease 5
#define X_MotionNotify 6
#define X_EnterNotify 7
#define X_LeaveNotify 8
#define X_FocusIn 9
#define X_FocusOut 10
#define X_KeymapNotify 11
#define X_Expose 12
#define X_GraphicsExpose 13
#define X_NoExpose 14
#define X_VisibilityNotify 15
#define X_CreateNotify 16
#define X_DestroyNotify 17
#define X_UnmapNotify 18
#define X_MapNotify 19
#define X_MapRequest 20
#define X_ReparentNotify 21
#define X_ConfigureNotify 22
#define X_ConfigureRequest 23
#define X_GravityNotify 24
#define X_ResizeRequest 25
#define X_CirculateNotify 26
#define X_CirculateRequest 27
#define X_PropertyNotify 28
#define X_SelectionClear 29
#define X_SelectionRequest 30
#define X_SelectionNotify 31
#define X_ColormapNotify 32
#define X_ClientMessage 33
#define X_MappingNotify 34
X_KeyPress -> putKeyEvent ev Pressed
X_KeyRelease -> putKeyEvent ev Released
X_ButtonPress -> putButtonEvent ev Pressed
X_ButtonRelease -> putButtonEvent ev Released
X_MotionNotify -> putMotionEvent ev
X_EnterNotify -> putCrossingEvent ev True
X_LeaveNotify -> putCrossingEvent ev False
X_FocusIn -> putFocusChangeEvent ev True
X_FocusOut -> putFocusChangeEvent ev False
X_KeymapNotify -> return KeymapNotify
X_Expose -> putExposeEvent ev
X_GraphicsExpose -> putGraphicsExposeEvent ev
X_NoExpose -> return NoExpose
X_VisibilityNotify -> putVisibilityEvent ev
X_CreateNotify -> putStructEvent ev CreateNotify
X_DestroyNotify -> putStructEvent ev DestroyNotify
X_UnmapNotify -> putStructEvent ev UnmapNotify
X_MapNotify -> putStructEvent ev MapNotify
X_MapRequest -> putStructEvent ev MapRequest
X_ReparentNotify -> return ReparentNotify
X_ConfigureNotify -> putConfigureEvent ev
X_ConfigureRequest -> return ConfigureRequest
X_GravityNotify -> return GravityNotify
X_ResizeRequest -> putResizeRequestEvent ev
X_CirculateNotify -> return CirculateNotify
X_CirculateRequest -> return CirculateRequest
X_PropertyNotify -> return PropertyNotify
X_SelectionClear -> putSelectionClearEvent ev
X_SelectionRequest -> putSelectionRequestEvent ev
X_SelectionNotify -> putSelectionNotifyEvent ev
X_ColormapNotify -> return ColormapNotify
X_ClientMessage -> putClientMessageEvent ev
X_MappingNotify -> return MappingNotify
mkClientData :: CXEvent -> IO ClientData
mkClientData CXEvent
ev = do
Int
format <- GET(XClientMessageEvent,Int,ev,format)
Addr
d <- AGET(XClientMessageEvent,Addr,ev,data)
case Int
format::Int of
Int
32 -> [Int] -> ClientData
Long ([Int] -> ClientData) -> IO [Int] -> IO ClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Int) -> [Int] -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CINDEX(long) Addr
(d::Addr)) Int
[0..(4::Int)]
Int
16 -> [Int] -> ClientData
Short ([Int] -> ClientData) -> IO [Int] -> IO ClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Int) -> [Int] -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CINDEX(short) d) Int
[0..(9::Int)]
Int
8 -> String -> ClientData
Byte (String -> ClientData) -> IO String -> IO ClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Cchar) -> [Int] -> IO String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CINDEX(char) d) Int
[0..(19::Int)]
putKeyEvent :: CXEvent -> Pressed -> IO XEvent
putKeyEvent CXEvent
ev Pressed
p = do
(String
key,String
l) <- CXEvent -> Int -> IO (String, String)
xLookupString CXEvent
ev Int
100
Int
-> Point
-> Point
-> ModState
-> Pressed
-> KeyCode
-> String
-> String
-> XEvent
KeyEvent
(Int
-> Point
-> Point
-> ModState
-> Pressed
-> KeyCode
-> String
-> String
-> XEvent)
-> IO Int
-> IO
(Point
-> Point
-> ModState
-> Pressed
-> KeyCode
-> String
-> String
-> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XKeyEvent,Time,ev,time)
IO
(Point
-> Point
-> ModState
-> Pressed
-> KeyCode
-> String
-> String
-> XEvent)
-> IO Point
-> IO
(Point
-> ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XKeyEvent,Int,ev,x) GET(XKeyEvent,Int,ev,y)
IO
(Point
-> ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
-> IO Point
-> IO
(ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XKeyEvent,Int,ev,x_root) GET(XKeyEvent,Int,ev,y_root)
IO (ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
-> IO ModState
-> IO (Pressed -> KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ModState) -> IO Int -> IO ModState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ModState
forall a. FromC a => Int -> a
fromC GET(XKeyEvent,Int,ev,state)
IO (Pressed -> KeyCode -> String -> String -> XEvent)
-> IO Pressed -> IO (KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pressed -> IO Pressed
forall (m :: * -> *) a. Monad m => a -> m a
return Pressed
p
IO (KeyCode -> String -> String -> XEvent)
-> IO KeyCode -> IO (String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> KeyCode) -> IO Int -> IO KeyCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> KeyCode
KeyCode GET(XKeyEvent,Int,ev,keycode)
IO (String -> String -> XEvent)
-> IO String -> IO (String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
key
IO (String -> XEvent) -> IO String -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
decodeUTF8 String
l)
putButtonEvent :: CXEvent -> Pressed -> IO XEvent
putButtonEvent CXEvent
ev Pressed
p =
Int -> Point -> Point -> ModState -> Pressed -> Button -> XEvent
ButtonEvent
(Int -> Point -> Point -> ModState -> Pressed -> Button -> XEvent)
-> IO Int
-> IO (Point -> Point -> ModState -> Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XButtonEvent,Time,ev,time)
IO (Point -> Point -> ModState -> Pressed -> Button -> XEvent)
-> IO Point
-> IO (Point -> ModState -> Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XButtonEvent,Int,ev,x) GET(XButtonEvent,Int,ev,y)
IO (Point -> ModState -> Pressed -> Button -> XEvent)
-> IO Point -> IO (ModState -> Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XButtonEvent,Int,ev,x_root) GET(XButtonEvent,Int,ev,y_root)
IO (ModState -> Pressed -> Button -> XEvent)
-> IO ModState -> IO (Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ModState) -> IO Int -> IO ModState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ModState
forall a. FromC a => Int -> a
fromC GET(XButtonEvent,Int,ev,state)
IO (Pressed -> Button -> XEvent)
-> IO Pressed -> IO (Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pressed -> IO Pressed
forall (m :: * -> *) a. Monad m => a -> m a
return Pressed
p
IO (Button -> XEvent) -> IO Button -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Button) -> IO Int -> IO Button
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Button
Button GET(XButtonEvent,Int,ev,button)
putMotionEvent :: CXEvent -> IO XEvent
putMotionEvent CXEvent
ev =
Int -> Point -> Point -> ModState -> XEvent
MotionNotify
(Int -> Point -> Point -> ModState -> XEvent)
-> IO Int -> IO (Point -> Point -> ModState -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XMotionEvent,Time,ev,time)
IO (Point -> Point -> ModState -> XEvent)
-> IO Point -> IO (Point -> ModState -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XMotionEvent,Int,ev,x) GET(XMotionEvent,Int,ev,y)
IO (Point -> ModState -> XEvent)
-> IO Point -> IO (ModState -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XMotionEvent,Int,ev,x_root) GET(XMotionEvent,Int,ev,y_root)
IO (ModState -> XEvent) -> IO ModState -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ModState) -> IO Int -> IO ModState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ModState
forall a. FromC a => Int -> a
fromC GET(XMotionEvent,Int,ev,state)
putCrossingEvent :: CXEvent -> Bool -> IO XEvent
putCrossingEvent CXEvent
ev Bool
c =
(if Bool
c then Int -> Point -> Point -> Detail -> Mode -> Bool -> XEvent
EnterNotify else Int -> Point -> Point -> Detail -> Mode -> Bool -> XEvent
LeaveNotify)
(Int -> Point -> Point -> Detail -> Mode -> Bool -> XEvent)
-> IO Int
-> IO (Point -> Point -> Detail -> Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XCrossingEvent,Time,ev,time)
IO (Point -> Point -> Detail -> Mode -> Bool -> XEvent)
-> IO Point -> IO (Point -> Detail -> Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XCrossingEvent,Int,ev,x) GET(XCrossingEvent,Int,ev,y)
IO (Point -> Detail -> Mode -> Bool -> XEvent)
-> IO Point -> IO (Detail -> Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XCrossingEvent,Int,ev,x_root) GET(XCrossingEvent,Int,ev,y_root)
IO (Detail -> Mode -> Bool -> XEvent)
-> IO Detail -> IO (Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Detail) -> IO Int -> IO Detail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Detail
forall a. FromC a => Int -> a
fromC GET(XCrossingEvent,Int,ev,detail)
IO (Mode -> Bool -> XEvent) -> IO Mode -> IO (Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Mode) -> IO Int -> IO Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Mode
forall a. FromC a => Int -> a
fromC GET(XCrossingEvent,Int,ev,mode)
IO (Bool -> XEvent) -> IO Bool -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. FromC a => Int -> a
fromC GET(XCrossingEvent,Int,ev,focus)
putFocusChangeEvent :: CXEvent -> Bool -> IO XEvent
putFocusChangeEvent CXEvent
ev Bool
c =
(if Bool
c then Detail -> Mode -> XEvent
FocusIn else Detail -> Mode -> XEvent
FocusOut)
(Detail -> Mode -> XEvent) -> IO Detail -> IO (Mode -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Detail) -> IO Int -> IO Detail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Detail
forall a. FromC a => Int -> a
fromC GET(XFocusChangeEvent,Int,ev,detail)
IO (Mode -> XEvent) -> IO Mode -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Mode) -> IO Int -> IO Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Mode
forall a. FromC a => Int -> a
fromC GET(XFocusChangeEvent,Int,ev,mode)
putExposeEvent :: CXEvent -> IO XEvent
putExposeEvent CXEvent
ev =
Rect -> Int -> XEvent
Expose
(Rect -> Int -> XEvent) -> IO Rect -> IO (Int -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Int -> IO Int -> IO Rect
forall (f :: * -> *).
Applicative f =>
f Int -> f Int -> f Int -> f Int -> f Rect
mkRect GET(XExposeEvent,Int,ev,x) GET(XExposeEvent,Int,ev,y)
GET(XExposeEvent,Int,ev,width) GET(XExposeEvent,Int,ev,height)
IO (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XExposeEvent,Int,ev,count)
putGraphicsExposeEvent :: CXEvent -> IO XEvent
putGraphicsExposeEvent CXEvent
ev =
Rect -> Int -> Int -> Int -> XEvent
GraphicsExpose
(Rect -> Int -> Int -> Int -> XEvent)
-> IO Rect -> IO (Int -> Int -> Int -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Int -> IO Int -> IO Rect
forall (f :: * -> *).
Applicative f =>
f Int -> f Int -> f Int -> f Int -> f Rect
mkRect GET(XGraphicsExposeEvent,Int,ev,x) GET(XGraphicsExposeEvent,Int,ev,y)
GET(XGraphicsExposeEvent,Int,ev,width) GET(XGraphicsExposeEvent,Int,ev,height)
IO (Int -> Int -> Int -> XEvent)
-> IO Int -> IO (Int -> Int -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XGraphicsExposeEvent,Int,ev,count)
IO (Int -> Int -> XEvent) -> IO Int -> IO (Int -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XGraphicsExposeEvent,Int,ev,major_code)
IO (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XGraphicsExposeEvent,Int,ev,minor_code)
putVisibilityEvent :: CXEvent -> IO XEvent
putVisibilityEvent CXEvent
ev =
Visibility -> XEvent
VisibilityNotify (Visibility -> XEvent) -> (Int -> Visibility) -> Int -> XEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Visibility
forall a. FromC a => Int -> a
fromC (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XVisibilityEvent,Int,ev,state)
putStructEvent :: CXEvent -> (WindowId -> b) -> IO b
putStructEvent CXEvent
ev WindowId -> b
c = WindowId -> b
c (WindowId -> b) -> IO WindowId -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XMapEvent,WindowId,ev,window)
putConfigureEvent :: CXEvent -> IO XEvent
putConfigureEvent CXEvent
ev =
Rect -> Int -> XEvent
ConfigureNotify
(Rect -> Int -> XEvent) -> IO Rect -> IO (Int -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Int -> IO Int -> IO Rect
forall (f :: * -> *).
Applicative f =>
f Int -> f Int -> f Int -> f Int -> f Rect
mkRect GET(XConfigureEvent,Int,ev,x) GET(XConfigureEvent,Int,ev,y)
GET(XConfigureEvent,Int,ev,width) GET(XConfigureEvent,Int,ev,height)
IO (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XConfigureEvent,Int,ev,border_width)
putResizeRequestEvent :: CXEvent -> IO XEvent
putResizeRequestEvent CXEvent
ev =
Point -> XEvent
ResizeRequest
(Point -> XEvent) -> IO Point -> IO XEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XResizeRequestEvent,Int,ev,width)
GET(XResizeRequestEvent,Int,ev,height)
putSelectionClearEvent :: CXEvent -> IO XEvent
putSelectionClearEvent CXEvent
ev = Atom -> XEvent
SelectionClear
(Atom -> XEvent) -> IO Atom -> IO XEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionClearEvent,Atom,ev,selection)
putSelectionRequestEvent :: CXEvent -> IO XEvent
putSelectionRequestEvent CXEvent
ev =
Int -> WindowId -> Selection -> XEvent
SelectionRequest
(Int -> WindowId -> Selection -> XEvent)
-> IO Int -> IO (WindowId -> Selection -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionRequestEvent,Time,ev,time)
IO (WindowId -> Selection -> XEvent)
-> IO WindowId -> IO (Selection -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionRequestEvent,WindowId,ev,requestor)
IO (Selection -> XEvent) -> IO Selection -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom -> Atom -> Atom -> Selection
Selection (Atom -> Atom -> Atom -> Selection)
-> IO Atom -> IO (Atom -> Atom -> Selection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionRequestEvent,Atom,ev,selection)
IO (Atom -> Atom -> Selection) -> IO Atom -> IO (Atom -> Selection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionRequestEvent,Atom,ev,target)
IO (Atom -> Selection) -> IO Atom -> IO Selection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionRequestEvent,Atom,ev,property))
putSelectionNotifyEvent :: CXEvent -> IO XEvent
putSelectionNotifyEvent CXEvent
ev =
Int -> Selection -> XEvent
SelectionNotify
(Int -> Selection -> XEvent) -> IO Int -> IO (Selection -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionEvent,Time,ev,time)
IO (Selection -> XEvent) -> IO Selection -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom -> Atom -> Atom -> Selection
Selection (Atom -> Atom -> Atom -> Selection)
-> IO Atom -> IO (Atom -> Atom -> Selection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionEvent,Atom,ev,selection)
IO (Atom -> Atom -> Selection) -> IO Atom -> IO (Atom -> Selection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionEvent,Atom,ev,target)
IO (Atom -> Selection) -> IO Atom -> IO Selection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionEvent,Atom,ev,property))
putClientMessageEvent :: CXEvent -> IO XEvent
putClientMessageEvent CXEvent
ev =
Atom -> ClientData -> XEvent
ClientMessage
(Atom -> ClientData -> XEvent)
-> IO Atom -> IO (ClientData -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XClientMessageEvent,Atom,ev,message_type)
IO (ClientData -> XEvent) -> IO ClientData -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CXEvent -> IO ClientData
mkClientData CXEvent
ev
foreign import ccall "X11/Xlib.h XLookupString"
cXLookupString :: CXKeyEvent -> Addr -> Int -> F.Ptr XlibKeySym -> Addr -> IO Int
xLookupString :: CXKeyEvent -> Int -> IO (KeySym,String)
xLookupString :: CXEvent -> Int -> IO (String, String)
xLookupString CXEvent
xev Int
len =
Int -> (Addr -> IO (String, String)) -> IO (String, String)
forall c. Int -> (Addr -> IO c) -> IO c
alloca Int
len ((Addr -> IO (String, String)) -> IO (String, String))
-> (Addr -> IO (String, String)) -> IO (String, String)
forall a b. (a -> b) -> a -> b
$ \ Addr
arr ->
(Ptr XlibKeySym -> IO (String, String)) -> IO (String, String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr XlibKeySym -> IO (String, String)) -> IO (String, String))
-> (Ptr XlibKeySym -> IO (String, String)) -> IO (String, String)
forall a b. (a -> b) -> a -> b
$ \ Ptr XlibKeySym
keysyma ->
do Int
len' <-
CXEvent -> Addr -> Int -> Ptr XlibKeySym -> Addr -> IO Int
cXLookupString CXEvent
xev Addr
arr Int
len Ptr XlibKeySym
keysyma Addr
nullAddr
XlibKeySym
keysym <- Ptr XlibKeySym -> IO XlibKeySym
forall a. Storable a => Ptr a -> IO a
F.peek Ptr XlibKeySym
keysyma
Maybe String
key <- XlibKeySym -> IO (Maybe String)
xKeysymToString XlibKeySym
keysym
let key' :: String
key' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(undefined)" Maybe String
key
String
str <- CString -> Int -> IO String
unmarshallString' (Addr -> CString
CString Addr
arr) Int
len'
(String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key',String
str)
instance FromC Detail where fromC :: Int -> Detail
fromC = Detail -> Int -> Detail
forall a p. Enum a => p -> Int -> a
toEnum' Detail
NotifyAncestor
instance FromC Mode where fromC :: Int -> Mode
fromC = Mode -> Int -> Mode
forall a p. Enum a => p -> Int -> a
toEnum' Mode
NotifyNormal
instance FromC Visibility where fromC :: Int -> Visibility
fromC = Visibility -> Int -> Visibility
forall a p. Enum a => p -> Int -> a
toEnum' Visibility
VisibilityUnobscured
instance F.Storable XID where
sizeOf :: XlibKeySym -> Int
sizeOf (XID Int
x) = Int -> Int
forall a. Storable a => a -> Int
F.sizeOf Int
x
alignment :: XlibKeySym -> Int
alignment (XID Int
x) = Int -> Int
forall a. Storable a => a -> Int
F.alignment Int
x
peek :: Ptr XlibKeySym -> IO XlibKeySym
peek Ptr XlibKeySym
a = (Int -> XlibKeySym) -> IO Int -> IO XlibKeySym
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> XlibKeySym
XID (Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
F.peek (Ptr XlibKeySym -> Ptr Int
forall a b. Ptr a -> Ptr b
F.castPtr Ptr XlibKeySym
a))
poke :: Ptr XlibKeySym -> XlibKeySym -> IO ()
poke Ptr XlibKeySym
a (XID Int
x) = Ptr Int -> Int -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke (Ptr XlibKeySym -> Ptr Int
forall a b. Ptr a -> Ptr b
F.castPtr Ptr XlibKeySym
a) Int
x