chiark / gitweb /
speed measurements
authorian <ian>
Mon, 21 Jan 2008 00:15:03 +0000 (00:15 +0000)
committerian <ian>
Mon, 21 Jan 2008 00:15:03 +0000 (00:15 +0000)
hostside/measure-speeds

index 05da951ded7ede11a61b71c150fb97de0876657c..df965f89c7eabb1ca5b908107e7cfc6521b7950c 100755 (executable)
@@ -2,10 +2,7 @@
 
 load chiark_tcl_hbytes-1.so
 
-set port /dev/ttyUSB0
-set loco 2
-
-# Put loco 2 on track segment X5
+# Put loco on track segment X5 ish, facing anticlockwise
 
 proc debug_r {m} { puts -nonewline stderr "$m\r" }
 proc debug {m} { puts stderr $m }
@@ -16,7 +13,7 @@ proc send-now {str} {
 }
 
 proc startup {} {
-    global port rwy buf last_fast_speed
+    global port rwy buf last_fast_speed noise
     set rwy [open $port r+]
     fconfigure $rwy -blocking no -buffering none -encoding binary \
            -translation binary
@@ -27,6 +24,7 @@ proc startup {} {
     fileevent $rwy readable readable
     set buf {}
     set last_fast_speed 0
+    set noise [hbytes random 256]
 }
 
 proc readable {} {
@@ -141,32 +139,38 @@ proc xmit {nmral} {
     xmit-now
 }
 
-proc record-mm-per-s {speed distance start finish} {
-    debug "S $speed: $distance / ( $finish-$start = [expr {$finish-$start}] )"
-    set mmpers [expr {$distance*1.0/($finish-$start)}]
-    puts [format "%3d %g" $speed $mmpers]
-}
-
 proc now-ms {} {
     clock clicks -milliseconds
 }
 
 proc now-ms-click {} {
+    global noise
     set now [now-ms]
     if {[catch {
-       exec dd if=/bin/ls of=/dev/dsp count=1 > /dev/null
-    } m]} { debug $m }
+       set dsp [open /dev/dsp w]
+       fconfigure $dsp -encoding binary -translation binary
+       puts -nonewline $dsp [hbytes h2raw $noise]
+       close $dsp
+    } emsg]} {
+       debug "noise: $emsg"
+       catch { close $dsp }
+    }
     return $now
 }
 
+proc record-mm-per-s {speed mm ms} {
+    debug "S $speed: $mm / $ms"
+    set mmpers [expr {$mm*1.0/$ms}]
+    puts [format "%3d %g" $speed $mmpers]
+}
 proc timing-start {} {
     global start
     set start [now-ms-click]
 }
-proc timing-finish {speed distance} {
+proc timing-finish {} {
     global start
     set finish [now-ms-click]
-    record-mm-per-s $speed $distance $start $finish
+    return [expr {$finish-$start}]
 }
 
 proc goto-slow-start-position {speed} {
@@ -187,7 +191,7 @@ proc slow-speed-test {speed} {
     run-until $speed 9804
     timing-start
     run-until $speed 980a
-    timing-finish $speed 231
+    record-mm-per-s $speed 231 [timing-finish]
     instruct-stop-for 100
 }
 
@@ -208,10 +212,17 @@ proc fast-speed-test {speed} {
        if {$deficit < 0} break
     }
     set last_fast_speed $speed
-    run-until $speed 9804
-    timing-start
-    run-until $speed 9809
-    timing-finish $speed 483
+    set ms 0; set mm 0
+    while {$ms < 2000} {
+       run-until $speed 9804
+       timing-start
+       run-until $speed 980a
+       incr ms [timing-finish]
+       incr mm 231
+       debug "+ $mm / $ms"
+       run-until-not $speed 980a 100
+    }
+    record-mm-per-s $speed $mm $ms
 }
 
 proc speed-test {speed} {
@@ -222,8 +233,12 @@ proc speed-test {speed} {
     }
 }
 
+set port [lindex $argv 0]
+set loco [lindex $argv 1]
+
 startup
-foreach s $argv {
+
+foreach s [lrange $argv 2 end] {
     speed-test $s
 }
 instruct-stop-for 500