lights by left and right arrows

[trains.git] / hostside / stopgap-controller

diff --git a/hostside/stopgap-controller b/hostside/stopgap-controller
index df5595bcdb67f72b495c65faed53dd4396fce364..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
@@ -29,6 +31,8 @@ set segs {xx yy}
 set segsasgot {xx yy}
 set pq {} ;# unset: cdu charged and waiting
 set speeddirn ff7f
+#unset askspeedix
+set askspeeds {10 30 50 80 100 126}
 #set speeddirn ffff80c3fbcced7f
 #set speeddirn_fixed {speed126 2 80 0}
 set speeddirn_fixed {}
@@ -36,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"
 }
@@ -188,11 +198,11 @@ proc pt_maybe {point oneisright} {
        }
        set pointasked M
     } elseif {![string compare $pointasked M]} {
-       debug "leave point $point pos=$pos manual"
+       debug "leave point $point manual"
        return
     } else {
-       debug "fixed point $point pos=$pos"
        set pos $pointasked
+       debug "fixed point $point pos=$pos"
     }
     pt_must $point $pos
 }
@@ -374,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} {
@@ -413,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
@@ -445,6 +491,7 @@ proc onreadcmd {} {
 
 proc setup {} {
     global port p testonly
+    fconfigure stdout -buffering none
     if {!$testonly} {
        set p [open $port {RDWR NONBLOCK} 0]
     
@@ -471,32 +518,52 @@ 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_now {l} {
-    global speeddirn_fixed
-    set speeddirn_fixed $l
+proc ask_speed {updown} {
+    global speeddirn_fixed askspeeds askspeedix loco
+    set ll [llength $askspeeds]
+    if {![info exists askspeedix]} {
+       set askspeedix [expr {
+           int($ll * 0.5 - 0.5 + 0.5 * $updown)
+       }]
+    } else {
+       incr askspeedix $updown
+       if {$askspeedix < 0} { set askspeedix 0 }
+       if {$askspeedix >= $ll} { set askspeedix [expr {$ll - 1}] }
+    }
+    set speed [lindex $askspeeds $askspeedix]
+    set speeddirn_fixed [list speed126 $loco $speed 0]
     maybechange speeddirn 1
 }
 
-proc ask_fast {} { ask_speed_now {speed126 2 126 0} }
-proc ask_slow {} { ask_speed_now {speed126 2 10 0} }
 proc ask_randspeed {} {
-    global speeddirn_fixed; catch { unset speeddirn_fixed }
+    global speeddirn_fixed askspeedix
+    catch { unset speeddirn_fixed }
+    catch { unset askspeedix }
     maybechange speeddirn 1
 }    
 
-proc ask_manual {rightp} { global pointasked; set pointasked M$rightp }
-proc ask_figureeightt {rightp} { global pointasked; set pointasked 0 }
-proc ask_loop {rightp} { global pointasked; set pointasked 1 }
-proc ask_randpath {rightp} { global pointasked; catch { unset pointasked } }
+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 } }
 
 setup
 gui_init