From 5b84d2c525d8987fae38b7b632c496667b8ab390 Mon Sep 17 00:00:00 2001 From: ian Date: Sun, 8 Jun 2008 00:18:49 +0000 Subject: [PATCH] can set speeds we think --- hostside/gui | 67 +++++++++++++++++++++++++++++--------- hostside/gui-config | 1 + hostside/gui-plan-testdata | 10 +++++- 3 files changed, 61 insertions(+), 17 deletions(-) diff --git a/hostside/gui b/hostside/gui index 279aa9c..c083ef4 100755 --- a/hostside/gui +++ b/hostside/gui @@ -285,9 +285,6 @@ proc layout-data {} { # while we're executing a speed command, to avoid loss of steps during # quick motions. -# for rel speedws: -# $s(stepmap) from creator - # Interfaces for concrete controllers: # speedw-new $w $ctrlr {stepmap} # speedw-setstate $w disabled|normal controller appears/disappears @@ -310,7 +307,6 @@ proc speedw-new {w ctrlr} { lappend speedws $w set s(ctrlr) $ctrlr set s(inhibit) 0 - set s(commanding) 0 frame $w -relief groove -border 1 label $w.ctrlr -state disabled -text $s(ctrlr) @@ -340,10 +336,13 @@ proc speedw-inhibit {w} { set s(inhibit) 2 $w.speed configure -foreground red } -proc speedw-uninhibit {w} { +proc speedw-uninhibit {w max} { upvar #0 speed/$w s + set r $s(inhibit) + if {$r>$max} { return -1 } set s(inhibit) 0 $w.speed configure -foreground white + return $r } proc speedw-setstate {w disnorm} { @@ -356,6 +355,7 @@ proc speedw-train-selected {w t} { $w.train configure -text $t $w.speed configure -text {} -textvariable train_commanded($t) set s(inhibit) 1 + set s(train) $t $w.speed configure -foreground white } @@ -385,8 +385,8 @@ proc speedw-trains-available {w l} { proc speedw-userinput-abs {w speed} { upvar #0 speed/$w s if {![string length $s(train)]} return - set $s(queued) $speed - speedw-check + set s(queued) $speed + speedw-check $w } proc speedw-check {w} { @@ -398,18 +398,23 @@ proc speedw-check {w} { unset s(queued) if {$s(inhibit)} { if {$newspeed > $gcommanded} return - speedw-uninhibit $w + speedw-uninhibit $w 2 } set s(commanding) $newspeed scmd speedw-commanded $s(ctrlr) "speed $s(train) $newspeed" $w } proc speedw-commanded-nak {m args} { error "got nak from speed: $m" } -proc speedw-commanded-ok {m w} { upvar #0 speed/$w s; unset s(commanding) } +proc speedw-commanded-ok {m w} { + upvar #0 speed/$w s + unset s(commanding) + speedw-check $w +} proc speedw-commanded-err {m w} { upvar #0 speed/$w s unset s(commanding) speedw-inhibit $w + speedw-check $w } proc speedw-userinput-rel {w stepmap} { @@ -423,7 +428,7 @@ proc speedw-userinput-rel {w stepmap} { } else { set oldspeed $gcommanded } - set newspeed [eval $s(stepmap) [list $oldspeed]] + set newspeed [eval $stepmap [list $oldspeed]] speedw-userinput-abs $w $newspeed } @@ -444,7 +449,7 @@ register-event ?train_*_speed_commanded {train speed} \ proc speedws-stastate-hook {} { global train_commanded stastate - switch -exact $stastate { + switch -exact -- $stastate { Run { set trains [array names train_commanded] speedws-forall speedw-trains-available $trains @@ -464,6 +469,33 @@ register-event &train_*_signalling-problem {train problem} \ speedws-train-problem $train } +#---------- concrete input bindings ---------- + +proc ib-wheelmouse-stepmap {offset oldspeed} { + upvar #0 ib_wheelmouse_stepmap map + set ixabove 0 + foreach entry $map { + if {$entry==$oldspeed} { set ixbelow $ixabove; break } + if {$entry>$oldspeed} break + set ixbelow $ixabove + incr ixabove + } + set ix [expr {($offset>0 ? $ixbelow : $ixabove) + $offset}] + if {$ix<0} { return 0 } + if {$ix>=[llength $map]} { return [lindex $map end] } + return [lindex $map $ix] +} + +proc ib-wheelmouse-EV_REL/REL_WHEEL {w value} { + if {$value<0} { + if {[speedw-uninhibit $w 2]>0} { incr value 1 } + if {!$value} return + } else { + speedw-uninhibit $w 1 + } + speedw-userinput-rel $w [list ib-wheelmouse-stepmap $value] +} + #---------- input device evdev binding ---------- proc bind-input {bus vendor product version concrete ctrlr} { @@ -548,12 +580,12 @@ proc scan-input-bindings {} { if {$newlast < $now} { set newlast $now } set in(laststart) $newlast manyset [lindex $target($key) 0] ev sysfs - set cmdl [list ./evdev-manip --grab --stdin-monitor \ + 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" - set in(chan) [open |$cmdl r] + 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]] @@ -587,7 +619,7 @@ proc input-binding-inputline {chan l key} { manyset [split $l] dummy dummy kind code value set proc ib-$in(concrete)-$kind/$code if {[catch { info args $proc }]} return - $proc $value + $proc $in(w) $value } {report-from *} { } {synch *} { } @@ -641,7 +673,7 @@ proc train-event-eof {args} { register-event ?stastate {ctxch state} {^(.)stastate (\w+|\-) } { global ctrain trains stastate set stastate $state - if {[string compare ctxch |]} speedws-stastate-hook + if {[string compare $ctxch |]} speedws-stastate-hook } register-event {} {} {^=connected } { @@ -676,7 +708,10 @@ register-event {} {} {^\+nack } { error "multiplexer does not understand" } append event_dispatch_body { debug "ignored $l" } -proc train-event-inputline {sconn l} $event_dispatch_body +proc train-event-inputline {sconn l} " +puts stderr \"<<<\$l\" +$event_dispatch_body +" proc register-event {args} { error "too late!" } proc engage-server {} { diff --git a/hostside/gui-config b/hostside/gui-config index 9b86f11..d08a941 100644 --- a/hostside/gui-config +++ b/hostside/gui-config @@ -7,4 +7,5 @@ set movpos_bindings(bot) { J I O M K L } +set ib_wheelmouse_stepmap {0 1 10 20 35 50 65 80 95 110 126} bind-input 0003 045e 0084 0390 wheelmouse "wheel mouse" diff --git a/hostside/gui-plan-testdata b/hostside/gui-plan-testdata index 27db520..5891eb5 100644 --- a/hostside/gui-plan-testdata +++ b/hostside/gui-plan-testdata @@ -11,5 +11,13 @@ movpos A5 feat P 2 point movpos Q0 feat Q 0 two movpos X8 feat P 0 three picio out polarity -train shinkansen speed commanded 100 +train shinkansen speed commanded 0 stastate Run +train shinkansen speed commanded 100 + +executing speed +train shinkansen speed commanded 95 +ack speed ok + +executing speed +ack speed SignallingPredictedProblem shinkansen X3 : some burblings -- 2.30.2