From: ian <ian>
Date: Tue, 24 Jan 2006 00:26:45 +0000 (+0000)
Subject: variable probabilities
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?p=trains.git;a=commitdiff_plain;h=3027fa47162f721fd8d1a10953c0d95e34ae33cb

variable probabilities
---

diff --git a/hostside/eventrun.events b/hostside/eventrun.events
index df76a97..78e20e5 100644
--- 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 fa2739a..450b00f 100644
--- 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 826106b..5cc274d 100755
--- 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 0916819..1e9ca22 100755
--- 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