layout: support specifying colours, colour parsing. no functional change intended...

diff --git a/layout/README.layout b/layout/README.layout
index 44519ed9ce892d1fad6242adef0b53f5039526e6..1dcc45fa781f3c6453d0886beea6c371bc8fe0e5 100644 (file)
--- a/layout/README.layout
+++ b/layout/README.layout
@@ -266,19 +266,23 @@ Command-line options
               O  mark locs with a bar in parts
               G  draw subsegment encoding
 
-Colour letters:
-  extra colour letters:
+ -C<elements>=<colour>
+         Specify colour to draw <elements> in.  <element> is one or
+         more of the element letters above (uppercase), except that
+         (i) the elements QGON are not colourable separately and
+         (ii) the following additional letters are available here:
              r  registration marks
              o  library entry object names
              l  background for loc labels
              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
-             
+             *  all elements
+         <colour> may be:
+             empty        reverts to monochrome, with default grayscale
+             <name>       name from rgb.txt
+             #<R><G><B>   where R G B are each the same number of hex digits
+              %<ps>       literal postscript <ps> eg  0.5 setgray
+
  -q       quiet: do not print info to stderr
           (default: prints bounding box, at the moment)
 

diff --git a/layout/layout b/layout/layout
index 49194e46f6a5bf10b29e2569859d0b8d4e03ad62..e0cdb8f1c9f243a1959665a168330162108f16b6 100755 (executable)
--- a/layout/layout
+++ b/layout/layout
@@ -33,6 +33,8 @@ our %subsegcmap;
 our %segcmap;
 our $shiftrotate= "";
 
+our %colourmap;
+
 our $drawers= 'arqscldmnoge';
 our %chdraw_emap= qw(A ARScgd
                     R aRscgD
@@ -55,6 +57,60 @@ $psu_subseglw{'e'}= 20.0;
 $psu_subseglw{'m'}= 15.0;
 $psu_subseglw{'q'}= 20.0;
 
+
+#---------- colour command line processing ----------
+
+$colourmap{$_}='' foreach qw(A R E S C L D M r o l p i);
+
+sub parse_colour ($) {
+    my ($spec) = @_;
+    my @rgb;
+    my $rgbmax;
+    if ($spec =~ m/^\#([0-9a-f]+)$/) {
+       my $l3= length $1;
+       die "bad hex colour (length) \`$spec'" if $l3 % 3;
+       my $l1= $l3/3;
+       foreach my $i (0..2) {
+           push @rgb, hex substr $1, $i*$l1, $l1;
+       }
+       $rgbmax= (1 << ($l1 * 4))-1;
+    } elsif ($spec eq '') {
+       return '';
+    } elsif ($spec =~ m/^\%/) {
+       return $';
+    } else {
+       our %rgb_txt_map;
+       if (!%rgb_txt_map) {
+           my $rgbtxt= '/usr/share/X11/rgb.txt';
+           my $rgbf= new IO::File $rgbtxt or die "$rgbtxt $!";
+           while (<$rgbf>) {
+               s/^\s+//; s/\s+$//; chomp;
+               next if m/^[\#!]/;
+               my @l = m/^(\d+)\s+(\d+)\s+(\d+)\s+(\S.*)$/;
+               if (!@l) { warn "$rgbtxt:$.: bad line\n"; next; }
+               my $k= pop @l;
+               $rgb_txt_map{$k}= \@l;
+           }
+       }
+
+       my $ent= $rgb_txt_map{$spec};
+       die "unknown colour \`$ent'\n" unless defined $ent;
+
+       @rgb= @$ent;
+       $rgbmax= 255;
+    }
+    my $s= ' ';
+    foreach my $i (0..2) {
+       my $v= $rgb[$i] / $rgbmax;
+       die "bad rgb value $v ($rgb[$i] vs. $rgbmax in \`$spec'"
+           unless $v >= 0 && $v <= 1;
+       $s .= sprintf "%5.3f ", $v;
+    }
+    return "$s setrgbcolor";
+}
+
+#---------- parse arguments ----------
+
 while (@ARGV && $ARGV[0] =~ m/^\-/) {
     last if $ARGV[0] eq '-';
     $_= shift @ARGV;
@@ -70,6 +126,19 @@ while (@ARGV && $ARGV[0] =~ m/^\-/) {
        elsif (s/^Lsubseglw(\w)\=(\d+)$//) {
            exists $psu_subseglw{$1} or die "unknown -L<spec> spec";
            $psu_subseglw{$1}= $2*0.1;
+       } elsif (s/^C([A-Za-z*]+)=(.*)$//) {
+           my @defs= split //, $1;
+           my $nc= parse_colour($2);
+           foreach my $def (@defs) {
+               if ($def eq '*') {
+                   $colourmap{$_}=$nc foreach keys %colourmap;
+               } elsif (exists $colourmap{$def}) {
+                   $colourmap{$def}= $nc;
+               } else {
+                   die "cannot specify colour for unknown thing $def";
+               }
+           }
+           $_='';
        } elsif (s/^GR//) { $subsegcmapreq=1; }
        elsif (s/^GP(\d+|f)$//) { $subsegmovfeatpos=$1; }
        elsif (s/^R(0|90|180|270)$//) {
@@ -636,12 +705,12 @@ sub dv {
 
 sub set_black ($) {
     my ($colourletter) = @_;
-    return '0 setgray';
+    return $colourmap{$colourletter} || '0 setgray';
 }
 
 sub set_colour ($$) {
     my ($grey, $colourletter) = @_;
-    return "$grey setgray";
+    return $colourmap{$colourletter} || "$grey setgray";
 }
 
 #---------- output helpers ----------