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 ($) {
sub miscpscolour ($) {
my ($colourname) = @_;
print STDERR "COLOUR MISC $colourname\n";
- pscolour($colourname, 1,0);
+ pscolour($colourname, 1, 1,0);
}
sub cubeedgepscolour () { '0 setgray ' }