chiark / gitweb /
wip cmykcolour nfc
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 6 Mar 2019 14:58:32 +0000 (14:58 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 6 Mar 2019 14:58:32 +0000 (14:58 +0000)
generate-board

index f785689f1d36f97f083b83738db770e9c2a2cd99..f7e3cdb9fb589faa8f63c394ac177897ee81c59c 100755 (executable)
@@ -388,32 +388,62 @@ showpage
 END
 }
 
-sub pscolour ($$$) {
-  my ($colourname, $rgbmul,$rgbadd) = @_;
+sub pscolour ($$$$) {
+  my ($colourname, $cmykix,$rgbmul,$rgbadd) = @_;
   my $spec = $c{Colours}{$colourname};
   confess unless defined $spec;
-  my $le = (length $spec)/3;
-  my $re = ("(.{$le})") x 3;
-  my @rgb = $spec =~ m/^$re$/;  @rgb or confess "$re ?";
-  @rgb = map { hex($_) / (16**$le -1) } @rgb;
-  foreach (@rgb) { $_ *= $rgbmul; $_ += $rgbadd; }
+
+  # check that we have only one lighter/darker retain value for each one
+  our %colour_occurred;
+  $colour_occurred{$colourname}{$cmykix}{$rgbmul,$rgbadd} = 1;
+  keys %{ $colour_occurred{$colourname}{$cmykix} } == 1 or confess;
+
+  my @r;
+  my $rw;
+  if ($spec =~ m/^[0-9a-f]+$/) {
+    my $le = (length $spec)/3;
+    my $re = ("(.{$le})") x 3;
+    my @rgb = $spec =~ m/^$re$/;  @rgb or confess "$re ?";
+    @rgb = map { hex($_) / (16**$le -1) } @rgb;
+    foreach (@rgb) { $_ *= $rgbmul; $_ += $rgbadd; }
+    @r = @rgb;
+    $rw = 'setrgbcolor';
+  } elsif ($spec =~ m/[CMYK]/) {
+    my @specs = split /\//, $spec;
+    if ($cmykix==0 && @specs==1) {
+      $spec = $specs[0];
+    } else {
+      $spec = $specs[$cmykix];
+      confess unless defined;
+    }
+    my %cmyk;
+    foreach (split /(?=[A-Z])/, $spec) {
+      m/^([CMYK])(?:[0-7]\.\d*|8)_?$/ or confess $_.' ?';
+      confess if defined $cmyk{$1};
+      $cmyk{$1} = $2 / 8.;
+    }
+    @r = map { $cmyk{$_} // 0 } qw(C M Y K);
+    $rw = 'setcmykcolor';
+  } else {
+    confess $spec.' ?';
+  }
   my $r = join ' ',
-      (map { sprintf "%.6f ", $_ } @rgb
+      (map { sprintf "%.6f ", $_ } @r
       ),
-          'setrgbcolor';
+         $rw;
   return $r;
 }
 
 sub lighterpscolour ($$) {
   my ($colourname, $retain) = @_;
   print STDERR "COLOUR LIGHTER $retain $colourname\n";
-  pscolour($colourname, $retain, 1-$retain);
+  pscolour($colourname, 0, $retain, 1-$retain);
 }
 
 sub darkerpscolour ($$) {
   my ($colourname, $retain) = @_;
   print STDERR "COLOUR DARKER $retain $colourname\n";
-  pscolour($colourname, $retain, 0);
+  pscolour($colourname, 2, $retain, 0);
 }
 
 sub facepscolour ($) {
@@ -424,7 +454,7 @@ sub facepscolour ($) {
 sub miscpscolour ($) {
   my ($colourname) = @_;
   print STDERR "COLOUR MISC $colourname\n";
-  pscolour($colourname, 1,0);
+  pscolour($colourname, 1, 1,0);
 }
 
 sub cubeedgepscolour () {  '0 setgray ' }