E annotations work, perhaps need cosmetic tweaks

[trains.git] / layout / layout

diff --git a/layout/layout b/layout/layout
index 87d5c66c33aed1f488b80056642c4a9c97cf611b..f6d9cc0beb6d4406598ee18d95d599fec9b86a61 100755 (executable)
--- a/layout/layout
+++ b/layout/layout
@@ -253,16 +253,18 @@ our $allwidthmin= allwidth(undef);
 #  $seggraphends{"$bareseg"}[]{X}
 #  $seggraphends{"$bareseg"}[]{Y}
 #  $seggraphends{"$bareseg"}[]{A}
-#  $seggraphends{"-$bareseg"}[]...
-#  $seggraphend[0]{X}
-#  $seggraphend[0]{Y}
-#  $seggraphend[1]{X}
-#  $seggraphend[1]{Y}
+#  $seggraphaim->{X}
+#  $seggraphaim->{Y}
+#  $seggraphbest{$bareseg}{X}
+#  $seggraphbest{$bareseg}{Y}
+#  $seggraphbest{$bareseg}{A}
+#  $seggraphbest{$bareseg}{D2}
 
 our $ctx;
 our %objs;
 our %seggraphends;
-our @seggraphend;
+our $seggraphaim;
+our %seggraphbest;
 our @al; # current cmd
 
 our $o='';
@@ -395,12 +397,23 @@ sub v_subtract ($$) {
     return { X => $b->{X} - $a->{X},
             Y => $b->{Y} - $a->{Y} };
 }
-sub v_len ($) {
+sub v_lensquared ($) {
     # v_len(V)
     # scalar length of V
     my ($v)=@_;
     my ($x,$y) = ($v->{X}, $v->{Y});
-    return sqrt($x*$x + $y*$y);
+    return $x*$x + $y*$y;
+}
+sub v_len ($) {
+    # v_len(V)
+    # scalar length of V
+    my ($v)=@_;
+    return sqrt(v_lensquared($v));
+}
+sub v_distsquared ($$) {
+    # v_dist(A,B)
+    # returns squared distance from A to B
+    return v_lensquared(v_subtract($_[0],$_[1]));
 }
 sub v_dist ($$) {
     # v_dist(A,B)
@@ -718,19 +731,13 @@ sub segment_state_restore ($) {
 }
 
 sub segment__check_graphends () {
-    my ($bare,$ge,$i,$key);
-    @seggraphend= ();
+    my ($bare,$ge,$i,$key,@end);
+    $seggraphaim= undef;
     $segments[0] =~ m/^\-?(\w+)/ or return;
     $bare= $1;
-    foreach $i (qw(0 1)) {
-       $key= ('', '-')[$i].$bare;
-       $ge= $seggraphends{$key};
-       defined $ge or return;
-#print STDERR "$key @$ge\n";
-#map { print STDERR " ".join('|',keys %{$_}),"<\n"; } @$ge;
-       $seggraphend[$i]= v_mean(@$ge);
-#print STDERR "SGE $i $seggraphend[$i]{X} $seggraphend[$i]{Y}\n";
-    }
+    $ge= $seggraphends{$bare};
+    defined $ge or return;
+    $seggraphaim= v_mean(@$ge);
 }
 
 sub segment_used_begin ($) {
@@ -768,7 +775,7 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
     $draw= current_draw();
     if ($draw =~ m/[QGE]/) {
        my ($pt,$going,$red,$csegbare,$movfeat,$movstroke);
-       my ($used_last,$me,$segsave,$diff);
+       my ($used_last,$me,$segsave,$diff, $best,$dist2,$segvbare,$segvbaren);
        o("gsave\n");
        $segsave= segment_state_save();
        foreach $me ($draw =~ m/Q/ ? qw(q) : qw(e m)) {
@@ -825,15 +832,18 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
                $param += $ppu;
                last if $param>=$p1;
                $pt= &$calcfn;
-               if ($draw =~ m/E/ && @seggraphend==2) {
-                   $diff= v_len(v_subtract($pt, $seggraphend[0])) -
-                          v_len(v_subtract($pt, $seggraphend[1]));
-                   if (abs($diff) < $psu_ulen*3) {
-                       $segments[0] =~ m/^(\-?)(\w+)/;
-                       $seglabel{$2}{X}= $pt->{X};
-                       $seglabel{$2}{Y}= $pt->{Y};
-                       $seglabel{$2}{A}= $pt->{A};
-                       $seglabel{$2}{A} += $pi if length($1);
+               if ($draw =~ m/E/ && $seggraphaim) {
+                   $segments[0] =~ m/^(\-?)(\w+)/ or die;
+                   ($segvbaren,$segvbare)=($1,$2);
+                   $dist2= v_distsquared($pt, $seggraphaim);
+                   $best= $seggraphbest{$segvbare};
+                   if (!$best or $dist2 < $best->{D2}) {
+                       $best= { X => $pt->{X},
+                                Y => $pt->{Y},
+                                A => $pt->{A},
+                                D2 => $dist2 };
+                       $best->{A} += $pi if length($segvbaren);
+                       $seggraphbest{$segvbare}= $best;
                    }
                }
                segment_used_middle($psu_ulen,$pt);
@@ -862,20 +872,6 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu)\n";
        parametric__o_pt(&$calcfn);
        o("      stroke\n");
     }
-    if ($draw =~ m/E/) {
-       my ($pt,$seg);
-       foreach $seg (keys %seglabel) {
-           $pt= $seglabel{$seg};
-           ol("    gsave\n");
-           o_transform($pt);
-           ol("      /s ($seg) def\n".
-              "      sf setfont\n".
-              "      0 0 moveto\n".
-              "      s stringwidth pop -0.5 mul  $lmu_segtxtoff  moveto\n".
-              "      s show\n".
-              "      grestore\n");
-       }
-    }
     if ($draw =~ m/[ARS]/) { for ($pa= $p0; $pa<$p1; $pa=$pb) {
        $pb= $pa + $ppu;
        $param= $pa; $ends[0]= @ends ? $ends[1] : &$calcfn;
@@ -1431,7 +1427,7 @@ sub cmd_segcmap {
 sub cmd_segend {
     my ($from,$sp) = @_;
     $from= can(\&cva_idex);
-    $sp= can(\&cva_segment_n);
+    $sp= can(\&cva_segment);
 #print STDERR "setting $from ".join('|',keys %$from),"<\n";
     push @{ $seggraphends{$sp} }, $from;
 };
@@ -1761,6 +1757,21 @@ while (<>) {
     cmd__one();
 }
 
+{
+    my ($seg, $pt);
+    foreach $seg (keys %seggraphbest) {
+       $pt= $seggraphbest{$seg};
+       ol("    gsave\n");
+       o_transform($pt);
+       ol("      /s ($seg >) def\n".
+          "      sf setfont\n".
+          "      0 0 moveto\n".
+          "      s stringwidth pop -0.5 mul  $lmu_segtxtoff  moveto\n".
+          "      s show\n".
+          "      grestore\n");
+    }
+}
+
 {
     my ($min_x, $max_x, $min_y, $max_y) = bbox($ctx->{Loc});
     my ($bboxstr);