From: ian <ian>
Date: Sun, 3 May 2009 16:48:10 +0000 (+0000)
Subject: extrapolation; bugfixes; ps runes; etc.
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=58175909a87003a25a0a48169891dc97d578b1de;p=trains.git

extrapolation; bugfixes; ps runes; etc.
---

diff --git a/layout/slopecalc b/layout/slopecalc
index 3cada54..63c8ccb 100755
--- a/layout/slopecalc
+++ b/layout/slopecalc
@@ -2,6 +2,7 @@
 #
 # usage:
 #   slopecalc =HEIGHT|SLOPE%|+DIST|@ABSDIST ...
+#     ... | atp -B -p >ps
 #
 # args represent details of control points
 #
@@ -23,6 +24,7 @@ use strict qw(vars refs);
 
 our $halfreverselen= 80; # mm to change from going flat to going up/down
 our $printinterval= 10;
+our $totallinesout= 66;
 
 our @cp= ({ L => 0 });
 # $cp[]{H}    height
@@ -35,6 +37,7 @@ our $numre= '(?:\\d{1,6}(?:\\.\\d*)?|\\.\\d+)';
 our $progname= $0;
 $progname =~ s,.*/,,;
 our $arg_errors= 0;
+our $lines++;
 
 sub arg_error ($) {
     my ($m) = @_;
@@ -42,6 +45,12 @@ sub arg_error ($) {
     $arg_errors++;
 }
 
+sub lprintf {
+    printf @_ or die $!;
+    print "\n" or die $!;
+    $lines++;
+}
+
 # always called in this order:         $this->{S}   $this->{L}   $this->{H}
 #  compute_fixed_S($last,$this)        undef         -            -
 #  compute_fixed_L($last,$this)         -           undef         -
@@ -95,10 +104,10 @@ sub complete_current_point ($) {
     foreach my $k2 (qw(S L H)) {
 	if (defined $last) {
 	    no strict 'refs';
-	    exists $this->{$k2} or &{"compute_fixed_$k2"}($last, $this);
-	    exists $this->{$k2} or &{"compute_default_$k2"}($last, $this);
+	    defined $this->{$k2} or &{"compute_fixed_$k2"}($last, $this);
+	    defined $this->{$k2} or &{"compute_default_$k2"}($last, $this);
 	}
-	if (!exists $this->{$k2}) {
+	if (!defined $this->{$k2}) {
 	    arg_error("point \#$#cp: property $k2 unspecified");
 	    $this->{$k2}= 1;
 	    $say_why= 1;
@@ -114,7 +123,7 @@ sub arg_item ($$) {
     my ($k, $v) = @_;
     my $last = $cp[$#cp];
 
-    if (!exists $last->{$k}) {
+    if (!defined $last->{$k}) {
 	$last->{$k}= $v;
 	return;
     }
@@ -122,7 +131,7 @@ sub arg_item ($$) {
     my $this = { $k => $v };
     foreach my $k2 (qw(S L H)) {
 	no strict 'refs';
-	exists $this->{$k2} or &{"compute_fixed_$k"}($last, $this);
+	defined $this->{$k2} or &{"compute_fixed_$k"}($last, $this);
     }
     push @cp, $this;
 }
@@ -150,6 +159,11 @@ sub parse_args () {
     die "$progname: errors in argument(s)\n" if $arg_errors;
 }
 
+sub lprint_interp ($$$$) {
+    my ($l_more,$l,$y,$cc) = @_;
+    lprintf("   %4s        %7d  %7.2f  %s", "+$l_more", $l, $y, $cc);
+}
+
 sub dump_schedule ($) {
     my ($interpolate) = @_;
     $absoffset=0 unless defined $absoffset;
@@ -158,49 +172,70 @@ sub dump_schedule ($) {
     my $last;
     for ($i=0; $i<@cp; $i++) {
 	my $this= $cp[$i];
-	if ($interpolate and defined $last) {
-	    my $l= $last->{L};
-	    my $dist_l = $this->{L} - $last->{L};
+	lprintf("%4s  %7s  %7s   =%5.2f  %s %5.02f%%",
+		"#$i",
+		'+'.($this->{L} - $last_l),
+		'@'.($this->{L} - $absoffset),
+		$this->{H},
+		($this->{S} < 0 ? '/' :
+		 $this->{S} > 0 ? '\\' :
+		 '|'),
+		$this->{S} * 100);
+	my $next= $cp[$i+1];
+	if ($interpolate and defined $next) {
+	    my $more_l= 0;
+	    my $dist_l = $next->{L} - $this->{L};
 	    if ($dist_l > 0) {
-		my $base_hdiff = $this->{H} - $last->{H};
+		my $base_hdiff = $next->{H} - $this->{H};
 		my $base_slope = $base_hdiff / $dist_l;
-		my $this_hoop = -($this->{S} * $dist_l - $base_hdiff);
-		my $last_hoop =   $last->{S} * $dist_l - $base_hdiff;
-#printf "$dist_l $base_slope $this_hoop $last_hoop\n";
-		while ($l < $this->{L}) {
-		    my $gamma= ($l - $last->{L}) / $dist_l;
+		my $next_hoop = -($next->{S} * $dist_l - $base_hdiff);
+		my $this_hoop =   $this->{S} * $dist_l - $base_hdiff;
+		my $char_char =
+		    ($next->{S} < $this->{S} ? '>' :
+		     $next->{S} > $this->{S} ? '<' :
+		     $next->{H} < $this->{H} ? '/' :
+		     $next->{H} > $this->{H} ? '\\' :
+		     '|');
+		for (;;) {
+		    $more_l += $printinterval;
+		    my $gamma= $more_l / $dist_l;
+		    my $l = $this->{L} + $more_l;
+		    last unless $l < $next->{L};
 		    my $zeta= 1 - $gamma;
-		    my $y = $last->{H} + $gamma * $base_hdiff;
+		    my $y = $this->{H} + $gamma * $base_hdiff;
 		    my $hoop= $gamma * $zeta;
-		    $y += $hoop * ($gamma * $this_hoop +
-				   $zeta * $last_hoop);
-		    printf("               %7d  %7.2f\n",
-			   $l, $y)
-			or die $!;
-		    $l += $printinterval;
+		    $y += $hoop * ($gamma * $next_hoop +
+				   $zeta * $this_hoop);
+		    lprint_interp($more_l,$l,$y,$char_char);
 		}
 	    }
 	}
-	printf("%4s  %7s  %7s   =%5.2f   %5.02f%%\n",
-	       "#$i",
-	       '+'.($this->{L} - $last_l),
-	       '@'.($this->{L} - $absoffset),
-	       $this->{H},
-	       $this->{S} * 100)
-	    or die $!;
         $last_l= $this->{L};
 	$last= $this;
     }
+    if ($interpolate) {
+	my $more_l= 0;
+	while ($lines < $totallinesout) {
+	    lprint_interp($more_l,
+			  $last->{L} + $more_l,
+			  $last->{H} + $last->{S} * $more_l,
+			  ':');
+	    $more_l += $printinterval;
+	}
+    }
 }
 parse_args();
 
-printf("%s\n\n", "@ARGV")
-    or die $!;
+lprintf("args: %s", "@ARGV");
+lprintf("");
 
+lprintf("control points:");
 dump_schedule(0);
-print "\n" or die $!;
+lprintf("");
+lprintf("table of heights:");
 dump_schedule(1);
 
-printf("\n%s\n",
+lprintf("");
+lprintf("%s",
        '$Id$'
-    ) or die $!;
+    );