module Graphics.X11.XInput.Foreign
(
xinputVersion,
setEventMask,
queryDevice,
grabDevice, ungrabDevice,
grabButton, ungrabButton,
grabKeycode, ungrabKeycode,
xiQueryDevice,
xQueryExtension,
getEventData,
freeEventData
) where
import Control.Applicative
import Control.Monad
import Data.Bits
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import qualified Graphics.X11 as X11
import Graphics.X11.XInput.Types
import Graphics.X11.XInput.Parser
queryDevice :: X11.Display
-> SelectDevices
-> IO [DeviceInfo]
queryDevice dpy devs = do
alloca $ \nptr -> do
dptr <- xiQueryDevice dpy (selectDevices devs) nptr
n <- peek nptr
let sz = 28
offsets = take (fromIntegral n) [0, sz ..]
dptrs = map (plusPtr dptr) offsets
forM dptrs peekStruct
foreign import ccall "Foreign.chs.h XIQueryDevice"
xiQueryDevice :: X11.Display -> CInt -> Ptr CInt -> IO DeviceInfoPtr
foreign import ccall "Foreign.chs.h XQueryExtension"
xQueryExtension :: X11.Display -> CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt
foreign import ccall "Foreign.chs.h XIQueryVersion"
xinputVersion :: X11.Display -> Ptr CInt -> Ptr CInt -> IO CInt
getEventData :: X11.Display -> EventCookiePtr -> IO (Bool)
getEventData a1 a2 =
let {a1' = display2ptr a1} in
let {a2' = castPtr a2} in
getEventData'_ a1' a2' >>= \res ->
let {res' = toBool res} in
return (res')
freeEventData :: X11.Display -> EventCookiePtr -> IO ()
freeEventData a1 a2 =
let {a1' = display2ptr a1} in
let {a2' = castPtr a2} in
freeEventData'_ a1' a2' >>= \res ->
return ()
pokeAlloca :: Storable a => a -> (Ptr a -> IO b) -> IO b
pokeAlloca x f =
alloca $ \ptr -> do
poke ptr x
f ptr
selectEvents :: X11.Display -> X11.Window -> EventMaskPtr -> Int -> IO ()
selectEvents a1 a2 a3 a4 =
let {a1' = display2ptr a1} in
let {a2' = fromIntegral a2} in
let {a3' = castPtr a3} in
let {a4' = fromIntegral a4} in
selectEvents'_ a1' a2' a3' a4' >>= \res ->
return ()
foreign import ccall unsafe "Foreign.chs.h XIGrabDevice"
xiGrabDevice :: X11.Display
-> DeviceID
-> X11.Window
-> X11.Time
-> X11.Cursor
-> X11.GrabMode
-> X11.GrabMode
-> CInt
-> EventMaskPtr
-> IO CInt
foreign import ccall unsafe "Foreign.chs.h XIUngrabDevice"
xiUngrabDevice :: X11.Display
-> DeviceID
-> X11.Time
-> IO X11.Status
foreign import ccall unsafe "Foreign.chs.h XIGrabButton"
xiGrabButton :: X11.Display
-> DeviceID
-> CInt
-> X11.Window
-> X11.Cursor
-> X11.GrabMode
-> X11.GrabMode
-> CInt
-> EventMaskPtr
-> CInt
-> GrabModifiersPtr
-> IO CInt
foreign import ccall unsafe "Foreign.chs.h XIUngrabButton"
xiUngrabButton :: X11.Display
-> DeviceID
-> X11.Button
-> X11.Window
-> CInt
-> GrabModifiersPtr
-> IO X11.Status
foreign import ccall unsafe "Foreign.chs.h XIGrabKeycode"
xiGrabKeycode :: X11.Display
-> DeviceID
-> X11.KeyCode
-> X11.Window
-> X11.GrabMode
-> X11.GrabMode
-> CInt
-> EventMaskPtr
-> CInt
-> GrabModifiersPtr
-> IO CInt
foreign import ccall unsafe "Foreign.chs.h XIUngrabKeycode"
xiUngrabKeycode :: X11.Display
-> DeviceID
-> X11.KeyCode
-> X11.Window
-> CInt
-> GrabModifiersPtr
-> IO X11.Status
grabDevice :: X11.Display
-> DeviceID
-> X11.Window
-> X11.Cursor
-> X11.GrabMode
-> X11.GrabMode
-> Bool
-> EventMask
-> IO X11.Status
grabDevice dpy dev win cursor
grab_mode paired_mode owner_events mask =
pokeAlloca mask $ \maskPtr ->
xiGrabDevice dpy dev win 0 cursor
grab_mode paired_mode
(fromBool owner_events)
maskPtr
ungrabDevice :: X11.Display
-> DeviceID
-> IO X11.Status
ungrabDevice dpy dev =
xiUngrabDevice dpy dev 0
grabButton :: X11.Display
-> SelectDevices
-> X11.Button
-> X11.Window
-> X11.Cursor
-> X11.GrabMode
-> X11.GrabMode
-> Bool
-> [EventType]
-> [GrabModifiers]
-> IO [GrabModifiers]
grabButton dpy dev btn win cursor
grab_mode paired_mode owner_events
events mods = do
let nMods = length mods
allocaArray nMods $ \modsPtr ->
withEventMask dpy win events $ \maskPtr -> do
pokeArray modsPtr mods
n <- xiGrabButton dpy (selectDevices dev)
(fromIntegral btn) win cursor
grab_mode paired_mode
(fromBool owner_events)
maskPtr
(fromIntegral nMods)
modsPtr
peekArray (fromIntegral n) modsPtr
ungrabButton :: X11.Display
-> SelectDevices
-> X11.Button
-> X11.Window
-> [GrabModifiers]
-> IO X11.Status
ungrabButton dpy dev btn win mods = do
let nMods = length mods
allocaArray nMods $ \modsPtr -> do
xiUngrabButton dpy (selectDevices dev)
(fromIntegral btn) win
(fromIntegral nMods)
modsPtr
grabKeycode :: X11.Display
-> SelectDevices
-> X11.KeyCode
-> X11.Window
-> X11.GrabMode
-> X11.GrabMode
-> Bool
-> [EventType]
-> [GrabModifiers]
-> IO [GrabModifiers]
grabKeycode dpy dev btn win
grab_mode paired_mode owner_events
events mods = do
let nMods = length mods
allocaArray nMods $ \modsPtr ->
withEventMask dpy win events $ \maskPtr -> do
pokeArray modsPtr mods
n <- xiGrabKeycode dpy (selectDevices dev)
(fromIntegral btn) win
grab_mode paired_mode
(fromBool owner_events)
maskPtr
(fromIntegral nMods)
modsPtr
peekArray (fromIntegral n) modsPtr
ungrabKeycode :: X11.Display
-> SelectDevices
-> X11.KeyCode
-> X11.Window
-> [GrabModifiers]
-> IO X11.Status
ungrabKeycode dpy dev btn win mods = do
let nMods = length mods
allocaArray nMods $ \modsPtr -> do
xiUngrabKeycode dpy (selectDevices dev)
(fromIntegral btn) win
(fromIntegral nMods)
modsPtr
addMask :: Ptr CUChar -> EventType -> IO ()
addMask ptr t = do
let event = eventType2int t
offset = fromIntegral $ event `shiftR` 3
mask = (1 `shiftL` (event .&. 7)) :: CUChar
value <- peekByteOff ptr offset :: IO CUChar
let newValue = value .|. mask
pokeByteOff ptr offset newValue
setEventMask :: X11.Display
-> X11.Window
-> [EventType]
-> IO ()
setEventMask dpy win list =
withEventMask dpy win list $ \maskptr ->
selectEvents dpy win maskptr 1
withEventMask :: X11.Display
-> X11.Window
-> [EventType]
-> (EventMaskPtr -> IO a)
-> IO a
withEventMask dpy win list callback = do
let len = (eventType2int XI_RawMotion + 7) `shiftR` 3
allocaBytes (fromIntegral len) $ \(maskptr :: EventMaskPtr) -> do
(\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) maskptr 0
(\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) maskptr len
allocaArray (fromIntegral len) $ \mask -> do
forM list $ addMask mask
(\ptr val -> do {pokeByteOff ptr 8 (val::(Ptr CUChar))}) maskptr mask
callback maskptr
foreign import ccall unsafe "Graphics/X11/XInput/Foreign.chs.h XGetEventData"
getEventData'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))
foreign import ccall unsafe "Graphics/X11/XInput/Foreign.chs.h XFreeEventData"
freeEventData'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO ())))
foreign import ccall unsafe "Graphics/X11/XInput/Foreign.chs.h XISelectEvents"
selectEvents'_ :: ((Ptr ()) -> (CULong -> ((Ptr ()) -> (CInt -> (IO CInt)))))