summaryrefslogtreecommitdiffstats
path: root/virtual-programs/keyboard.folk
blob: f28da39b664d45ab82ceae93340b3ff6f768368e (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
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]

# go through each keyboard device and start a process that 
foreach keyboard $keyboardDevices {
    Claim the keyboards are $keyboardDevices
    Start process "keyboard-$keyboard" {
        source "lib/key-codes.tcl"
        set KEY_STATES [list up down repeat]

        Wish $::thisProcess shares statements like \
            [list keyboard /kb/ claims key /k/ is /t/ with modifiers /m/ timestamp /timestamp/]
        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 create \
            shift 0 \
            ctrl 0 \
            alt 0 \
        ]
        while 1 {
            binary scan [read $keyboardChannel $evtBytes] $evtFormat \
                tvSec tvUsec type code value

            if {$type == 0x01} { ;# EV_KEY
                set shift [dict get $modifiers shift]
                set key [keyFromCode $code $shift]
                if {$key eq ""} { continue }

                set keyState [lindex $KEY_STATES $value]

                set isDown [expr {$keyState != "up"}]
                if {[string match *SHIFT $key]} {
                    dict set modifiers shift $isDown
                }
                if {[string match *CTRL $key]} {
                    dict set modifiers ctrl $isDown
                }
                if {[string match *ALT $key]} {
                    dict set modifiers alt $isDown
                }

                set heldModifiers [dict keys [dict filter $modifiers value 1]]
                set now [clock milliseconds]
                Assert keyboard $keyboardSpecifier claims key $key is $keyState with \
                                     modifiers $heldModifiers 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 modifiers /ms/ timestamp /timestamp/]]
                foreach event $events {
                    dict with event {
                        if {$now - $timestamp > 5000} {
                            Retract keyboard $keyboardSpecifier claims key $key is $keyState with modifiers $ms timestamp $timestamp
                        }
                    }
                }

                Step
            }
        }
    }
}