END
}
-sub pscolour ($;$) {
- my ($spec, $adj1) = @_;
+sub pscolour ($$$) {
+ my ($colourname, $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;
- $adj1 //= sub { };
- $adj1->(@rgb);
+ foreach (@rgb) { $_ *= $rgbmul; $_ += $rgbadd; }
my $r = join ' ',
(map { sprintf "%.6f ", $_ } @rgb
),
sub lighterpscolour ($$) {
my ($colourname, $retain) = @_;
print STDERR "COLOUR LIGHTER $retain $colourname\n";
- pscolour($c{Colours}{$colourname},
- sub { $_ = 1.0 - $retain * (1.0 - $_) foreach @_ })
+ pscolour($colourname, $retain, 1-$retain);
}
sub darkerpscolour ($$) {
my ($colourname, $retain) = @_;
print STDERR "COLOUR DARKER $retain $colourname\n";
- pscolour($c{Colours}{$colourname},
- sub { $_ = $retain * $_ foreach @_ })
+ pscolour($colourname, $retain, 0);
}
sub facepscolour ($) {
sub miscpscolour ($) {
my ($colourname) = @_;
print STDERR "COLOUR MISC $colourname\n";
- pscolour($c{Colours}{$colourname});
+ pscolour($colourname, 1,0);
}
sub cubeedgepscolour () { '0 setgray ' }