Ah. I was about to offer the code below as an improvement... I've added the updated subroutine to my tests.
The "corners" here are: (a) you can end up with $v == 1786; and (b) the ranges contain 255 values, apart from the first range (up to 255) which contains 256.
[Assuming I've understood the mapping correctly... the code below tests the various colorRamp1785() routines for 0..1785 (with $vmin == 0 and $vmax == 1785) against the expected values.]
use strict ; use warnings ;
sub rgb2n { unpack 'N', pack 'CCCC', 0, @_ } ;
# As per original.... ________________________________________________
+____________________
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;
}
# As updated.... _____________________________________________________
+____________________
BEGIN {
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_u {
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 % 255 / 256 ) ) for
+ @map;
}
}
# Alternative 1.... __________________________________________________
+____________________
my %map_1 = (
255 => sub { 0, 0, 255+$_[0] },
510 => sub { 0, 255+$_[0], 255 },
765 => sub { 0, 255, -$_[0] },
1020 => sub { 255+$_[0], 255, 0 },
1275 => sub { 255, -$_[0], 0 },
1530 => sub { 255, 0, 255+$_[0] },
1785 => sub { 255, 255+$_[0], 255 },
1786 => sub { 255, 255, 255 }, # Trap edge case
);
sub numeric ($$) { $_[0] <=> $_[1] } ;
my @map_1 = sort numeric keys %map_1 ;
sub colorRamp1785_1 {
my( $v, $vmin, $vmax ) = @_;
$v = $vmax if $v > $vmax;
$v = $vmin if $v < $vmin;
$v = int(1786 * ($v - $vmin) / ($vmax - $vmin)) ; # NB: if $v == $v
+max: $v => 1786
$v <= $_ and return rgb2n( $map_1{ $_ }->($v - $_) ) for @map_1 ;
}
# Alternative 2.... __________________________________________________
+____________________
my @map_2 = (
sub {( 0, 0, $_[0] )}, # 0.. 255 => (
+0, 0, 0..255)
sub {( 0, $_[0]- 255, 255 )}, # 256.. 510 => (
+0, 1..255, 255)
sub {( 0, 255, 765-$_[0] )}, # 511.. 765 => (
+0, 255, 254..0)
sub {( $_[0]- 765, 255, 0 )}, # 766..1020 => (1..25
+5, 255, 0)
sub {( 255, 1275-$_[0], 0 )}, # 1021..1275 => ( 25
+5, 254..0, 0)
sub {( 255, 0, $_[0]-1275 )}, # 1276..1530 => ( 25
+5, 0, 1..255)
sub {( 255, $_[0]-1530, 255 )}, # 1531..1785 => ( 25
+5, 1..255, 255)
) ;
sub colorRamp1785_2 {
my( $v, $vmin, $vmax ) = @_;
$v = int((1785 + 1) * ($v - $vmin) / ($vmax - $vmin)) ;
my $i ;
if ($v <= 0) {
$v = 0 ; # Clamp $v < $vmin
$i = 0 ; # Special case of $v = 0
}
else {
if ($v >= 1786) { $v = 1785 ; } ; # Clamp $v >= $vmin
$i = int(($v - 1) / 255) ; # Select conversion band. 1..25
+5 => 0
# 256..51
+0 => 1 etc.
} ;
return rgb2n( $map_2[$i]->($v) ) ;
}
# Testing ____________________________________________________________
+____________________
test_ramp(-50, +50) ;
test_expected("colorRamp1785", \&colorRamp1785) ;
test_expected("colorRamp1785_u", \&colorRamp1785_u) ;
test_expected("colorRamp1785_1", \&colorRamp1785_1) ;
test_expected("colorRamp1785_2", \&colorRamp1785_2) ;
sub test_ramp {
my ($vmin, $vmax) = @_ ;
my $diff = 0 ;
print "\n" ;
print "Ramps for $vmin-1..$vmax+1:\n" ;
for my $v ($vmin-1..$vmax+1) {
my $rgb = colorRamp1785 ($v, $vmin, $vmax) ;
my $rgb_u = colorRamp1785_u($v, $vmin, $vmax) ;
my $rgb_1 = colorRamp1785_1($v, $vmin, $vmax) ;
my $rgb_2 = colorRamp1785_2($v, $vmin, $vmax) ;
print show($v, $vmin, $vmax), " ", show_rgb($rgb),
" & ", show_rgb($rgb_u),
" cf ", show_rgb($rgb_1) ;
if ($rgb_1 != $rgb_2) {
print " *** but rgb_2 = ", show_rgb($rgb_2) ;
$diff++ ;
} ;
print "\n" ;
} ;
print $diff ? "*** $diff differences" : "No difference",
" between colorRamp1785_1 & colo
+rRamp1785_2\n" ;
} ;
sub test_expected {
my ($name, $ramp) = @_ ;
my $vmin = 0 ;
my $vmax = 1785 ;
my $vcount = $vmax - $vmin + 1 ;
print "\n" ;
print "Testing $name\($vmin..$vmax) against expected values.\n" ;
my $ok = 0 ;
for my $v ($vmin..$vmax) {
my $rmp = $ramp->($v, $vmin, $vmax) ;
my $exp = expectRamp($v) ;
if ($rmp == $exp) {
$ok++ ;
}
else {
print show($v, $vmin, $vmax), " ", show_rgb($rmp),
" cf ", show_rgb($exp), "\n" ;
} ;
} ;
print "$name: $ok/$vcount OK" ;
if ($ok != $vcount) { print " -- so ", $vcount - $ok, "/$vcount wron
+g" ; } ;
print "\n" ;
} ;
sub show {
my ($v, $vmin, $vmax) = @_ ;
sprintf "%+6d (%5.1f%%):", $v, 100 * ($v - $vmin) / ($vmax - $vmin)
+;
} ;
sub show_rgb {
my ($rgb) = @_ ;
my (undef, $r, $g, $b) = unpack('C*', pack('N', $rgb)) ;
sprintf "(r=%3d g=%3d b=%3d)", $r, $g, $b ;
} ;
sub expectRamp {
my ($v) = @_ ;
my ($r, $g, $b) = (0) x 3;
for my $step (0 .. $v - 1) {
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; }
} ;
return rgb2n($r, $g, $b) ;
} ;
|