BrowserUk's nice post in
ColorRamp1785 had one little shortcoming.... there was no selection method for choosing the right color. Here is a little Perl/Tk front-end to his subs.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my @colors;
# generate colors from BrowserUk's subs in
# http://perlmonks.org?node_id=724491
sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }
my( $r, $g, $b ) = (0) x 3;
for my $step ( 0 .. 1784 ) {
if( $step < 255 ) { ++$b; }
elsif( $step < 510 ) { ++$g; }
elsif( $step < 765 ) { --$b; }
elsif( $step < 1020 ) { ++$r; }
elsif( $step < 1275 ) { --$g; }
elsif( $step < 1530 ) { ++$b; }
else { ++$g; }
#print "$r $g $b\t";
my $hexcurrent = '#'.sprintf('%.2x', $r).sprintf('%.2x', $g).sprintf(
+'%.2x', $b);
# print "$hexcurrent\n";
push @colors,$hexcurrent;
}
my %map = (
255 => sub{ 0, 0, $_[0] * 255 },
510 => sub{ 0, $_[0]*255, 255 },
765 => sub{ 0, 255, (1-$_[0])*255 },
1020 => sub{ $_[0]*255, 255, 0 },
1275 => sub{ 255, (1-$_[0])*255, 0 },
1530 => sub{ 255, 0, $_[0]*255 },
1785 => sub{ 255, $_[0]*255, 255 },
);
my @map = sort{ $a <=> $::b } keys %map;
sub colorRamp1785 {
my( $v, $vmin, $vmax ) = @_;
$v = $vmax if $v > $vmax;
$v = $vmin if $v < $vmin;
$v = ( $v - $vmin ) / ( $vmax - $vmin );
$v *= 1785;
$v < $_ and return rgb2n( $map{ $_ }->( $v ) ) for @map;
}
######################################3
#print "\n",join "\n", @colors,"\n";
#print scalar @colors,"\n";
my $mw=tkinit;
$mw->fontCreate('big',
-family=>'arial',
-weight=>'bold',
-size=> 38
);
my $bfr = $mw->Frame()->pack(-fill=>'x');
my $cur_color = '# ';
my $lab = $bfr->Label(-textvariable => \$cur_color,
-font => 'big',
)->pack();
my $sc = $mw->Scrolled('Canvas',
-bg=>'white',
-scrollbars=>'s',
)->pack(-expand=>1,-fill=>'x',-padx=>10);
my $realcanvas = $sc->Subwidget('scrolled');
my $x = 0;
foreach my $color(@colors) {
my $line = $realcanvas->createLine($x,0,$x, 250,
-fill=> $color,
-tags => [$color,'line']
);
$x++;
$realcanvas->bind("line", "<Enter>",
sub {
my (@tags) = $realcanvas->gettags('current');
$cur_color = $tags[0];
});
}
#print "$x\n";
$realcanvas->configure(-scrollregion=>[$realcanvas->bbox("all")]);
MainLoop;
__END__