blob: fa242379fc75924fc0f99c13c530eeab4b259212 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
set ::debug_keyboard true
proc establishKeyPressListener {keyboard} {
set kb [open $keyboard r]
fconfigure $kb -translation binary
return $kb
}
# Function to check if the device is a keyboard
proc isKeyboard {device} {
set properties [exec udevadm info --query=property --name=$device]
if {$properties eq ""} {
return false
}
set isKeyboard [string match *ID_INPUT_KEYBOARD=1* $properties]
return $isKeyboard
# TODO: Excluding mice would nice to keey the list of keyboard devices short
# Alas, including mice is necessary for the Logitech K400R keyboard
# set isMouse [string match *ID_INPUT_MOUSE=1* $properties]
# return [expr {$isKeyboard && !$isMouse}]
}
####
# /dev/input/event* addresses are the ground truth for keyboard devices
#
# This function goes through each of them and checks if they are keyboards
proc walkInputEventPaths {} {
# set allDevices [glob -nocomplain "/dev/input/event*"]
set allDevices [glob -nocomplain "/dev/input/by-path/*"]
set keyboards [list]
foreach device $allDevices {
if {[isKeyboard $device]} {
if {[file readable $device] == 0} {
puts "Device $device is not readable. Attempting to change permissions."
# Attempt to change permissions so that the file can be read
exec sudo chmod +r $device
}
lappend keyboards $device
}
}
return $keyboards
}
set keyboardDevices [walkInputEventPaths]
set globalKeymap [keymap load "us"]
# go through each keyboard device and start a process that
foreach keyboard $keyboardDevices {
Claim the keyboards are $keyboardDevices
Start process "keyboard-$keyboard" {
source "lib/Keymap.tcl"
set KEY_STATES [list up down repeat]
Wish $::thisProcess shares statements like \
[list keyboard /kb/ claims key /k/ is /t/ with timestamp /timestamp/]
Wish $::thisProcess receives statements like \
[list /someone/ claims /page/ is a keyboard with path $keyboard locale /locale/]
set ::localKeymap ""
When $keyboardSpecifier is a keyboard with path $keyboard locale /locale/ {
set ::localKeymap [keymap load $locale]
On unmatch {
keymap destroy $::localKeymap
set ::localKeymap ""
}
}
variable evtBytes 16
variable evtFormat iissi
if {[exec getconf LONG_BIT] == 64} {
set evtBytes 24
set evtFormat wwssi
}
set keyboardSpecifier $keyboard
variable keyboardChannel [open $keyboard r]
chan configure $keyboardChannel -translation binary
set modifiers [dict map {k v} $keymap::modWeights 0]
while 1 {
binary scan [read $keyboardChannel $evtBytes] $evtFormat \
tvSec tvUsec type code value
if {$type == 0x01} { ;# EV_KEY
set activeKeymap [expr {$localKeymap eq "" ? $globalKeymap : $localKeymap}]
set mods [+ {*}[dict values $modifiers]]
set key [keymap resolve $activeKeymap $code $mods]
if {$key eq ""} { continue }
set keyState [lindex $KEY_STATES $value]
set isDown [expr {$keyState != "up"}]
if {[dict exists $keymap::modWeights $key]} {
set weight [dict get $keymap::modWeights $key]
dict set modifiers $key [expr {$isDown * $weight}]
}
set now [clock milliseconds]
Assert keyboard $keyboardSpecifier claims key $key is $keyState with timestamp $now
puts "Assert keyboard $keyboardSpecifier claims key $key is $keyState with timestamp $now"
# Retract all key events that are more than 5 seconds old.
set events [Statements::findMatches [list keyboard $keyboardSpecifier claims key /key/ is /keyState/ with timestamp /timestamp/]]
foreach event $events {
dict with event {
if {$now - $timestamp > 5000} {
Retract keyboard $keyboardSpecifier claims key $key is $keyState with timestamp $timestamp
}
}
}
Step
}
}
}
}
|
