chiark / gitweb /
hostside/measure-speeds: stopping distance measurement on track C works
authorIan Jackson <ian@davenant.greenend.org.uk>
Sun, 2 Jan 2011 22:35:19 +0000 (22:35 +0000)
committerIan Jackson <ian@davenant.greenend.org.uk>
Sun, 2 Jan 2011 22:35:19 +0000 (22:35 +0000)
hostside/measure-speeds

index e511dea1adf87e365aee6ba432fc4de1d003c0f1..d809ec702816b8d92b3ad86e6f29e8ead62821f9 100755 (executable)
@@ -1,19 +1,22 @@
 #!/usr/bin/tclsh8.3
 
 # Put loco on track segment X5 ish, facing anticlockwise
-#  ./measure-speeds /dev/railway 2 0 `seq 1 126` |tee santafe.speeds
-#                                  ^reverse
+#  ./measure-speeds /dev/railway AX speed 2 0 `seq 1 126` |tee santafe.speeds
+#                                     loco^ ^reverse
 
 # For stop distance at speed (say) 126,
 # Put loco on track segment X5 ish, facing ANTICLOCKWISE
+#  ./measure-speeds /dev/railway AX stop 2 0 40
 # OR put on track segment or C7 ish, facing CLOCKWISE
-#  ./measure-speeds /dev/railway 2 0 126
+#  ./measure-speeds /dev/railway C stop 2 0 40
 
 # debugging:
-# ./measure-speeds /dev/railway 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] }') 
+# ./measure-speeds [stuff] 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] }') 
 
 load chiark_tcl_hbytes-1.so
 
+source lib.tcl
+
 proc debug_r {m} { puts -nonewline stderr "$m\r" }
 proc debug {m} { puts stderr $m }
 
@@ -89,12 +92,20 @@ proc proc-msg {msg} {
     exit 1
 }
 
-# For speed or stopping distance tests For stopping distance test only
-#                              A5 14           -C1 11
-#                              X7 02           -C9 2e
-#                              X5 04           -C8 34
-#                              X6 0a           -C7 32
-#                              X8 09           -C5 2f
+proc use-segment {name_AX seg_AX name_C_unused seg_C} {
+    global track segs
+    set segs($name_AX) 98[set seg_$track]
+}
+
+proc define-segments {} {
+               # For speed or stopping         For stopping distance
+               # stopping distance             tests only
+    use-segment                A5 14                           C1 11
+    use-segment                X7 02                           C9 2e
+    use-segment                X5 04                           C8 34
+    use-segment                X6 0a                           C7 32
+    use-segment                X8 09                           C5 2f
+}
 
 proc speed-msg {speed} {
     global loco reverse
@@ -192,27 +203,29 @@ proc timing-finish {{now {}}} {
 }
 
 proc goto-slow-start-position {speed} {
-    global last_fast_speed
+    global last_fast_speed segs
     if {$last_fast_speed >= 0} {
-       run-until -100 {9804 980a}
+       run-until -100 [list $segs(X5) $segs(X6)]
        set last_fast_speed -1
     }
-    run-until -40 {9802 9804}
-    run-until-not -40 9804 600
+    run-until -40 [list $segs(X7) $segs(X5)]
+    run-until-not -40 $segs(X5) 600
     instruct-speed-for -40 [expr {$speed*$speed}]
     instruct-stop-for 1000
 }
 
 proc begin-slow-test {speed} {
+    global segs
     debug "==================== $speed S ===================="
     goto-slow-start-position $speed
-    run-until $speed 9804
+    run-until $speed $segs(X5)
 }
 
 proc slow-speed-test {speed} {
+    global segs
     begin-slow-test $speed
     timing-start
-    run-until $speed 980a
+    run-until $speed $segs(X6)
     record-mm-per-s S $speed 231 [timing-finish]
     instruct-stop-for 100
 }
@@ -233,7 +246,7 @@ proc finish-stop-test {} {
 }
 
 proc prepare-fast-test {speed} {
-    global last_fast_speed
+    global last_fast_speed segs
     debug "==================== $speed F ===================="
     set start [now-ms]
     set acceltime [expr {abs($last_fast_speed-$speed)*100}]
@@ -242,8 +255,8 @@ proc prepare-fast-test {speed} {
     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
+       run-until $speed $segs(X8)
+       run-until $speed $segs(A5)
        set deficit [expr {$finish - [now-ms]}]
        debug "W $deficit"
        if {$deficit < 0} break
@@ -252,11 +265,12 @@ proc prepare-fast-test {speed} {
 }
 
 proc fast-speed-test {speed} {
+    global segs
     prepare-fast-test $speed
     set ms 0; set mm 0
     set mslaps 0; set mmlaps 0
     while {$ms < 2000} {
-       run-until $speed 9804
+       run-until $speed $segs(X5)
        set now [now-ms-click]
        if {$ms} {
            incr mslaps [timing-finish $now]
@@ -265,24 +279,29 @@ proc fast-speed-test {speed} {
        }
        timing-start $now
 
-       run-until $speed 980a
+       run-until $speed $segs(X6)
 
        incr ms [timing-finish]
        incr mm 231
        debug "+- $mm / $ms"
-       run-until-not $speed 980a 600
+       run-until-not $speed $segs(X6) 600
     }
     record-mm-per-s F $speed $mm $ms
     if {$mslaps} { record-mm-per-s L $speed $mmlaps $mslaps }
 }
 
 proc fast-stop-test {speed} {
+    global segs
     prepare-fast-test $speed
-    run-until $speed 9804
+    run-until $speed $segs(X5)
     finish-stop-test
 }
 
 proc run-test {how speed} {
+    global track
+    if {[string compare $track AX] && [string compare $how stop]} {
+       error "$track $how ?"
+    }
     if {$speed<50} {
        slow-$how-test $speed
     } else {
@@ -290,18 +309,13 @@ proc run-test {how speed} {
     }
 }
 
-set port [lindex $argv 0]
-set loco [lindex $argv 1]
-set reverse [lindex $argv 2]
+manyset $argv port track how loco reverse
 
+define-segments
 startup
 
-foreach s [lrange $argv 3 end] {
-    if {[regexp {^s(\d+)} $s dummy s]} {
-       run-test stop $s
-    } else {
-       run-test speed $s
-    }
+foreach s [lrange $argv 5 end] {
+    run-test $how $s
 }
 instruct-stop-for 1000
 send-now 10