From: ijackson <ijackson>
Date: Tue, 20 Jan 2004 18:24:26 +0000 (+0000)
Subject: initial
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=fd83ed2d0d12230da6149d313370bfdb16b39b3c;p=trains.git

initial
---

fd83ed2d0d12230da6149d313370bfdb16b39b3c
diff --git a/layout/layout b/layout/layout
new file mode 100755
index 0000000..8d4f276
--- /dev/null
+++ b/layout/layout
@@ -0,0 +1,119 @@
+#!/usr/bin/perl
+
+use POSIX;
+
+# Data structures:
+#  $loc{$id}{X}
+#  $loc{$id}{Y}
+#  $loc{$id}{A}  may be undef
+
+sub canf ($$) {
+    my ($converter,$defaulter)=@_;
+    my ($spec);
+    &$defaulter unless @al;
+    $spec= shift @al;
+    return &$converter($spec);
+}
+
+sub can ($) { my ($conv)=@_; canf($c, sub { die "too few args"; }); }
+sub cano ($$) { my ($conv,$def)=@_; canf($c, sub { return $def }); }
+
+$pi= atan2(0,-1);
+
+%units_len= qw(- mm  mm 0  cm 10  m 1000);
+%units_ang= qw(- d   r 1); $units_ang{'d'}= 2*$pi/360;
+
+sub cva_len ($) { my ($sp)=@_; cva_units($sp,\%units_len); }
+sub cva_ang ($) { my ($sp)=@_; cva_units($sp,\%units_ang); }
+sub cva_units ($$) {
+    my ($sp,$ua,$n,$u)=@_;
+    $sp =~ s/^([-0-9eE.]+)([A-Za-z]*)$/;
+    ($n,$u)= ($1,$1);
+    $u=$u{'-'} unless length $u;
+    defined $ua->{$u} or die "unknown unit $u";
+    return $n * $ua->{$u};
+}
+sub cva_idstr ($) { my ($sp)=@_; die unless m/^[-0-9a-z]+$; return $&; }
+sub cva_idex ($) {
+    my ($sp,$id)=@_;
+    $id=cva_idstr($sp);
+    die "unknown $id" unless defined $loc{$id};
+    return $loc{$id};
+}
+sub cva_idnew ($) {
+    my ($sp,$id)=@_;
+    $id=cva_idstr($sp); 
+    die "duplicate $id" if defined $loc{$id};
+    keys %{ $loc{$id} };
+    return $loc{$id};
+}    
+
+sub cmd_mark {
+    $mark= 1;
+    &cmd__do;
+}
+
+sub cmd_abs {
+    $nl= can(\&cva_idnew);
+    $nl->{X}= can(\&cva_len);
+    $nl->{Y}= can(\&cva_len);
+    $nl->{A}= cano(\&cva_ang, undef);
+}   
+
+sub cmd_extend {
+    $from= can(\&cva_idex);
+    $to= can(\&cva_idnew);
+    die "no ang" unless defined $from->{A};
+    $how= can(cva_enum(qw(len upto ang)));
+    if ($how eq 'len') { $len= can(\&cva_len); }
+    elsif ($how eq 'ang') { $ang= can(\&cva_ang); }
+    elsif ($how eq 'upto') { $upto= can(\&cva_id); }
+    $radius= cano(\&cva_ang, 'Inf'); # +ve is right hand bend
+    if ($radius eq 'Inf') {
+	if ($how eq 'ang') { die "len of straight spec by angle"; }
+	if ($how eq 'upto') {
+	    $len= ($upto->{X} - $from->{X}) * cos($from->{a})
+		+ ($upto->{Y} - $from->{Y}) * sin($from->{a});
+	}
+	$to->{X}= $from->{X} + $len * cos($from->{A});
+	$to->{Y}= $from->{Y} + $len * sin($from->{A});
+	$to->{A}= $from->{A};
+	# fixme mark
+    } else {
+	$signum= $radius / abs($radisu);
+	$ctr->{X}= $from->{X} + $radius * sin($from->{A});
+	$ctr->{Y}= $from->{Y} - $radius * cos($from->{A});
+	if ($how eq 'upto') {
+	    $beta= atan2(-$signum * ($upto->{X} - $ctr->{X}),
+			 $signum * ($upto->{Y} - $ctr->{Y}));
+	} else {
+	    if ($how eq 'len') { $ang= $len / abs($radius); }
+	    $beta= $from->{A} - $signum * $ang;
+	}
+	$to->{A}= $beta;
+	$to->{X}= $ctr->{X} + $radius * cos($beta);
+	$to->{Y}= $ctr->{Y} - $radius * sin($beta);
+	
+
+    die "point only" unless defined $from->{A};
+    join($from,$to);
+}
+
+sub cmd__do {
+    
+	
+sub cmd_str_asfar {
+    $from= can(\&cva_idex);
+    $to= can(\&cva_idex);
+    
+
+while (<>) {
+    next if m/^\s*\#/;
+    chomp; s/^\s+//; s/\s+$//;
+    @al= split /\s+/, $_;
+    next unless @al;
+    $mark= 0;
+    $cmd= can(\&cva_cmd);
+shift @al;    $cmd =~ y/-_/_-/;
+    &{ "cmd_$cmd" };
+}