lights by left and right arrows

[trains.git] / hostside / stopgap-controller

diff --git a/hostside/stopgap-controller b/hostside/stopgap-controller
index b2c2276866aabc013b37147e62ebd4045c5e0341..826106b027942ba5eb86adad9997e57ed28faf08 100755 (executable)
--- a/hostside/stopgap-controller
+++ b/hostside/stopgap-controller
@@ -7,6 +7,8 @@ set testonly 0
 set port /dev/ttya0
 #set port /dev/ttyS0
 
+set loco 2
+
 set ch(funcsevery) 10
 set ch(speeddirnevery) 30
 set ch(scale) 1
@@ -38,6 +40,12 @@ set funcs ff7f
 # unset pointpos($point)
 # unset segdetect($seg) ;# unset: shown D0; {}: shown D1; or: after id, D1->0
 
+set funcsr1 {0x061 0x020 0x000 0x040 0x060}
+set funcsl1 {0x181 0x080 0x000 0x100 0x180}
+set funcsr2 {0x021 0x020 0x000}
+set funcsl2 {0x041 0x040 0x000}
+set funcsval 0x000
+
 proc gui {m} {
     puts "GUI $m"
 }
@@ -376,20 +384,59 @@ proc onreadp {} {
 }
 
 proc newspeeddirn {} {
+    global loco
     set b1 0x[randbyte]
     set speed [expr {round(($b1 * $b1) / 65535.0 * 100.0 + 26.0)}]
     set b2 0x[randbyte]
     set dirn [expr {$b2 / 128}]
     set dirn 0
     debug "speeddirn b1=$b1 speed=$speed b2=$b2 dirn=$dirn"
-    return "speed126 2 $speed $dirn"
+    return "speed126 $loco $speed $dirn"
+}
+
+proc funcs_removebits {lr headent} {
+    global funcsval
+    set funcsval [format 0x%x [expr {$funcsval & ~$headent}]]
+}
+proc funcs_addbits {lr list} {
+    global loco funcsval
+    set headent [lindex $list 0]
+    set val $funcsval
+    set add $headent
+    if {$add & 0x01} {
+       set rand 0x[randbyte]0
+       set add [expr {$add & $rand}]
+       set val [expr {$val | $add}]
+       debug "funcs $lr v=$funcsval add=$add new=$val rand=$rand ($list)"
+    } else {
+       set val [expr {$val | $add}]
+       debug "funcs $lr v=$funcsval add=$add new=$val ($list)"
+    }
+    set funcsval $val
+}
+
+proc funcsnmralist {} {
+    global loco funcsval
+    return "funcs5to8 $loco $funcsval"
 }
 
 proc newfuncs {} {
-    set b3 0x[randbyte]
-    set value [expr {($b3 & 127) * 16}]
-    debug "funcs b3=$b3 value=[format %x $value]"
-    return "funcs5to8 2 $value"
+    global loco funcsval
+    foreach lr {l r} {
+       upvar #0 funcs${lr}${loco} list
+       set now [lindex $list 0]
+       funcs_removebits $lr $now
+       funcs_addbits $lr $list
+    }
+    return [funcsnmralist]
+}
+
+proc nmrachange {thing argstring} {
+    global $thing
+    set bin [eval exec ./hostside-old -s/dev/stdout $argstring]
+    binary scan $bin H* x
+    debug "changed $thing=$x ($argstring)"
+    set $thing ff$x
 }
 
 proc maybechange {thing force} {
@@ -415,17 +462,14 @@ proc maybechange {thing force} {
        set l $fixed
        if {![llength $l]} { return 0 }
     }
-    set bin [eval exec ./hostside-old -s/dev/stdout $l]
-    binary scan $bin H* x
-    debug "changed $thing=$x"
-    set $thing ff$x
+    nmrachange $thing $l
     return 1
 }
 
 proc changewhat {} {
     global ch chwa
     catch { after cancel $chwa }
-    if {[maybechange speeddirn 0] || [maybechange funcs 0]} {
+    if {[maybechange speeddirn 0] + [maybechange funcs 0]} {
        set interval $ch(minint)
     } else {
        set interval 1000
@@ -474,17 +518,17 @@ proc setup {} {
 
 proc setup_complete {} {
     global rand
+#    exec [xset s off]
     set rand [open /dev/urandom {RDONLY} 0]
     fconfigure $rand -encoding binary -translation binary
     tellpic 0a
 }
 
-
 #----------
 # for keyboard control
 
 proc ask_speed {updown} {
-    global speeddirn_fixed askspeeds askspeedix
+    global speeddirn_fixed askspeeds askspeedix loco
     set ll [llength $askspeeds]
     if {![info exists askspeedix]} {
        set askspeedix [expr {
@@ -496,7 +540,7 @@ proc ask_speed {updown} {
        if {$askspeedix >= $ll} { set askspeedix [expr {$ll - 1}] }
     }
     set speed [lindex $askspeeds $askspeedix]
-    set speeddirn_fixed [list speed126 2 $speed 0]
+    set speeddirn_fixed [list speed126 $loco $speed 0]
     maybechange speeddirn 1
 }
 
@@ -507,7 +551,16 @@ proc ask_randspeed {} {
     maybechange speeddirn 1
 }    
 
-proc ask_manual {rightp} { global pointasked; set pointasked M$rightp }
+proc ask_funcs {lr} {
+    global loco
+    upvar #0 funcs${lr}${loco} list
+    set now [lindex $list 0]
+    funcs_removebits $lr $now
+    set list [concat [lrange $list 1 end] $now]
+    funcs_addbits $lr $list
+    nmrachange funcs [funcsnmralist]
+}
+
 proc ask_figureeight {} { global pointasked; set pointasked 0 }
 proc ask_loop {} { global pointasked; set pointasked 1 }
 proc ask_randpath {} { global pointasked; catch { unset pointasked } }