From: ian <ian>
Date: Sun, 3 May 2009 16:02:32 +0000 (+0000)
Subject: slope calculator
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=d8b013a8a959ea400cc221df0841430cbb438f42;p=trains.git

slope calculator
---

diff --git a/layout/slopecalc b/layout/slopecalc
new file mode 100755
index 0000000..3cada54
--- /dev/null
+++ b/layout/slopecalc
@@ -0,0 +1,206 @@
+#!/usr/bin/perl -w
+#
+# usage:
+#   slopecalc =HEIGHT|SLOPE%|+DIST|@ABSDIST ...
+#
+# args represent details of control points
+#
+# an arg starts a new control point if it specifies
+#  a property (height, slope or location) which has
+#  already been determined for the current control
+#  point.
+#
+# when a new point is started all the properties of the previous
+#  point must be determinable - although unless otherwise specified
+#  the slope will remain unchanged from the point before, and if
+#  the slope _has_ changed a default distance is supplied
+#
+# the first use of @... to specify an absolute location
+#  acts only to fix the zero point of the absolute position scale
+#  and does not actually specify the location of the current point
+
+use strict qw(vars refs);
+
+our $halfreverselen= 80; # mm to change from going flat to going up/down
+our $printinterval= 10;
+
+our @cp= ({ L => 0 });
+# $cp[]{H}    height
+# $cp[]{L}    absolute dist
+# $cp[]{S}    slope
+
+our $absoffset;
+our $numre= '(?:\\d{1,6}(?:\\.\\d*)?|\\.\\d+)';
+
+our $progname= $0;
+$progname =~ s,.*/,,;
+our $arg_errors= 0;
+
+sub arg_error ($) {
+    my ($m) = @_;
+    print STDERR "$progname: $m\n";
+    $arg_errors++;
+}
+
+# always called in this order:         $this->{S}   $this->{L}   $this->{H}
+#  compute_fixed_S($last,$this)        undef         -            -
+#  compute_fixed_L($last,$this)         -           undef         -
+#  compute_fixed_H($last,$this)         -            -           undef
+#  compute_default_S($last,$this)      undef         -            -
+#  compute_default_L($last,$this)      defined      undef         -
+#  compute_default_H($last,$this)      defined      defined      undef
+# $last->{S}, $last->{H}, $last->{L} are always defined on entry
+
+sub compute_fixed_S ($$) { }
+sub compute_default_S ($$) {
+    my ($last,$this) = @_;
+    $this->{S}= $last->{S};
+}
+sub compute_fixed_L ($$) {
+    my ($last,$this) = @_;
+    if (defined $this->{S}
+	and defined $this->{H}
+	and $last->{S} == $this->{S}) {
+	$this->{L}= $last->{L} + ($this->{H} - $last->{H})/$last->{S};
+	return;
+    }
+}
+sub compute_default_L ($$) {
+    my ($last,$this) = @_;
+    if (defined $this->{S}
+	and !defined $this->{H}
+	and $last->{S} != $this->{S}) {
+	$this->{L}= $last->{L} +
+	    $halfreverselen * ($last->{S} * $this->{S} < 0 ? 2 : 1);
+	return;
+    }
+}
+sub compute_fixed_H ($$) {
+    my ($last,$this) = @_;
+    if (defined $this->{S}
+	and defined $this->{L}) {
+	my $meanslope= 0.5 * ($last->{S} + $this->{S});
+	$this->{H}= $last->{H} + $meanslope * ($this->{L} - $last->{L});
+	return;
+    }
+}
+sub compute_default_H ($$) { }
+
+sub complete_current_point ($) {
+    my ($why) = @_;
+    my $say_why= 0;
+
+    my $this= $cp[$#cp];
+    my $last= $cp[$#cp-1];
+    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);
+	}
+	if (!exists $this->{$k2}) {
+	    arg_error("point \#$#cp: property $k2 unspecified");
+	    $this->{$k2}= 1;
+	    $say_why= 1;
+	}
+    }
+    if ($say_why) {
+	print STDERR "$progname: ($why)\n"
+	    or die $!;
+    }
+}
+
+sub arg_item ($$) {
+    my ($k, $v) = @_;
+    my $last = $cp[$#cp];
+
+    if (!exists $last->{$k}) {
+	$last->{$k}= $v;
+	return;
+    }
+    complete_current_point("new point started because of change to $k");
+    my $this = { $k => $v };
+    foreach my $k2 (qw(S L H)) {
+	no strict 'refs';
+	exists $this->{$k2} or &{"compute_fixed_$k"}($last, $this);
+    }
+    push @cp, $this;
+}
+
+sub parse_args () {
+    foreach $_ (@ARGV) {
+	if (m/^\=([-+]?$numre)$/o) {
+	    arg_item(H, $1);
+	} elsif (m/^([-+]?$numre)\%$/o) {
+	    arg_item(S, $1 * 0.01);
+	} elsif (m/^\@([-+]?$numre)$/o) {
+	    if (defined $absoffset) {
+		arg_item(L, $1 + $absoffset);
+	    } else {
+		$absoffset= -$1;
+	    }
+	} elsif (m/^\+($numre)$/o) {
+	    complete_current_point("new point started because of +...");
+	    arg_item(L, $cp[$#cp]{L} + $1);
+	} else {
+	    arg_error("bad argument `$_'");
+	}
+    }
+    complete_current_point("completing as it is the final point");
+    die "$progname: errors in argument(s)\n" if $arg_errors;
+}
+
+sub dump_schedule ($) {
+    my ($interpolate) = @_;
+    $absoffset=0 unless defined $absoffset;
+    my $i;
+    my $last_l= 0;
+    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};
+	    if ($dist_l > 0) {
+		my $base_hdiff = $this->{H} - $last->{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 $zeta= 1 - $gamma;
+		    my $y = $last->{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;
+		}
+	    }
+	}
+	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;
+    }
+}
+parse_args();
+
+printf("%s\n\n", "@ARGV")
+    or die $!;
+
+dump_schedule(0);
+print "\n" or die $!;
+dump_schedule(1);
+
+printf("\n%s\n",
+       '$Id$'
+    ) or die $!;
diff --git a/layout/slopeguide.ps b/layout/slopeguide.ps
deleted file mode 100644
index 865adfb..0000000
--- a/layout/slopeguide.ps
+++ /dev/null
@@ -1,86 +0,0 @@
-%!
-
-% convert coordinates to mm
-% from bottom left corner of landscape
-72 25.4 div dup  scale
-90 rotate
-0 -210  translate
-
-0.05 setlinewidth
-
-/Times-Roman findfont 5 scalefont setfont
-
-10 10 moveto ($Id$) show
-
-15 30  translate
-
-/sbuf 10 string def
-/i2s { 10 sbuf cvrs } def
-
-/xmax 260 def
-/changein 80 def
-
-/title {
-    0 exch moveto
-    (0 to ) show
-    slope i2s show (% in ) show
-    changein i2s show
-    (mm) show
-} def
-
-/do {
-    /slope exch def
-
-    2 title
-    -9 title
-
-    0 1 xmax {
-	/x exch def
-	newpath
-	x -1 moveto
-	0 +2 rlineto
-	stroke
-    } for
-
-    0 10 xmax {
-	/x exch def
-	newpath
-	x 0 moveto
-	0 -2.5 rlineto
-	stroke
-
-	x -4 moveto
-	x i2s show
-    } for
-
-    0 1 10 {
-	neg /y exch def
-	newpath
-	0 y moveto
-	xmax 0 rlineto
-	stroke
-    } for
-
-    /afterchange  slope changein 0.005 mul mul  def
-
-    0 0 moveto
-    0 0.5 changein {
-	/x exch def
-	/y  x changein div  dup mul  afterchange mul  def
-	x y lineto
-    } for
-    /y  xmax changein sub  slope 0.01 mul mul  afterchange add  def
-    xmax y lineto
-    stroke
-
-    newpath
-    changein 0 moveto
-    0 afterchange rlineto
-    stroke
-
-    0 22 translate
-} def
-
-0.5 0.5 4 { do } for
-
-showpage