# variables:
# $train_commanded($train) $speed_step
+# $train_direction($train) forwards|backwards or unset
# $speedws [list $w ...]
#
# speed/${w}(...) aka s(...):
foreach w $speedws { eval [list $command $w] $args }
}
+proc speedws-fortrain {train command args} {
+ global speedws
+ foreach w $speedws {
+ upvar #0 speed/$w s
+ if {[string compare $s(train) $train]} continue
+ eval [list $command $w] $args
+ }
+}
+
proc speedw-new {w ctrlr} {
upvar #0 speed/$w s
global speedws
upvar #0 speed/$w s
set s(train) {}
$w.train configure -text $whystr
- $w.speed configure -textvariable {} -text -
+ $w.speed configure -text -
speedw-inhibit $w
}
proc speedw-train-selected {w t} {
upvar #0 speed/$w s
$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
+ speedw-redisplay-speed $w
+}
+
+proc speedw-redisplay-speed {w} {
+ upvar #0 speed/$w s
+ upvar #0 train_commanded($s(train)) gcommanded
+ upvar #0 train_direction($s(train)) gdirection
+ set t $gcommanded
+ if {[info exists gdirection]} {
+ switch -exact $gdirection {
+ forwards { set t "$t>" }
+ backwards { set t "<$t" }
+ }
+ }
+ $w.speed configure -text $t
}
proc speedw-train-direction {w dirchange} {
- # fixme nyi
+ upvar #0 speed/$w s
+ if {![string length $s(train)]} return
+ scmd routinecmd $s(ctrlr) "direction $s(train) $dirchange"
}
proc speedw-trains-available {w l} {
proc speedw-check {w} {
upvar #0 speed/$w s
+ if {![string length $s(train)]} return
upvar #0 train_commanded($s(train)) gcommanded
if {[info exists s(commanding)]} return
if {![info exists s(queued)]} return
}
proc speedws-train-problem {train} {
- speedws-forall speedw-train-problem $train
+ speedws-fortrain $train speedw-inhibit
}
-proc speedw-train-problem {w train} {
- upvar #0 speed/$w s
- if {[string compare $s(train) $train]} return
- speedw-inhibit $w
+
+register-event ?train_*_at {train direction} \
+ {^.train (\w+) at \S+ (forwards|backwards) } {
+ upvar #0 train_direction($train) dirn
+ set dirn $direction
+ speedws-fortrain $train speedw-redisplay-speed
}
register-event ?train_*_speed_commanding {train speed} \
{^.train (\w+) speed commanding (\d+) } {
upvar #0 train_commanded($train) cmd
set cmd $speed
+ speedws-fortrain $train speedw-redisplay-speed
}
proc speedws-stastate-hook {} {
proc ib-ev/wheelmouse/EV_KEY/BTN_LEFT {devid value} {
ib-selectnext $devid $value
}
+proc ib-ev/wheelmouse/EV_KEY/BTN_RIGHT {devid value} {
+ upvar #0 input/$devid in
+ if {!$value} return
+ speedw-train-direction $in(speedw) change
+}
proc ib-create/wheelmouse {devid wunique desc} {
ib-speedw-new $devid $wunique $desc