From: ian <ian>
Date: Sun, 13 Jul 2008 21:45:34 +0000 (+0000)
Subject: decouple input-binding from speedw
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=35560ae3f0ab4ec7a3b321137646cd05c0164ab8;p=trains.git

decouple input-binding from speedw
---

diff --git a/hostside/gui b/hostside/gui
index 8967904..e0a294a 100755
--- a/hostside/gui
+++ b/hostside/gui
@@ -506,52 +506,57 @@ proc ib-wheelmouse-stepmap {offset oldspeed} {
     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
@@ -565,10 +570,10 @@ proc scan-input-bindings {} {
     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 }
 	}
@@ -579,7 +584,7 @@ proc scan-input-bindings {} {
 	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]} {
@@ -589,68 +594,89 @@ proc scan-input-bindings {} {
 	}
     }
     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 }
@@ -660,11 +686,11 @@ proc catch-for-input-binding {key body} {
 	{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 {} {