return [lindex $map $ix]
}
-proc ib-wheelmouse-EV_REL/REL_WHEEL {w value} {
+proc ib-ev/wheelmouse/EV_REL/REL_WHEEL {w value} {
+ upvar #0 input/$devid in
if {$value<0} {
- if {[speedw-uninhibit $w 2]>0} { incr value 1 }
+ if {[speedw-uninhibit $in(speedw) 2]>0} { incr value 1 }
if {!$value} return
} else {
- speedw-uninhibit $w 1
+ speedw-uninhibit $in(speedw) 1
}
- speedw-userinput-rel $w [list ib-wheelmouse-stepmap $value]
+ speedw-userinput-rel $in(speedw) [list ib-wheelmouse-stepmap $value]
+}
+
+proc ib-create/wheelmouse {devid wunique desc} {
+ upvar #0 input/$devid in
+ set w .inputs.$wunique
+ speedw-new $w $desc
+ pack $w -side top -padx 10
+ set in(speedw) $w
}
#---------- input device evdev binding ----------
-proc bind-input {bus vendor product version concrete ctrlr} {
+proc bind-input {bus vendor product version concrete args} {
global input_bindings
- set key $bus:$vendor:$product:$version
- lappend input_bindings [list $key $concrete $ctrlr]
+ set devid $bus:$vendor:$product:$version
+ lappend input_bindings [list $devid $concrete $args]
}
proc widgets-input-bindings {} {
global input_bindings
frame .inputs
foreach binding $input_bindings {
- manyset $binding key concrete ctrlr
+ manyset $binding devid concrete xa
upvar #0 concreteix($concrete) cix
if {![info exists cix]} { set cix 0 }
incr cix
- set w .inputs.$concrete$cix
- speedw-new $w $ctrlr
- pack $w -side left -padx 10
- upvar #0 input/$key in
-puts stderr $key
- set in(w) $w
+ upvar #0 input/$devid in
set in(laststart) 0
set in(concrete) $concrete
+ eval [list ib-create/$concrete $devid $concrete$cix] $xa
}
pack .inputs -side top -fill x
}
# input/$bus:$vendor:$product:$version becomes `in' via upvar
-# $in(w) the speedw
# $in(chan) channel open onto evdev-manip; unset if none
# $in(laststart) last start time, [clock seconds]
# at every event we set this the current time
# but we insist on adding at least 5s
# and if that would make it > current time +15s
# we don't start
+# $in(speedw) optional, may be set by ib-create
proc scan-input-bindings {} {
global errorInfo errorCode
while 1 {
set r [gets $f l]
if {$r <= 0} {
- if {[info exists v(key)] &&
+ if {[info exists v(devid)] &&
[info exists v(sysfs)] &&
[info exists v(event)]} {
- lappend target($v(key)) [list $v(event) $v(sysfs)]
+ lappend target($v(devid)) [list $v(event) $v(sysfs)]
}
catch { unset v }
}
if {[regexp \
{^I: Bus=(\w+) Vendor=(\w+) Product=(\w+) Version=(\w+)\s} \
$l dummy bus vendor product version]} {
- set v(key) $bus:$vendor:$product:$version
+ set v(devid) $bus:$vendor:$product:$version
} elseif {[regexp {^S: Sysfs=(\S+)\s} $l dummy sysfs]} {
set v(sysfs) $sysfs
} elseif {[regexp {^H: Handlers=(?:.*\s)?(event\d+)\s} $l dummy ev]} {
}
}
close $f
- foreach key [array names target] {
- if {[llength $target($key)] > 1} { unset target($key); continue }
- upvar #0 input/$key in
- if {![info exists in(w)]} continue
+ foreach devid [array names target] {
+ if {[llength $target($devid)] > 1} { unset target($devid); continue }
+ upvar #0 input/$devid in
+ if {![info exists in(concrete)]} continue
if {[info exists in(chan)]} continue
set now [clock seconds]
set newlast [expr {$in(laststart) + $inputretryadd}]
if {$newlast > $now + $inputretrymax} continue
if {$newlast < $now} { set newlast $now }
set in(laststart) $newlast
- manyset [lindex $target($key) 0] ev sysfs
- set cmdl [list 2>@ stderr ./evdev-manip --grab --stdin-monitor \
- --expect-sysfs /sys$sysfs/$ev/dev \
- /dev/input/$ev]
- catch-for-input-binding $key {
- debug "i-b $key running $cmdl"
+ if {[catch { info args ib-evcmd/$in(concrete) }]} {
+ manyset [lindex $target($devid) 0] ev sysfs
+ set cmdl [list 2>@ stderr ./evdev-manip --grab --stdin-monitor \
+ --expect-sysfs /sys$sysfs/$ev/dev \
+ /dev/input/$ev]
+ } else {
+ set cmdl [eval [list ib-evcmd/$in(concrete) $devid] \
+ $target($devid)]
+ }
+ catch-for-input-binding $devid {
+ debug "ib $devid running $cmdl"
set in(chan) [open |$cmdl r+]
fconfigure $in(chan) -blocking 0 -buffering line
- fileevent $in(chan) readable [list catch-for-input-binding $key \
- [list readable input-binding $in(chan) $key]]
+ fileevent $in(chan) readable [list catch-for-input-binding $devid \
+ [list readable input-binding $in(chan) $devid]]
}
}
foreach binding $input_bindings {
- manyset $binding key concrete ctrlr
- upvar #0 input/$key in
- if {![info exists in(w)]} continue
- if {[info exists target($key)]} continue
- speedw-setstate $in(w) disabled
+ manyset $binding devid concrete ctrlr
+ upvar #0 input/$devid in
+ if {![info exists in(concrete)]} continue
+ if {[info exists target($devid)]} continue
+ input-binding-notpresent $devid absent
}
after $scaninputinterval scan-input-bindings
}
-proc input-binding-eof {chan key} {
- upvar #0 input/$key in
+proc input-binding-notpresent {devid why} {
+ upvar #0 input/$devid in
+ if {[info exists in(speedw)]} {
+ speedw-setstate $in(speedw) disabled
+ }
+ if {![catch { info args ib-absent/$in(concret) }]} {
+ ib-absent/$in(concrete) $devid $why
+ }
+}
+
+proc input-binding-eof {chan devid} {
+ upvar #0 input/$devid in
fconfigure $in(chan) -blocking 1
close $in(chan)
error "evdev-manip exited" {} {CHILDSTATUS ? 0}
}
-proc input-binding-inputline {chan l key} {
- upvar #0 input/$key in
+proc input-binding-inputline {chan l devid} {
+ upvar #0 input/$devid in
+ if {![catch { info args ib-inputline/$in(concrete) }]} {
+ # give the input binding first dibs
+ if {[ib-inputline/$in(concrete) $devid $l]} return
+ }
switch -glob -- $l {
{device *} {
- debug "i-b $key start << $l"
- speedw-setstate $in(w) normal
+ debug "ib $devid start << $l"
+ if {[info exists in(speedw)]} {
+ speedw-setstate $in(speedw) normal
+ }
}
{event *} {
manyset [split $l] dummy dummy kind code value
- set proc ib-$in(concrete)-$kind/$code
+ set proc ib/$in(concrete)/$kind/$code
if {[catch { info args $proc }]} return
- $proc $in(w) $value
+ $proc $devid $value
}
{report-from *} { }
{synch *} { }
* {
- debug "i-b $key ignored << $l"
+ debug "ib $devid ignored << $l"
}
}
}
-proc catch-for-input-binding {key body} {
- upvar #0 input/$key in
+proc catch-for-input-binding {devid body} {
+ upvar #0 input/$devid in
global errorInfo errorCode
set r [catch { uplevel 1 $body } rv]
if {$r!=1} { return -code $r $rv }
{POSIX *} { set m "communication error: [lindex $errorCode 1]" }
* { error $rv $errorInfo $errorCode }
}
- debug "i-b $key died $m"
+ debug "ib $devid died $m"
catch { close $in(chan) }
catch { unset in(chan) }
- speedw-setstate $in(w) disabled
+ input-binding-notpresent $devid "died $m"
}
proc engage-input-bindings {} {
~ijackson / trains.git / commitdiff