From: ian <ian>
Date: Sat, 31 Dec 2005 13:12:26 +0000 (+0000)
Subject: stopgap-controller produces insns for train
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=207736ef2929dd6dccda2ce81648546877b954e1;p=trains.git

stopgap-controller produces insns for train
---

diff --git a/hostside/stopgap-controller b/hostside/stopgap-controller
index 24f3cb7..fe475d8 100755
--- a/hostside/stopgap-controller
+++ b/hostside/stopgap-controller
@@ -2,12 +2,20 @@
 
 set testonly 1
 set port /dev/ttya0
+
+set ch(funcsevery) 10
+set ch(speeddirnevery) 15
+set ch(scale) 1
+
+set ch(minint) 5000
 # unset always
 
 set m xx
 set segs xx
 set polarity 908000
 set pq {} ;# unset: cdu charged and waiting
+set speeddirn {}
+set funcs {}
 # unset pointpos($point)
 # unset segdetect($seg) ;# unset: shown D0; {}: shown D1; or: after id, D1->0
 
@@ -31,14 +39,18 @@ proc debug {m} {
     puts $m
 }
 
-proc tellpic {m} {
+proc tellpic_q {m} {
     global p testonly
-    puts ">> $m"
     if {$testonly} return
     set b [binary format H* $m]
     puts -nonewline $p $b
 }
 
+proc tellpic {m} {
+    puts ">> $m"
+    tellpic_q $m
+}
+
 proc bgerror {m} {
     if {[catch {
 	global errorInfo errorCode
@@ -128,13 +140,19 @@ proc pm_charged {} {
     }
 }
 
+proc randbyte {} {
+    global rand
+    set c [read $rand 1]; if {![string length $c]} { error "eof on rand" }
+    binary scan $c H* x
+    return $x
+}
+
 proc pt_maybe {point} {
-    global always rand
+    global always
     if {[info exists always]} {
 	set pos $always
     } else {
-	set c [read $rand 1]; if {![string length $c]} { error "eof on rand" }
-	binary scan $c H* x
+	set x [randbyte]
 	set pos [expr [regexp {^[89a-f]} $x] ? 1 : 0]
 	debug "chose point $point pos=$pos (x=$x)"
     }
@@ -220,11 +238,10 @@ proc pm_detect {seg} {
 }
 
 proc watchdog {} {
-    global watchdog testonly
-    if {$testonly} return
+    global watchdog testonly speeddirn funcs
     catch { after cancel $watchdog }
     set watchdog [after 50 watchdog]
-    tellpic 9808 ;# 128ms
+    tellpic_q 9808$speeddirn$funcs ;# 128ms
 }
 
 proc pm_hello {} {
@@ -270,6 +287,51 @@ proc onreadp {} {
     }
 }
 
+proc newspeeddirn {} {
+    set b1 0x[randbyte]
+    set speed [expr {($b1 * $b1) / 516}]
+    set b2 0x[randbyte]
+    set dirn [expr {$b2 / 128}]
+    debug "speeddirn b1=$b1 speed=$speed b2=$b2 dirn=$dirn"
+    return "speed126 2 $speed $dirn"
+}
+
+proc newfuncs {} {
+    set b3 0x[randbyte]
+    set value [expr {($b3 & 127) * 16}]
+    debug "funcs b3=$b3 value=[format %x $value]"
+    return "funcs5to8 2 $value"
+}
+
+proc maybechange {thing} {
+    global $thing ch
+    set rb 0x[randbyte][randbyte]
+    if {
+	$rb / 65536.0 >
+	1.0 / (($ch(${thing}every) - $ch(minint)*0.001) * $ch(scale))
+    } {
+	debug "maybechange $thing rb=$rb no"
+	return 0
+    }
+    debug "maybechange $thing rb=$rb yes ..."
+    set l [new$thing]
+    set bin [eval exec ./hostside-old -s/dev/stdout $l]
+    binary scan $bin H* x
+    debug "changed $thing=$x"
+    set $thing $x
+    return 1
+}
+
+proc changewhat {} {
+    global ch
+    if {[maybechange speeddirn] || [maybechange funcs]} {
+	set interval $ch(minint)
+    } else {
+	set interval 1000
+    }
+    after $interval changewhat
+}
+
 proc setup {} {
     global port p rand testonly
     if {!$testonly} {
@@ -293,6 +355,8 @@ proc setup {} {
 
     set rand [open /dev/urandom {RDONLY} 0]
     fconfigure $rand -encoding binary -translation binary
+
+    changewhat
 }
 
 setup