xkbcommon-0.0.0: tests/state.hs

import Control.Monad
import Data.Maybe
import Data.Functor

import Text.XkbCommon
import Text.XkbCommon.Constants
import Text.XkbCommon.KeycodeList

import Common

blergh :: IO Bool -> IO ()
blergh iob = do
   b <- iob
   assert b "err"

testUpdateKey :: Keymap -> IO ()
testUpdateKey km = do
   st <- newKeyboardState km

   updateKeyboardStateKey st keycode_leftctrl keyDown
   blergh (stateModNameIsActive st modname_ctrl stateModDepressed)

   updateKeyboardStateKey st keycode_rightalt keyDown
   blergh (stateModNameIsActive st modname_ctrl stateModDepressed)
   blergh (stateModNameIsActive st modname_alt stateModDepressed)

   updateKeyboardStateKey st keycode_leftctrl keyUp
   blergh (liftM not $ stateModNameIsActive st modname_ctrl stateModDepressed)
   blergh (stateModNameIsActive st modname_alt stateModDepressed)

   updateKeyboardStateKey st keycode_rightalt keyUp
   blergh (liftM not $ stateModNameIsActive st modname_alt stateModDepressed)

   updateKeyboardStateKey st keycode_capslock keyDown
   blergh (stateModNameIsActive st modname_caps stateModDepressed)
   updateKeyboardStateKey st keycode_capslock keyUp
   blergh (liftM not $ stateModNameIsActive st modname_caps stateModDepressed)
   blergh (stateModNameIsActive st modname_caps stateModLocked)
   blergh (stateLedNameIsActive st ledname_caps)
   out <- getStateSyms st keycode_q
   assert (1 == length out) "err"
   assert (head out == keysym_Q) "err"

   updateKeyboardStateKey st keycode_numlock keyDown
   updateKeyboardStateKey st keycode_numlock keyUp
   blergh (stateModNameIsActive st modname_caps stateModLocked)
   blergh (stateModNameIsActive st "Mod2" stateModLocked)
   out <- getStateSyms st keycode_kp1
   assert (1 == length out) "err"
   assert (head out == keysym_KP_1) "err"
   blergh (stateLedNameIsActive st ledname_num)

   updateKeyboardStateKey st keycode_numlock keyDown
   updateKeyboardStateKey st keycode_numlock keyUp

   updateKeyboardStateKey st keycode_compose keyDown
   updateKeyboardStateKey st keycode_compose keyUp

   blergh (stateLedNameIsActive st "Group 2")
   out <- stateLedNameIsActive st ledname_num
   assert (not out) "err"

   updateKeyboardStateKey st keycode_compose keyDown
   updateKeyboardStateKey st keycode_compose keyUp

   updateKeyboardStateKey st keycode_capslock keyDown
   updateKeyboardStateKey st keycode_capslock keyUp
   blergh (liftM not $ stateModNameIsActive st modname_caps stateModEffective)
   blergh (liftM not $ stateLedNameIsActive st ledname_caps)
   out <- getStateSyms st keycode_q
   assert (1 == length out) "err"
   assert (head out == keysym_q) "err"


   out <- getStateSyms st keycode_6
   assert (5 == length out) "err"
   assert (head out == keysym_H) "err"
   assert (out !! 1 == keysym_E) "err"
   assert (out !! 2 == keysym_L) "err"
   assert (out !! 3 == keysym_L) "err"
   assert (out !! 4 == keysym_O) "err"

   out <- getOneKeySym st keycode_6
   assert (isNothing out) "err"
   updateKeyboardStateKey st keycode_6 keyDown
   updateKeyboardStateKey st keycode_6 keyUp

   out <- getOneKeySym st keycode_5
   assert (out == Just keysym_5) "err"


testSerialisation :: Keymap -> IO ()
testSerialisation km = do
   st <- newKeyboardState km

   let caps = fromJust $ keymapModIdx km modname_caps
   let shift = fromJust $ keymapModIdx km modname_shift
   let ctrl = fromJust $ keymapModIdx km modname_ctrl

   updateKeyboardStateKey st keycode_capslock keyDown
   updateKeyboardStateKey st keycode_capslock keyUp

   baseMods <- stateSerializeMods st stateModDepressed
   latchedMods <- stateSerializeMods st stateModLatched
   lockedMods <- stateSerializeMods st stateModLocked
   effectiveMods <- stateSerializeMods st stateModEffective

   assert (baseMods == 0) "baseMods invalid"
   assert (latchedMods == 0) "latchedMods invalid"
   assert (lockedMods == (2^unCModIndex caps)) "lockedMods invalid"
   assert (effectiveMods == lockedMods) "effectiveMods invalid"

   updateKeyboardStateKey st keycode_leftshift keyDown

   baseMods <- stateSerializeMods st stateModDepressed
   latchedMods <- stateSerializeMods st stateModLatched
   lockedMods <- stateSerializeMods st stateModLocked
   effectiveMods <- stateSerializeMods st stateModEffective

   assert (baseMods == (2^unCModIndex shift)) "baseMods invalid"
   assert (latchedMods == 0) "latchedMods invalid"
   assert (lockedMods == (2^unCModIndex caps)) "lockedMods invalid"
   assert (effectiveMods == (2^unCModIndex shift) + (2^unCModIndex caps)) "effectiveMods invalid"

   let baseModsWithCtrl = baseMods + 2^unCModIndex ctrl
   let layout0 = CLayoutIndex 0
   updateKeyboardStateMask st (baseModsWithCtrl, latchedMods, lockedMods) (layout0, layout0, layout0)

   blergh $ stateModIndexIsActive st ctrl stateModDepressed
   blergh $ stateModIndexIsActive st ctrl stateModEffective

testRepeat :: Keymap -> IO ()
testRepeat km = do
   assert (not $ keymapKeyRepeats km keycode_leftshift) "shift key repeat error"
   assert (keymapKeyRepeats km keycode_a) "a key repeat error"
   assert (keymapKeyRepeats km keycode_8) "8 key repeat error"
   assert (keymapKeyRepeats km keycode_down) "down key repeat error"
   assert (keymapKeyRepeats km keycode_kbdillumdown) "kbdillumdown key repeat error"

testConsume :: Keymap -> IO ()
testConsume km = do
   st <- newKeyboardState km

   let alt = fromJust $ keymapModIdx km modname_alt
   let shift = fromJust $ keymapModIdx km modname_shift

   updateKeyboardStateKey st keycode_leftalt keyDown
   updateKeyboardStateKey st keycode_leftshift keyDown
   updateKeyboardStateKey st keycode_equal keyDown

   mask <- stateSerializeMods st stateModEffective
   assert (mask == 2^unCModIndex alt + 2^unCModIndex shift) "err"

   newMask <- stateRemoveConsumed st keycode_equal mask
   assert (newMask == 2^unCModIndex alt) $
               "consumed error: mask " ++ show mask
               ++ ", newMask " ++ show newMask
               ++ ", expected " ++ show (2^unCModIndex alt)

{- UNSUPPORTED AT THIS STAGE
static void
key_iter(struct xkb_keymap *keymap, xkb_keycode_t key, void *data)
{
    int *counter = (int *) data;

    assert(*counter == key);
    (*counter)++;
}

static void
test_range(struct xkb_keymap *keymap)
{
    int counter;

    assert(xkb_keymap_min_keycode(keymap) == 9);
    assert(xkb_keymap_max_keycode(keymap) == 253);

    counter = xkb_keymap_min_keycode(keymap);
    xkb_keymap_key_for_each(keymap, key_iter, &counter);
    assert(counter == xkb_keymap_max_keycode(keymap) + 1);
}
-}

main = do
   ctx <- getTestContext
   km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO
         (Just "evdev")
         (Just "pc104")
         (Just "us,ru")
         Nothing
         (Just "grp:menu_toggle"))

   testUpdateKey km
   testSerialisation km
   testRepeat km
   testConsume km
{-   testRange km-}