module Test.Robot.Internal.XTest
(
keyboard
, button
, motion
, getKeysymMap
) where
import Control.Arrow (second)
import Control.Applicative (liftA2)
import Control.Monad ((>=>))
import Data.List (unfoldr)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Tuple (swap)
import Data.Int (Int16)
import Graphics.XHB
import Graphics.XHB.Gen.Test
keyboard :: Connection -> Bool -> KEYCODE -> IO ()
keyboard c press keycode =
let eventType = if press then 2 else 3
req = MkFakeInput eventType keycode 0 noWindow 0 0 0
in fakeInput c req
button :: Connection -> Bool -> BUTTON -> IO ()
button c press butt =
let eventType = if press then 4 else 5
req = MkFakeInput eventType butt 0 noWindow 0 0 0
in fakeInput c req
motion :: Connection -> Bool -> (Int16, Int16) -> IO ()
motion c relative (x, y) =
let eventType = 6
isRelative = if relative then 1 else 0
req = MkFakeInput eventType isRelative 0 noWindow
(fromIntegral x) (fromIntegral y) 0
in fakeInput c req
noWindow :: WINDOW
noWindow = fromXid xidNone
getKeyboardMap :: Connection -> IO (Map KEYCODE [KEYSYM])
getKeyboardMap c = do
let (low, high) = keycodeRange c
MkGetKeyboardMappingReply
{ keysyms_per_keycode_GetKeyboardMappingReply = blockSize
, keysyms_GetKeyboardMappingReply = rawKeysyms }
<- getKeyboardMapping c low (highlow+1) >>= getReply'
return . M.fromList $ zip [low..high]
(chunksOf (fromIntegral blockSize) rawKeysyms)
getReply' :: Receipt a -> IO a
getReply' = getReply >=> either (error . show) return
chunksOf :: Int -> [a] -> [[a]]
chunksOf k = unfoldr $ \xs -> case xs of
[] -> Nothing
_ -> Just (splitAt k xs)
getKeysymMap :: Connection -> IO (Map KEYSYM KEYCODE)
getKeysymMap = fmap flipTable . getKeyboardMap
flipTable :: Map KEYCODE [KEYSYM] -> Map KEYSYM KEYCODE
flipTable
= M.fromList
. map swap
. concatMap expandEntry
. removeZeroes
. M.toList
where
removeZeroes = map (second (filter (/= 0)))
expandEntry :: (a, [b]) -> [(a, b)]
expandEntry (x, ys) = zip (repeat x) ys
keycodeRange :: Connection -> (KEYCODE, KEYCODE)
keycodeRange
= liftA2 (,) min_keycode_Setup max_keycode_Setup . connectionSetup