wip speed measurer

diff --git a/hostside/measure-speeds b/hostside/measure-speeds
new file mode 100755 (executable)
index 0000000..c372546
--- /dev/null
+++ b/hostside/measure-speeds
@@ -0,0 +1,215 @@
+#!/usr/bin/tclsh8.3
+
+load chiark_tcl_hbytes-1.so
+
+set port /dev/ttyUSB0
+set loco 2
+
+# Put loco 2 on track segment X5
+
+proc debug_r {m} { puts -nonewline stderr "$m\r" }
+proc debug {m} { puts stderr $m }
+
+proc send-now {str} {
+    global rwy
+    puts -nonewline $rwy [hbytes h2raw $str]
+}
+
+proc startup {} {
+    global port rwy buf last_fast_speed
+    set rwy [open $port r+]
+    fconfigure $rwy -blocking no -buffering none -encoding binary \
+           -translation binary
+    send-now 10
+    after 1000
+    read -nonewline $rwy
+    send-now 11
+    fileevent $rwy readable readable
+    set buf {}
+    set last_fast_speed 0
+}
+
+proc readable {} {
+    global rwy buf
+    append buf [hbytes raw2h [read $rwy]]
+    while {[regexp {^((?:[89a-f].)*[0-7].)(.*)$} $buf dummy msg buf]} {
+       proc-msg $msg
+    }
+}
+
+proc settle-cancel-after {} {
+    global settle_after
+    catch {
+       after cancel $settle_after
+       unset settle_after
+    }
+}
+
+proc proc-msg {msg} {
+    global until detend settle_detend settle_time settle_after
+    switch -glob $msg {
+       90?? {
+           if {[lsearch $settle_detend $msg]<0} { debug_r "o $msg"; return }
+           debug "= $msg"
+           settle-cancel-after
+           set settle_after [after $settle_time { set until 1}]
+           return
+       }
+       01 - 02 - 03 return
+       28 return
+       98?? {
+           if {[lsearch $detend $msg]<0} { debug_r "I $msg"; return }
+           debug "* $msg"
+           if {$settle_time>0} {
+               settle-cancel-after
+           } else {
+               set until 1
+           }
+           return
+       }
+    }
+    puts stderr "huh? $msg"
+    exit 1
+}
+
+#
+# A6 06
+# A5 14
+#
+# X7 02
+# X5 04
+# X6 0a
+# X8 09
+#
+
+proc speed-msg {speed} {
+    global loco
+    list speed126 $loco [expr {abs($speed)}] [expr {$speed<0}]
+}
+
+proc run-until {speed new_detend} {
+    global loco until detend settle_time settle_detend
+    set detend $new_detend
+    set settle_detend {}
+    set settle_time -1
+    catch { unset until }
+    xmit [speed-msg $speed]
+    vwait until
+}
+
+proc run-until-not {speed new_detend new_settle} {
+    global loco until detend settle_time settle_detend
+    set detend $new_detend
+    set settle_detend $new_detend
+    hbytes xor settle_detend 0800
+    set settle_time $new_settle
+    catch { unset until }
+    xmit [speed-msg $speed]
+    vwait until
+}
+
+proc instruct-speed-for {speed ms} {
+    global loco until detend settle_detend
+    catch { unset until }
+    set detend {}
+    set settle_detend {}
+    xmit [speed-msg $speed]
+    after $ms { set until 1 }
+    vwait until
+}
+
+proc instruct-stop-for {ms} {
+    instruct-speed-for 0 $ms
+}
+
+proc bgerror {m} {
+    global errorInfo errorCode
+    puts stderr "----------\nBGERROR\n$m\n$errorInfo\n$errorCode\n----------"
+}
+
+proc xmit-now {} {
+    global xmit_after xmit_msg
+    send-now $xmit_msg
+    set xmit_after [after 10 xmit-now]
+}
+proc xmit {nmral} {
+    global xmit_msg xmit_after detend settle_detend settle_time
+    set msg [eval [list exec ./hostside-old -s/dev/stdout] $nmral]
+    set xmit_msg [hbytes raw2h $msg]
+    debug "> $xmit_msg $nmral (E $detend $settle_detend $settle_time)"
+    catch { after cancel $xmit_after }
+    xmit-now
+}
+
+proc goto-slow-start-position {speed} {
+    global last_fast_speed
+    if {$last_fast_speed >= 0} {
+       run-until -100 {980a 9809}
+       set last_fast_speed -1
+    }
+    run-until -40 9804
+    run-until-not -40 980a 100
+    instruct-speed-for -40 [expr {$speed*$speed}]
+    instruct-stop-for 1000
+}
+
+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 {} {
+    set now [clock clicks -milliseconds]
+    if {[catch { exec dd if=/bin/ls of=/dev/dsp count=1 } m]} { debug "?? $m" }
+    return $now
+}
+
+proc slow-speed-test {speed} {
+    debug "==================== $speed S ===================="
+    goto-slow-start-position $speed
+    run-until $speed 980a
+    set start [now-ms]
+    run-until $speed 9809
+    set finish [now-ms]
+    instruct-stop-for 100
+    record-mm-per-s $speed 252 $start $finish
+}
+
+proc fast-speed-test {speed} {
+    global last_fast_speed
+    debug "==================== $speed F ===================="
+    set start [now-ms]
+    set acceltime [expr {abs($last_fast_speed-$speed)*100}]
+    debug "A $acceltime"
+    set finish [expr {$start + $acceltime}]
+    while 1 {
+       # we go round and round, keeping track of roughly where we
+       #  are, until there has been enough time to get the speed right
+       run-until $speed 9809
+       run-until $speed 9814
+       set deficit [expr {$finish - [now-ms]}]
+       debug "W $deficit"
+       if {$deficit < 0} break
+    }
+    set last_fast_speed $speed
+    run-until $speed 9804
+    set start [now-ms]
+    run-until $speed 9809
+    set finish [now-ms]
+    record-mm-per-s $speed 483 $start $finish
+}
+
+proc speed-test {speed} {
+    if {$speed<50} {
+       slow-speed-test $speed
+    } else {
+       fast-speed-test $speed
+    }
+}
+
+startup
+foreach s $argv {
+    speed-test $s
+}
+instruct-stop-for 500