3 # Put loco on track segment X5 ish, facing anticlockwise
4 # ./measure-speeds /dev/ttyUSB1 2 0 `seq 1 126` |tee santafe.speeds
8 # ./measure-speeds /dev/ttyUSB0 1 1 `seq 1 126` 2>&1 | perl -pe '$|=1; s/\r/\n/g' | 3<&0 tclsh8.3 <(echo 'set f [open /dev/fd/3]; proc cm {} { clock clicks -milliseconds }; set z [cm]; while {[gets $f l]>=0} { puts [format "%-10s %s" [expr {[cm]-$z}] $l] }')
10 load chiark_tcl_hbytes-1.so
12 proc debug_r {m} { puts -nonewline stderr "$m\r" }
13 proc debug {m} { puts stderr $m }
17 puts -nonewline $rwy [hbytes h2raw $str]
21 global port rwy buf last_fast_speed noise funcs_msgs loco
22 set rwy [open $port r+]
23 fconfigure $rwy -blocking no -buffering none -encoding binary \
29 fileevent $rwy readable readable
33 for {set i 0} {$i < 256} {incr i} { append noise \\x [hbytes random 1] }
34 foreach f {funcs0to4 funcs5to8} {
35 set m [exec ./hostside-old -s/dev/stdout $f $loco 0x1fff]
36 set m [hbytes raw2h $m]
37 lappend funcs_msgs ffff$m {}
44 append buf [hbytes raw2h [read $rwy]]
45 while {[regexp {^((?:[89a-f].)*[0-7].)(.*)$} $buf dummy msg buf]} {
50 proc settle-cancel-after {} {
53 after cancel $settle_after
59 global until detend settle_detend settle_time settle_after
62 if {[lsearch $settle_detend $msg]<0} { debug_r "o $msg"; return }
65 set settle_after [after $settle_time { set until 1}]
71 if {[lsearch $detend $msg]<0} { debug_r "I $msg"; return }
81 puts stderr "huh? $msg"
95 proc speed-msg {speed} {
97 list speed126 $loco [expr {abs($speed)}] [expr {$speed<0 != $reverse}]
100 proc run-until {speed new_detend} {
101 global loco until detend settle_time settle_detend
102 set detend $new_detend
105 catch { unset until }
106 xmit [speed-msg $speed]
110 proc run-until-not {speed new_detend new_settle} {
111 global loco until detend settle_time settle_detend
112 set detend $new_detend
113 set settle_detend $new_detend
114 hbytes xor settle_detend 0800
115 set settle_time $new_settle
116 catch { unset until }
117 xmit [speed-msg $speed]
121 proc instruct-speed-for {speed ms} {
122 global loco until detend settle_detend
123 catch { unset until }
126 xmit [speed-msg $speed]
127 after $ms { set until 1 }
131 proc instruct-stop-for {ms} {
132 instruct-speed-for 0 $ms
136 global errorInfo errorCode
137 puts stderr "----------\nBGERROR\n$m\n$errorInfo\n$errorCode\n----------"
141 global xmit_after xmit_msg funcs_msgs
142 set funcs_msg [lindex $funcs_msgs 0]
143 set funcs_msgs [lreplace $funcs_msgs 0 0]
144 lappend funcs_msgs $funcs_msg
145 send-now $xmit_msg$funcs_msg
146 set xmit_after [after 10 xmit-now]
149 global xmit_msg xmit_after detend settle_detend settle_time funcs_msgs
150 set msg [eval [list exec ./hostside-old -s/dev/stdout] $nmral]
151 set xmit_msg [hbytes raw2h $msg]
152 debug "> $xmit_msg $nmral (E $detend $settle_detend $settle_time) \[$funcs_msgs]"
153 catch { after cancel $xmit_after }
158 clock clicks -milliseconds
161 proc now-ms-click {{returnthis {}}} {
162 if {[string length $returnthis]} { return $returnthis }
165 set f [open |[list sh -c {"$@" >/dev/dsp} x printf $noise]]
166 fileevent $f readable [list close $f]
170 proc record-mm-per-s {how speed mm ms} {
171 debug " $how $speed: $mm / $ms"
172 set mmpers [expr {$mm*1.0/$ms}]
173 puts [format "%s %3d %g" $how $speed $mmpers]
175 proc timing-start {{now {}}} {
177 set start [now-ms-click $now]
179 proc timing-finish {{now {}}} {
181 set finish [now-ms-click $now]
182 return [expr {$finish-$start}]
185 proc goto-slow-start-position {speed} {
186 global last_fast_speed
187 if {$last_fast_speed >= 0} {
188 run-until -100 {9804 980a}
189 set last_fast_speed -1
191 run-until -40 {9802 9804}
192 run-until-not -40 9804 600
193 instruct-speed-for -40 [expr {$speed*$speed}]
194 instruct-stop-for 1000
197 proc slow-speed-test {speed} {
198 debug "==================== $speed S ===================="
199 goto-slow-start-position $speed
200 run-until $speed 9804
202 run-until $speed 980a
203 record-mm-per-s S $speed 231 [timing-finish]
204 instruct-stop-for 100
207 proc fast-speed-test {speed} {
208 global last_fast_speed
209 debug "==================== $speed F ===================="
211 set acceltime [expr {abs($last_fast_speed-$speed)*100}]
213 set finish [expr {$start + $acceltime}]
215 # we go round and round, keeping track of roughly where we
216 # are, until there has been enough time to get the speed right
217 run-until $speed 9809
218 run-until $speed 9814
219 set deficit [expr {$finish - [now-ms]}]
221 if {$deficit < 0} break
223 set last_fast_speed $speed
225 set mslaps 0; set mmlaps 0
227 run-until $speed 9804
228 set now [now-ms-click]
230 incr mslaps [timing-finish $now]
232 debug "++ $mmlaps / $mslaps"
236 run-until $speed 980a
238 incr ms [timing-finish]
241 run-until-not $speed 980a 600
243 record-mm-per-s F $speed $mm $ms
244 if {$mslaps} { record-mm-per-s L $speed $mmlaps $mslaps }
247 proc speed-test {speed} {
249 slow-speed-test $speed
251 fast-speed-test $speed
255 set port [lindex $argv 0]
256 set loco [lindex $argv 1]
257 set reverse [lindex $argv 2]
261 foreach s [lrange $argv 3 end] {
264 instruct-stop-for 1000
266 instruct-stop-for 500