layout: hooks for colouring output; no intentional change to meaning of output or...

diff --git a/layout/README.layout b/layout/README.layout
index 6b329defb054b4124edd467b45a537306939504b..0120971c52584d6ddd84446cb8a24c6f8018a4f6 100644 (file)
--- a/layout/README.layout
+++ b/layout/README.layout
@@ -266,6 +266,18 @@ Command-line options
               O  mark locs with a bar in parts
               G  draw subsegment encoding
 
+Colour letters:
+  extra colour letters:
+             r  registration marks
+             l  library entry object names
+             p  page number
+             i  ident
+  elements not separately colourable:
+              Q  draw track segment fills according to segcmap
+              G  draw subsegment encoding
+              O  mark locs with a bar in parts
+              N  mark locs with a bar in objs
+             
  -q       quiet: do not print info to stderr
           (default: prints bounding box, at the moment)
 

diff --git a/layout/layout b/layout/layout
index 3a5e4c1f154e0b456c2129488d80c2f87747630f..f1a40e0f6ae248ee44b312e429183f09bcc0f74b 100755 (executable)
--- a/layout/layout
+++ b/layout/layout
@@ -632,6 +632,18 @@ sub dv {
     }
 }                  
 
+#---------- colour ----------
+
+sub set_black ($) {
+    my ($colourletter) = @_;
+    return '0 setgray';
+}
+
+sub set_colour ($$) {
+    my ($grey, $colourletter) = @_;
+    return "$grey setgray";
+}
+
 #---------- output helpers ----------
 
 sub o ($) { $o .= $_[0]; }
@@ -899,14 +911,14 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu) $allwidth\n";
     }
     if ($draw =~ m/C/) {
        my ($pt);
-       o("    $psu_thinlw setlinewidth\n");
+       o("    gsave $psu_thinlw setlinewidth ".set_black('C')."\n");
        o_path_begin();
        for ($param=$p0; $param<$p1; $param += $ppu) {
            parametric__o_pt(&$calcfn);
        }
        $param=$p1;
        parametric__o_pt(&$calcfn);
-       o("      stroke\n");
+       o("      stroke grestore\n");
     }
     if ($draw =~ m/[ARS]/) { for ($pa= $p0; $pa<$p1; $pa=$pb) {
        $pb= $pa + $ppu;
@@ -922,20 +934,22 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu) $allwidth\n";
        o_path_point(psu_coords(\@ends,$e,$allwidth));
        o_path_point(psu_coords(\@ends,$e,-$allwidth));
        o("        closepath clip\n");
-       foreach $side qw(-1 1) {
-           if ($draw =~ m/R/) {
+       if ($draw =~ m/R/) {
+           o("        ".set_black('R')."\n");
+           foreach $side qw(-1 1) {
                o_line(psu_coords(\@ends,0,$side*$railctr),
                       psu_coords(\@ends,1.5,$side*$railctr),
                       $psu_raillw);
            }
        }
        if ($draw =~ m/S/) {
+           o("        ".set_black('S')."\n");
            o_line(psu_coords(\@ends,$sleeperctr,-$sleeperend),
                   psu_coords(\@ends,$sleeperctr,+$sleeperend),
                   $psu_sleeperlw);
        }
        if ($draw =~ m/A/) {
-           o("        0.5 setgray\n");
+           o("        ".set_colour(0.5, 'A')."\n");
            foreach $side qw(-1 1) {
                o_line(psu_coords(\@ends,0,$side*$allwidth),
                       psu_coords(\@ends,1.5,$side*$allwidth),
@@ -956,7 +970,7 @@ print DEBUG "ps $p0 $p1 $lenperp ($ppu) $allwidth\n";
        $len= sprintf "%.0f", $lenperp * abs($p1-$p0);
        $off= $draw =~ m/C/ ? $lmu_lenlabeloff : $lmu_lenlabeloffctr;
        o_gsave_transform($pt);
-       ol("        lf setfont\n".
+       ol("        lf setfont ".set_black('D')."\n".
           "        0 $off moveto\n".
           "        ($len) show\n".
           "      grestore\n");
@@ -1656,11 +1670,13 @@ dv("cmd__do $ctx @al ",'$ctx',$ctx);
            ol("    gsave\n".
               "      $loc->{X} $loc->{Y} translate $ad rotate\n");
            if ($draw =~ m/M/) {
+               ol("      ".set_black('M')."\n");
                ol("      0 $allwidthmin newpath moveto\n".
                   "      0 -$allwidthmin lineto\n".
                   "      $lmu_marklw setlinewidth stroke\n");
            }
            if ($draw =~ m/L/) {
+               ol("      ".set_black('L')."\n");
                ol("      /s ($id) def\n".
                   "      lf setfont\n".
                   "      /sx5  s stringwidth pop\n".
@@ -1670,7 +1686,7 @@ dv("cmd__do $ctx @al ",'$ctx',$ctx);
                   "      sx5 neg  $lmu_txtboxh  lineto\n".
                   "      sx5      $lmu_txtboxh  lineto\n".
                   "      sx5      0             lineto closepath\n".
-                  "      gsave  1 setgray fill  grestore\n".
+                  "      gsave  ".set_colour(1, 'L')." fill  grestore\n".
                   "      $lmu_txtboxlw setlinewidth stroke\n".
                   "      sx5 neg $lmu_txtboxpadx add  $lmu_txtboxtxty\n".
                   "      moveto s show\n");
@@ -1755,7 +1771,7 @@ sub cmd_showlibrary {
        cmd__runobj($obj_id);
        ol("    gsave\n".
           "      /s ($obj_id) def\n".
-          "      lf setfont\n      ".
+          "      lf setfont ".set_black('l')."\n".
           ($x + 0.5*$width)." ".($y - $olu_textheight)." moveto\n".
           "      s stringwidth pop -0.5 mul  0  rmoveto\n".
           "      s show grestore\n");
@@ -1780,8 +1796,9 @@ o("%!\n".
   "  gsave\n");
 
 if ($page_x || $page_y) {
-    o("  /Courier-New findfont 15 scalefont setfont\n".
-      "  30 30 moveto (${page_x}x${page_y}) show\n");
+    o("  gsave ".set_black('p')."\n");
+    o("    /Courier-New findfont 15 scalefont setfont\n".
+      "    30 30 moveto (${page_x}x${page_y}) show grestore\n");
 }
 
 o("  -$ps_page_xmul $page_x mul  -$ps_page_ymul $page_y mul  translate\n".
@@ -1830,7 +1847,7 @@ while (<>) {
        o_gsave_transform($pt);
        ol("      /s ($seg >) def\n".
           "      sf setfont\n".
-          "      0 0 moveto\n".
+          "      0 0 moveto ".set_black('E')."\n".
           "      s stringwidth pop -0.5 mul  $lmu_segtxtoff  moveto\n".
           "      s show\n".
           "      grestore\n");
@@ -1856,7 +1873,7 @@ while (<>) {
        my ($tick_x, $tick_y, $ticklen, $ticki_x, $ticki_y, $s);
        $ticklen= 10;
        o(sprintf
-         "    gsave 0.5 setgray 0.33 setlinewidth\n".
+         "    gsave ".set_colour(0.5,'r')." 0.33 setlinewidth\n".
          "      /Courier-New findfont 9 scalefont setfont\n".
          "      /regmark {\n".
          "        newpath moveto\n".
@@ -1892,9 +1909,10 @@ if (@ident_strings && !($subsegcmapreq || %subsegcmap)) {
     unshift @ident_strings, $gitid;
     $is= join('; ', grep { m/\S/ } @ident_strings);
     $is =~ s/[()\\]/\\$&/g;
-    ol("25 50 moveto".
-       "/Courier-New findfont 6 scalefont setfont\n".
-       " ($is) show\n");
+    ol("gsave ".set_black('i')."\n".
+       "  25 50 moveto".
+       "  /Courier-New findfont 6 scalefont setfont\n".
+       "  ($is) show grestore\n");
 }
 
 oflushpage();