--- /dev/null
+#!/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" };
+}