variable probabilities

diff --git a/hostside/eventrun.events b/hostside/eventrun.events
index df76a9742ad7052f5c84c5eb56e78cdcfac27004..78e20e5f98de177bce317b8bb6f8835791f9bae5 100644 (file)
--- a/hostside/eventrun.events
+++ b/hostside/eventrun.events
@@ -10,6 +10,6 @@ e6    tw ask_randspeed
 
 ea     tw ask_funcs l
 e9     tw ask_funcs r
-e8     tw ask_figureeight
-e7     tw ask_loop
-e5     tw ask_randpath
+e8     tw ask_pointprob +1
+e7     tw ask_pointprob -1
+e5     tw ask_pointrelabs

diff --git a/hostside/eventrun.procs b/hostside/eventrun.procs
index fa2739ad99ddbd736735e2d785cc83047ea36450..450b00fd08a8fcc4f7a38df389125611a8b6b4d0 100644 (file)
--- a/hostside/eventrun.procs
+++ b/hostside/eventrun.procs
@@ -25,6 +25,7 @@ proc tw {args} {
     if {![info exists trainsf]} return
     if {[catch {
        puts $trainsf $args
+       puts $trainsf ask_show
     } emsg]} {
        puts stderr "tw: $emsg"
        trains_stop

diff --git a/hostside/stopgap-controller b/hostside/stopgap-controller
index 826106b027942ba5eb86adad9997e57ed28faf08..5cc274dcfeadf4a72f8243af2f077f99074cbb71 100755 (executable)
--- a/hostside/stopgap-controller
+++ b/hostside/stopgap-controller
@@ -15,11 +15,13 @@ set ch(scale) 1
 
 set ch(minint) 5000
 
-#unset pointasked
-# 0 1 (settings) M0 M1 (manual, settings) unset (random) M (manual)
+set pointprobs {0 0x010 0x080 0x0f0 0x100}
+set pointprobix 0
+set pointabs 1 ;# 0 or 1
 
 set nmrawhich 0
 set lastptchosen xx
+set pointprob [lindex $pointprobs $pointprobix]
 
 set polmsg(l) 908000
 set polmsg(x) 90f802
@@ -41,9 +43,9 @@ set funcs ff7f
 # 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 funcsl1 {0x182 0x080 0x000 0x100 0x180}
 set funcsr2 {0x021 0x020 0x000}
-set funcsl2 {0x041 0x040 0x000}
+set funcsl2 {0x042 0x040 0x000}
 set funcsval 0x000
 
 proc gui {m} {
@@ -182,27 +184,20 @@ proc randbyte {} {
 }
 
 proc pt_maybe {point oneisright} {
-    global pointasked lastptchosen
-    if {![info exists pointasked]} {
-       if {![string compare $point $lastptchosen]} return
-       set lastptchosen $point
-       set x [randbyte]
-       set pos [expr [regexp {^[89a-f]} $x] ? 1 : 0]
-       debug "chose point $point pos=$pos (x=$x)"
-    } elseif {[regexp {^M([01])$} $pointasked dummy pos]} {
-       if {[lsearch -exact {40 02} [lindex $point 0]] >= 0} {
-           set pos [expr {!$pos}]
-           debug "chose point $point pos=$pos manual-rl"
-       } else {
-           debug "chose point $point pos=$pos manual-lr"
-       }
-       set pointasked M
-    } elseif {![string compare $pointasked M]} {
-       debug "leave point $point manual"
-       return
+    upvar #0 pointpos($point) oldpos
+    global lastptchosen pointprob pointabs
+    if {![string compare $point $lastptchosen]} return
+    set lastptchosen $point
+    set x 0x[randbyte]
+    set pos [expr {$x < $pointprob ? 1 : 0}]
+    if {$pointabs} {
+       debug "chose point $point $pos (abs x=$x prob=$pointprob)"
+       set pos [expr {!$pos}]
+    } elseif {[info exists oldpos] && !$oldpos} {
+       debug "chose point $point $pos (0-> x=$x prob=$pointprob)"
     } else {
-       set pos $pointasked
-       debug "fixed point $point pos=$pos"
+       set pos [expr {!$pos}]
+       debug "chose point $point $pos (1-> x=$x prob=$pointprob)"
     }
     pt_must $point $pos
 }
@@ -403,7 +398,7 @@ proc funcs_addbits {lr list} {
     set headent [lindex $list 0]
     set val $funcsval
     set add $headent
-    if {$add & 0x01} {
+    if {$add & 0x02} {
        set rand 0x[randbyte]0
        set add [expr {$add & $rand}]
        set val [expr {$val | $add}]
@@ -490,7 +485,7 @@ proc onreadcmd {} {
 }
 
 proc setup {} {
-    global port p testonly
+    global port p testonly stateshowpipe
     fconfigure stdout -buffering none
     if {!$testonly} {
        set p [open $port {RDWR NONBLOCK} 0]
@@ -507,10 +502,13 @@ proc setup {} {
        fileevent $p readable onreadp
        fconfigure stdin -blocking false
        fileevent stdin readable onreadcmd
+       set stateshowpipe [open /tmp/train-state w]
+       fconfigure $stateshowpipe -buffering none
     } else {
        set p stdin
        fconfigure stdin -blocking false
        fileevent stdin readable onreadp_test
+       set stateshowpipe [open /dev/null w]
     }
 
     after 250 setup_complete
@@ -527,19 +525,29 @@ proc setup_complete {} {
 #----------
 # for keyboard control
 
-proc ask_speed {updown} {
-    global speeddirn_fixed askspeeds askspeedix loco
-    set ll [llength $askspeeds]
-    if {![info exists askspeedix]} {
-       set askspeedix [expr {
+proc updownfromlist {wholelistv ixv updown} {
+    upvar #0 $wholelistv wholelist
+    upvar #0 $ixv ix
+    set ll [llength $wholelist]
+    if {![info exists ix]} {
+       set old ?
+       set ix [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 old $ix
+       incr ix $updown
+       if {$ix < 0} { set ix 0 }
+       if {$ix >= $ll} { set ix [expr {$ll - 1}] }
     }
-    set speed [lindex $askspeeds $askspeedix]
+    set val [lindex $wholelist $ix]
+    debug "updownfromlist ix:$old->$ix /$ll $val ($wholelist)"
+    return $val
+}
+
+proc ask_speed {updown} {
+    global speeddirn_fixed loco
+    set speed [updownfromlist askspeeds askspeedix $updown]
     set speeddirn_fixed [list speed126 $loco $speed 0]
     maybechange speeddirn 1
 }
@@ -561,10 +569,29 @@ proc ask_funcs {lr} {
     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 } }
+proc ask_pointprob {updown} {
+    global pointprob
+    set pointprob [updownfromlist pointprobs pointprobix $updown]
+}
+
+proc ask_pointrelabs {} {
+    global pointabs
+    set pointabs [expr {!$pointabs}]
+}
+
+proc ask_show {} {
+    global loco stateshowpipe pointprob pointabs askspeedix
+    upvar #0 funcsr$loco fr
+    upvar #0 funcsl$loco fl
+    if {[info exists askspeedix]} { set spd $askspeedix } { set spd r }
+    puts -nonewline $stateshowpipe [format \
+           "\nL$loco P%03x%s F%03x S%s" \
+           $pointprob [lindex {R A} $pointabs] \
+           [expr {[lindex $fr 0] | [lindex $fl 0]}] \
+           $spd]
+}
 
 setup
 gui_init
+ask_show
 vwait end

diff --git a/hostside/xsession b/hostside/xsession
index 09168199f3fc342bd82b383bae387fa565ec6440..1e9ca2244cfe935c93c39701390c475fea8cb743 100755 (executable)
--- a/hostside/xsession
+++ b/hostside/xsession
@@ -3,4 +3,11 @@ set -e
 HOME=/u/ian/things/Bessar/trains
 export HOME
 cd $HOME
+rm -f /tmp/train-state
+mknod /tmp/train-state p
+xterm -rv -fn '-*-*-bold-r-*-*-48-*-*-*-*-*-*-*' -geometry 28x1+0-0 -e sh -c '
+       exec 3<>/tmp/train-state
+       printf "\n%s" "$(date)"
+       cat <&3
+' &
 /etc/eventrun eventrun.events