From 8caad10e2f76306125e9ee67c9ae0d65cdb1baa7 Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Sun, 20 Jul 2008 17:59:42 +0000
Subject: [PATCH] can go backwards

---
 hostside/gui | 51 +++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 43 insertions(+), 8 deletions(-)

diff --git a/hostside/gui b/hostside/gui
index b946d43..855c4fc 100755
--- a/hostside/gui
+++ b/hostside/gui
@@ -290,6 +290,7 @@ proc layout-data {} {
 
 # variables:
 #   $train_commanded($train)    $speed_step
+#   $train_direction($train)    forwards|backwards or unset
 #   $speedws                    [list $w ...]
 #
 # speed/${w}(...) aka s(...):
@@ -326,6 +327,15 @@ proc speedws-forall {command args} {
     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
@@ -353,7 +363,7 @@ proc speedw-train-noneselected {w whystr} {
     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
 }
 
@@ -390,14 +400,30 @@ proc speedw-train-selectnext {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} {
@@ -432,6 +458,7 @@ proc speedw-userinput-abs {w speed} {
 
 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
@@ -484,18 +511,21 @@ proc speedw-userinput-rel-steps {w delta steplist} {
 }
 
 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 {} {
@@ -579,6 +609,11 @@ proc ib-selectnext {devid value} {
 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
-- 
2.30.2