chiark / gitweb /
refactor pscolour interface (nfc)
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 6 Mar 2019 14:42:10 +0000 (14:42 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 6 Mar 2019 14:42:10 +0000 (14:42 +0000)
generate-board

index 96e5207a3fc3a8b43c161934e528e32eab98b459..f785689f1d36f97f083b83738db770e9c2a2cd99 100755 (executable)
@@ -388,15 +388,15 @@ showpage
 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
       ),
@@ -407,15 +407,13 @@ sub pscolour ($;$) {
 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 ($) {
@@ -426,7 +424,7 @@ sub facepscolour ($) {
 sub miscpscolour ($) {
   my ($colourname) = @_;
   print STDERR "COLOUR MISC $colourname\n";
-  pscolour($c{Colours}{$colourname});
+  pscolour($colourname, 1,0);
 }
 
 sub cubeedgepscolour () {  '0 setgray ' }