fixes from bessar fettling session

[trains.git] / hostside / gui-displayer

diff --git a/hostside/gui-displayer b/hostside/gui-displayer
index acd395e837188443e4bd2edea2442d10099ca309..eadac7d9fa4a603520de7e336704bdc2c8362171 100755 (executable)
--- a/hostside/gui-displayer
+++ b/hostside/gui-displayer
@@ -1,14 +1,15 @@
-#!/usr/bin/wish
+#!/usr/bin/wish8.2
 
 proc widgets {} {
     global widg_pipe
-    set sizes [exec ./gui-plan --sizes]
+    set sizes [exec ./gui-plan-bot --sizes]
     frame .picture -background {} \
            -width [lindex $sizes 0] \
            -height [lindex $sizes 1]
     pack .picture
     tkwait visibility .picture
-    set widg_pipe [open |[list ./gui-plan [winfo id .picture] >&@ stderr] w]
+    set widg_pipe [open |[list ./gui-plan-bot \
+           [winfo id .picture] >&@ stderr] w]
 }
 
 proc setsegbyname {segfeatname command {posnum {}}} {
@@ -33,6 +34,7 @@ proc update_push {} {
 #        $power                    = 0 or 1
 #        $segrev($segname)         = 0 or 1
 #        $segdet($segname)         = 0 or 1
+#        $segown($segname)         = {} or t or f
 #        $movpos($segname/$movfeat) = $pos (number) or {} meaning unknown
 
 proc P {onoff} { # power
@@ -42,27 +44,30 @@ proc P {onoff} { # power
     update_push
 }
 
-proc R {args} { # reverse segnames
+proc R {now args} { # reverse segnames
     foreach segname $args {
        upvar #0 segrev($segname) r
-       set r [expr {!$r}]
+       set r $now
        update_seg $segname
     }
     update_push
 }
 
-proc D0 {args} { train_presence 0 $args }
-proc D1 {args} { train_presence 1 $args }
-
-proc train_presence {yn l} {
+proc setsegs {segfoo value l} {
     foreach segname $l {
-       upvar #0 segdet($segname) d
-       set d $yn
+       upvar #0 ${segfoo}($segname) d
+       set d $value
        update_seg $segname
     }
     update_push
 }
 
+proc D0 {args} { setsegs segdet 0 $args }
+proc D1 {args} { setsegs segdet 1 $args }
+proc OT {args} { setsegs segown t $args }
+proc OF {args} { setsegs segown f $args }
+proc ON {args} { setsegs segown {} $args }
+
 proc M {segname mp {movfeat P}} { # mp==x is unknown
     upvar #0 movpos($segname/$movfeat) p
     upvar #0 movconfs($segname/$movfeat) n
@@ -81,33 +86,35 @@ proc update_allsegs {} {
 proc update_seg {segname} {
     upvar #0 segrev($segname) r
     upvar #0 segdet($segname) d
+    upvar #0 segown($segname) o
     upvar #0 segmovs($segname) movs
     global power
 
 #puts stderr "update_seg $segname"
 
     if {!$power} {
-       set command off
+        set command off
     } else {
        set command [expr {$d ? "det" : "on"}]
        if {$r} { set command "i$command" }
+       set command $o$command
     }
     setsegbyname $segname $command
 
     foreach mov $movs {
 #puts stderr "update_seg $segname mov $mov"
        upvar #0 movpos($mov) mp
-       if {[string length $mp]} {
+       if {[string length $mp] && [string compare off $command]} {
            setsegbyname $mov $command $mp
        } else {
-           setsegbyname $mov off
+           setsegbyname $mov $command
        }
     }
 }
 
 proc setup {} {
     global segnum segmovs movconfs
-    global power segrev segdet movpos
+    global power segrev segdet segown movpos
     set power 0
     set f [open ../layout/ours.dgram-bot.segcmap]
     while {[gets $f l] >= 0} {
@@ -116,6 +123,7 @@ proc setup {} {
            set segmovs($segname) {}
            set segrev($segname) 0
            set segdet($segname) 0
+           set segown($segname) {}
        } elseif {[regexp {^F (\w+) \w+ (\w+) \w+ (\w+)$} \
                $l dummy  segname movfeat mc]} {
            set segnum($segname)
@@ -134,4 +142,17 @@ proc main {} {
     update_push
 }
 
+proc EOE {} { global exitoneof; set exitoneof 1}
+
 main
+
+while {[gets stdin l]>=0} {
+    if {[regexp {^GUI ([A-Z][0-9a-zA-Z ]*)$} $l dummy cmd]} {
+       puts "GUI $cmd"
+       eval $cmd
+    } else {
+       puts $l
+    }
+}
+
+if {[info exists exitoneof]} { exit 0 }