features, features, tested

diff --git a/layout/layout b/layout/layout
index a1d51652c9cbf2b2ee9b3d0b5940d22b0da16015..83b9486d88c665ef815608bd4dcdd54cc2c599b9 100755 (executable)
--- a/layout/layout
+++ b/layout/layout
@@ -7,8 +7,14 @@ use POSIX;
 #  $loc{$id}{Y}
 #  $loc{$id}{A}  may be undef
 
+#$debug=1;
 open DEBUG, ($debug ? ">&2" : ">/dev/null") or die $!;
 
+if ($debug) {
+    select(DEBUG); $|=1;
+    select(STDOUT); $|=1;
+}
+
 sub canf ($$) {
     my ($converter,$defaulter)=@_;
     my ($spec,$v);
@@ -47,11 +53,13 @@ sub cva_idstr ($) {
 }
 sub cva_idex ($) {
     my ($sp,$id)=@_;
-    my ($r);
+    my ($r,$d,$k);
     $id=cva_idstr($sp);
     die "unknown $id" unless defined $loc{$id};
     $r= $loc{$id};
-    printf DEBUG "%s %s %s\n", $id, join("|", keys %$r), $r->{A};
+    $d= "idex $id";
+    foreach $k (sort keys %$r) { $d .= " $k=$r->{$k}"; }
+    printf DEBUG "%s\n", $d;
     return $r;
 }
 sub cva_idnew ($) {
@@ -87,6 +95,18 @@ sub cmd_abs {
 dv('cmd_abs ','$nl',$nl,'\\%loc',\%loc);
 }
 
+sub cmd_rel {
+    $from= can(\&cva_idex);
+    $to= can(\&cva_idnew);
+    $len= can(\&cva_len);
+    $right= can(\&cva_len);
+    $turn= cano(\&cva_ang, 0);
+    $to->{X}= $from->{X} + $len * cos($from->{A}) + $right * sin($from->{A});
+    $to->{Y}= $from->{Y} + $len * sin($from->{A}) - $right * cos($from->{A});
+    $to->{A}= $from->{A} + $turn;
+dv('cmd_abs ','$to',$to);
+}
+
 sub evreff ($) {
     my ($pfx) = @_;
     $pfx . ($pfx =~ m/\}$|\]$/ ? '' : '->');
@@ -111,12 +131,12 @@ sub dv1_kind ($$$$$$$) {
        dv1($pfx,$expr.sprintf($ixfmt,evr($ix)),$v);
     }
     if (!$any) {
-       printf DEBUG "%s%s= ".$ixfmt, $pfx, $expr, ' ';
+       printf DEBUG "%s%s= $ixfmt\n", $pfx, $expr, ' ';
     }
     1;
 }    
 sub dv1 ($$$) {
-    return unless $debug;
+    return ;0 unless $debug;
     my ($pfx,$expr,$v) = @_;
     $ref= ref $v;
 #print STDERR "dv1 >$pfx|$ref<\n";
@@ -150,7 +170,7 @@ sub loc_lin_comb ($$$) {
     my ($a,$b,$p) = @_;
     my ($q,$r) = 1.0-$p;
     map { $r->{$_} = $q * $a->{$_} + $p * $b->{$_} } qw(X Y A);
-    dv("loc_lin_comb ",'$a',$a,'$b',$b,'$p',$p,'$r',$r);
+#    dv("loc_lin_comb ",'$a',$a,'$b',$b,'$p',$p,'$r',$r);
     return $r;
 }
 
@@ -201,7 +221,7 @@ sub psu_coords ($$$) {
     foreach $zo (qw(0 1)) {
        $prop= $zo ? $inunit : (1.0 - $inunit);
        $ea_zo{X} += $prop * ($ends->[$zo]{X} - $across * sin($ends->[0]{A}));
-       $ea_zo{Y} += $prop * ($ends->[$zo]{Y} - $across * cos($ends->[0]{A}));
+       $ea_zo{Y} += $prop * ($ends->[$zo]{Y} + $across * cos($ends->[0]{A}));
     }
 #    dv("psu_coords ", '$ends',$ends, '$inunit',$inunit, '$across',$across,
 #       '\\%ea_zo', \%ea_zo);
@@ -223,13 +243,13 @@ sub parametric_segment ($$$$$) {
     my ($tickpitch)=($psu_ulen / $psu_ticksperu);
     my ($sleeperctr)=($psu_ulen*0.5);
     my ($sleeperend)=($psu_sleeperlen*0.5);
-print DEBUG "ps $p0 $p1\n";
+print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
     for ($pa= $p0; $pa<$p1; $pa=$pb) {
        $pb= $pa + $ppu;
        $p= $pa; $ends[0]= @ends ? $ends[1] : &$calcfn;
        $p= $pb; $ends[1]= &$calcfn;
-print DEBUG "pa $pa $ends[0]{X} $ends[0]{Y} $ends[0]{A}\n";
-print DEBUG "pb $pb $ends[1]{X} $ends[1]{Y} $ends[1]{A}\n";
+#print DEBUG "pa $pa $ends[0]{X} $ends[0]{Y} $ends[0]{A}\n";
+#print DEBUG "pb $pb $ends[1]{X} $ends[1]{Y} $ends[1]{A}\n";
        $e= $pb<=$p1 ? 1.0 : ($p1-$pa)/$ppu;
        o("    gsave\n");
        o_path_begin();
@@ -259,23 +279,24 @@ print DEBUG "pb $pb $ends[1]{X} $ends[1]{Y} $ends[1]{A}\n";
 }
 
 sub cmd_extend {
-    my ($from,$to);
+    my ($from,$to,$radius,$ctr,$beta,$ang,$how,$signum);
     $from= can(\&cva_idex);
     $to= can(\&cva_idnew);
-    printf DEBUG "%s %s\n", join("|", keys %$from), join("|", values %$from);
+    printf DEBUG "from $from->{X} $from->{Y} $from->{A}\n";
     die "no ang" unless defined $from->{A};
-    $how= can(cvam_enum(qw(len upto ang)));
+    $how= can(cvam_enum(qw(len upto ang uptoang parallel)));
     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
+    elsif ($how =~ m/ang$/) { $ang= can(\&cva_ang); }
+    elsif ($how eq 'parallel' || $how eq 'upto') { $upto= can(\&cva_idex); }
+    $radius= cano(\&cva_len, 'Inf'); # +ve is right hand bend
     if ($radius eq 'Inf') {
        print DEBUG "extend inf $len\n";
        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});
+           $len= ($upto->{X} - $from->{X}) * cos($from->{A})
+               + ($upto->{Y} - $from->{Y}) * sin($from->{A});
        }
+       printf DEBUG "len $len\n";
        $to->{X}= $from->{X} + $len * cos($from->{A});
        $to->{Y}= $from->{Y} + $len * sin($from->{A});
        $to->{A}= $from->{A};
@@ -283,23 +304,46 @@ sub cmd_extend {
            loc_lin_comb($from, $to, $p);
        });
     } else {
+       print DEBUG "radius >$radius<\n";
        $signum= $radius / abs($radius);
        $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}));
+           $beta_interval= 1.0;
+       } elsif ($how eq 'parallel') {
+           $beta= $upto->{A};
+           $beta_interval= 1.0;
+       } elsif ($how eq 'uptoang') {
+           $beta= $ang;
+           $beta_interval= 2.0;
+       } elsif ($how eq 'len') {
+           $beta= $from->{A} - $signum * $len / abs($radius);
+           $beta_interval= 2.0;
        } else {
-           if ($how eq 'len') { $ang= $len / abs($radius); }
            $beta= $from->{A} - $signum * $ang;
+           $beta_interval= 2.0;
        }
+    printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
+       $beta += $signum * 4.0 * $pi;
+       for (;;) {
+           $delta= $beta - $from->{A};
+           last if $signum * $delta <= 0;
+           $beta -= $signum * $beta_interval * $pi;
+       }       
+    printf DEBUG "ctr->{Y}=$ctr->{Y} radius=$radius beta=$beta\n";
        $to->{A}= $beta;
-       $to->{X}= $ctr->{X} + $radius * cos($beta);
-       $to->{Y}= $ctr->{Y} - $radius * sin($beta);
-#      parametric_segment(0, II, $radius);
+       $to->{X}= $ctr->{X} - $radius * sin($beta);
+       $to->{Y}= $ctr->{Y} + $radius * cos($beta);
+       parametric_segment(II, 0.0, 1.0, abs($radius*$delta), sub {
+           my ($beta) = $from->{A} + $delta * $p;
+           return { X => $ctr->{X} - $radius * sin($beta),
+                    Y => $ctr->{Y} + $radius * cos($beta),
+                    A => $beta }
+       });
     }
-    die "point only" unless defined $from->{A};
-    join($from,$to);
+    printf DEBUG "to $to->{X} $to->{Y} $to->{A}\n";
 }
 
 sub cmd__do {
@@ -307,7 +351,7 @@ sub cmd__do {
     &{ "cmd_$cmd" };
 }      
 
-$ptscale= 72/25.4 * 0.1;
+$ptscale= 72/25.4 / 5.0;
 
 o("%!\n".
   "  $ptscale $ptscale scale\n");
@@ -317,6 +361,7 @@ while (<>) {
     chomp; s/^\s+//; s/\s+$//;
     @al= split /\s+/, $_;
     next unless @al;
+    print DEBUG "=== @al\n";
     $mark= 0;
     cmd__do();
 }

diff --git a/layout/testfile b/layout/testfile
new file mode 100644 (file)
index 0000000..54d46b0
--- /dev/null
+++ b/layout/testfile
@@ -0,0 +1,18 @@
+abs a 100 400 -30
+extend a b len 200mm
+extend b c ang 120 -450
+extend c d len 150mm
+extend d e parallel a -315
+extend e f upto a
+
+rel a a0 0 37 0
+extend a0 b0 upto b
+extend b0 c0 upto c -487
+extend c0 d0 upto d
+extend d0 e0 upto e -352
+extend e0 f0 upto f
+
+extend a b1 ang 22.5 -228
+extend b1 c1 uptoang 60 -228
+extend c1 d1 upto f
+extend d1 e1 len 100