3 # Put loco on track segment X5 ish, facing anticlockwise
4 # ./measure-speeds /dev/ttyUSB1 2 0 `seq 1 126` |tee santafe.speeds
7 load chiark_tcl_hbytes-1.so
9 proc debug_r {m} { puts -nonewline stderr "$m\r" }
10 proc debug {m} { puts stderr $m }
14 puts -nonewline $rwy [hbytes h2raw $str]
18 global port rwy buf last_fast_speed noise funcs_msgs loco
19 set rwy [open $port r+]
20 fconfigure $rwy -blocking no -buffering none -encoding binary \
26 fileevent $rwy readable readable
30 for {set i 0} {$i < 256} {incr i} { append noise \\x [hbytes random 1] }
31 foreach f {funcs0to4 funcs5to8} {
32 set m [exec ./hostside-old -s/dev/stdout $f $loco 0x1fff]
33 set m [hbytes raw2h $m]
34 lappend funcs_msgs ffff$m {}
41 append buf [hbytes raw2h [read $rwy]]
42 while {[regexp {^((?:[89a-f].)*[0-7].)(.*)$} $buf dummy msg buf]} {
47 proc settle-cancel-after {} {
50 after cancel $settle_after
56 global until detend settle_detend settle_time settle_after
59 if {[lsearch $settle_detend $msg]<0} { debug_r "o $msg"; return }
62 set settle_after [after $settle_time { set until 1}]
68 if {[lsearch $detend $msg]<0} { debug_r "I $msg"; return }
78 puts stderr "huh? $msg"
92 proc speed-msg {speed} {
94 list speed126 $loco [expr {abs($speed)}] [expr {$speed<0 != $reverse}]
97 proc run-until {speed new_detend} {
98 global loco until detend settle_time settle_detend
99 set detend $new_detend
102 catch { unset until }
103 xmit [speed-msg $speed]
107 proc run-until-not {speed new_detend new_settle} {
108 global loco until detend settle_time settle_detend
109 set detend $new_detend
110 set settle_detend $new_detend
111 hbytes xor settle_detend 0800
112 set settle_time $new_settle
113 catch { unset until }
114 xmit [speed-msg $speed]
118 proc instruct-speed-for {speed ms} {
119 global loco until detend settle_detend
120 catch { unset until }
123 xmit [speed-msg $speed]
124 after $ms { set until 1 }
128 proc instruct-stop-for {ms} {
129 instruct-speed-for 0 $ms
133 global errorInfo errorCode
134 puts stderr "----------\nBGERROR\n$m\n$errorInfo\n$errorCode\n----------"
138 global xmit_after xmit_msg funcs_msgs
139 set funcs_msg [lindex $funcs_msgs 0]
140 set funcs_msgs [lreplace $funcs_msgs 0 0]
141 lappend funcs_msgs $funcs_msg
142 send-now $xmit_msg$funcs_msg
143 set xmit_after [after 10 xmit-now]
146 global xmit_msg xmit_after detend settle_detend settle_time
147 set msg [eval [list exec ./hostside-old -s/dev/stdout] $nmral]
148 set xmit_msg [hbytes raw2h $msg]
149 debug "> $xmit_msg $nmral (E $detend $settle_detend $settle_time)"
150 catch { after cancel $xmit_after }
155 clock clicks -milliseconds
158 proc now-ms-click {{returnthis {}}} {
159 if {[string length $returnthis]} { return $returnthis }
162 set f [open |[list sh -c {"$@" >/dev/dsp} x printf $noise]]
163 fileevent $f readable [list close $f]
167 proc record-mm-per-s {how speed mm ms} {
168 debug " $how $speed: $mm / $ms"
169 set mmpers [expr {$mm*1.0/$ms}]
170 puts [format "%s %3d %g" $how $speed $mmpers]
172 proc timing-start {{now {}}} {
174 set start [now-ms-click $now]
176 proc timing-finish {{now {}}} {
178 set finish [now-ms-click $now]
179 return [expr {$finish-$start}]
182 proc goto-slow-start-position {speed} {
183 global last_fast_speed
184 if {$last_fast_speed >= 0} {
185 run-until -100 {9804 980a}
186 set last_fast_speed -1
189 run-until-not -40 9804 600
190 instruct-speed-for -40 [expr {$speed*$speed}]
191 instruct-stop-for 1000
194 proc slow-speed-test {speed} {
195 debug "==================== $speed S ===================="
196 goto-slow-start-position $speed
197 run-until $speed 9804
199 run-until $speed 980a
200 record-mm-per-s S $speed 231 [timing-finish]
201 instruct-stop-for 100
204 proc fast-speed-test {speed} {
205 global last_fast_speed
206 debug "==================== $speed F ===================="
208 set acceltime [expr {abs($last_fast_speed-$speed)*100}]
210 set finish [expr {$start + $acceltime}]
212 # we go round and round, keeping track of roughly where we
213 # are, until there has been enough time to get the speed right
214 run-until $speed 9809
215 run-until $speed 9814
216 set deficit [expr {$finish - [now-ms]}]
218 if {$deficit < 0} break
220 set last_fast_speed $speed
222 set mslaps 0; set mmlaps 0
224 run-until $speed 9804
225 set now [now-ms-click]
227 incr mslaps [timing-finish $now]
229 debug "++ $mmlaps / $mslaps"
233 run-until $speed 980a
235 incr ms [timing-finish]
238 run-until-not $speed 980a 600
240 record-mm-per-s F $speed $mm $ms
241 if {$mslaps} { record-mm-per-s L $speed $mmlaps $mslaps }
244 proc speed-test {speed} {
246 slow-speed-test $speed
248 fast-speed-test $speed
252 set port [lindex $argv 0]
253 set loco [lindex $argv 1]
254 set reverse [lindex $argv 2]
258 foreach s [lrange $argv 3 end] {
261 instruct-stop-for 500