## keys-and-buttons.pkg
#
# Representing and manipulating
# modifier key sets and mouse button sets.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublibstipulate
package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkgherein
package keys_and_buttons
: (weak) Keys_And_Buttons # Keys_And_Buttons is from src/lib/x-kit/xclient/src/wire/keys-and-buttons.api {
my (&) = unt::bitwise_and;
my (|) = unt::bitwise_or;
my (<<) = unt::(<<);
infix my & | << ;
# Modifier key states:
# # See p114-115 (117-118) http://mythryl.org/pub/exene/X-protocol-R6.pdf
shift_mask = 0ux0001;
lock_mask = 0ux0002;
cntl_mask = 0ux0004;
mod1mask = 0ux0008;
mod2mask = 0ux0010;
mod3mask = 0ux0020;
mod4mask = 0ux0040;
mod5mask = 0ux0080;
fun union_of_modifier_keys_states (xt::MKSTATE m1, xt::MKSTATE m2) => xt::MKSTATE (m1 | m2);
union_of_modifier_keys_states _ => xt::ANY_MOD_KEY;
end;
fun intersection_of_modifier_keys_states (xt::MKSTATE m1, xt::MKSTATE m2) => xt::MKSTATE (m1 & m2);
intersection_of_modifier_keys_states (xt::ANY_MOD_KEY, m) => m;
intersection_of_modifier_keys_states (m, xt::ANY_MOD_KEY) => m;
end;
fun modifier_keys_states_match (xt::MKSTATE m1, xt::MKSTATE m2) => (m1 == m2);
modifier_keys_states_match (_, xt::ANY_MOD_KEY) => TRUE;
modifier_keys_states_match _ => FALSE;
end;
fun modifier_keys_state_is_empty xt::ANY_MOD_KEY => TRUE;
modifier_keys_state_is_empty (xt::MKSTATE 0u0) => TRUE;
modifier_keys_state_is_empty _ => FALSE;
end;
fun make_modifier_keys_state l
=
{
exception ANY;
fun f ([], m)
=>
xt::MKSTATE m;
f (k ! r, m)
=>
{
mask = case k
#
xt::ANY_MODIFIER => raise exception ANY;
xt::SHIFT_KEY => shift_mask;
xt::LOCK_KEY => lock_mask;
xt::CONTROL_KEY => cntl_mask;
xt::MOD1KEY => mod1mask;
xt::MOD2KEY => mod2mask;
xt::MOD3KEY => mod3mask;
xt::MOD4KEY => mod4mask;
xt::MOD5KEY => mod5mask;
esac;
f (r, m | mask);
};
end;
(f (l, 0u0))
except
ANY = xt::ANY_MOD_KEY;
};
fun shift_key_is_set xt::ANY_MOD_KEY => TRUE;
shift_key_is_set (xt::MKSTATE s) => ((s & shift_mask) != 0u0);
end;
fun shiftlock_key_is_set xt::ANY_MOD_KEY => TRUE;
shiftlock_key_is_set (xt::MKSTATE s) => ((s & lock_mask) != 0u0);
end;
fun control_key_is_set xt::ANY_MOD_KEY => TRUE;
control_key_is_set (xt::MKSTATE s) => ((s & cntl_mask) != 0u0);
end;
fun modifier_key_is_set (xt::ANY_MOD_KEY, _) => TRUE;
modifier_key_is_set (xt::MKSTATE s, i) => ((s & (mod1mask << unt::from_int (i - 1))) != 0u0);
end;
# Mouse button states: # These are the actual X protocol wire encodings.
# # See p114-115 (117-118) http://mythryl.org/pub/exene/X-protocol-R6.pdf
but1mask = 0ux0100;
but2mask = 0ux0200;
but3mask = 0ux0400;
but4mask = 0ux0800;
but5mask = 0ux1000;
#
all_mousebuttons_mask = 0ux1f00;
fun union_of_mousebutton_states (xt::MOUSEBUTTON_STATE m1, xt::MOUSEBUTTON_STATE m2) = xt::MOUSEBUTTON_STATE (m1 | m2);
fun intersection_of_mousebutton_states (xt::MOUSEBUTTON_STATE m1, xt::MOUSEBUTTON_STATE m2) = xt::MOUSEBUTTON_STATE (m1 & m2);
fun invert_button_in_mousebutton_state (xt::MOUSEBUTTON_STATE s, xt::MOUSEBUTTON b)
=
xt::MOUSEBUTTON_STATE (unt::bitwise_xor (s, but1mask << (unt::from_int (b - 1))));
fun make_mousebutton_state l
=
f (l, 0u0)
where
fun f ([], m) => xt::MOUSEBUTTON_STATE m;
f ((xt::MOUSEBUTTON i) ! r, m) => f (r, m | (but1mask << unt::from_int (i - 1)));
end;
end;
fun no_mousebuttons_set (xt::MOUSEBUTTON_STATE s) = (s & all_mousebuttons_mask) == 0u0;
fun some_mousebutton_is_set (xt::MOUSEBUTTON_STATE s) = (s & all_mousebuttons_mask) != 0u0;
#
fun mousebutton_1_is_set (xt::MOUSEBUTTON_STATE s) = (s & but1mask) != 0u0;
fun mousebutton_2_is_set (xt::MOUSEBUTTON_STATE s) = (s & but2mask) != 0u0;
fun mousebutton_3_is_set (xt::MOUSEBUTTON_STATE s) = (s & but3mask) != 0u0;
fun mousebutton_4_is_set (xt::MOUSEBUTTON_STATE s) = (s & but4mask) != 0u0;
fun mousebutton_5_is_set (xt::MOUSEBUTTON_STATE s) = (s & but5mask) != 0u0;
#
fun mousebutton_is_set
( xt::MOUSEBUTTON_STATE s,
xt::MOUSEBUTTON i
)
=
(s & (but1mask << unt::from_int (i - 1))) != 0u0;
}; # package keys_and-buttons
end;