ColorRamp1785

[BrowserUk]

A while ago I had need of a color ramp and found one on-line which I implemented in Perl and have made regular use of since.

However, that ramp only allows a maximum of 1021 distinct colors, (four edges of the 24-bit color cube with 3 shared values), and I recently had the need of more. So I extended the ramp to start at black and transition to white: black->blue->cyan->green->yellow->red->magenta->white thus transitioning 7 edges of the color cube giving me 1785 distinct colors.

Update: seems I did a piss poor job of extracting the code below from the application where I used it, and attempting to generalise it. I believe I've corrected that now.

The color ramp sub and data table:

sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }

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 {
        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;
    }
}

A simple GD app that uses it to produce a png that displays the full range of the color ramp and the transitions:

#! perl -slw
use strict;
use GD;
use GD::Polygon;

sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }

my $tri = GD::Polygon->new;
$tri->addPt( @$_  ) for [ 0, 0 ], [ -9, 16 ], [ 9, 16 ], [ 0, 0 ];
$tri->offset( 0, 132 );

my $img = GD::Image->new( 1784, 151, 1 );
$img->filledRectangle( 0, 0, 1784, 150, rgb2n( (128) x 3 ) );

my( $r, $g, $b ) = (0) x 3;
for my $step ( 0 .. 1784 ) {
    $img->line( $step, 0, $step, 98, colorRamp1785( $step, 0, 1784 ) )
+;

    $img->line( $step, 100, $step, 109, rgb2n( $r,  0,  0 ) );
    $img->line( $step, 111, $step, 119, rgb2n(  0, $g,  0 ) );
    $img->line( $step, 121, $step, 129, rgb2n(  0,  0, $b ) );

    unless( grep{ $_ != 0 and $_ != 255 } $r, $g, $b ) {
        $img->filledPolygon( $tri, rgb2n( $r, $g, $b ) );
        $tri->offset( 255, 0 );
    }

    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; }

}
$img->filledPolygon( $tri, rgb2n( (255) x 3 ) );

open PNG, '>:raw', "colorRamp.png" or die $!;
print PNG $img->png;
close PNG;

system 'colorRamp.png';


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 {
        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;
    }
}

__END__
                        R       G       B
black   -> blue         0       0       0..255      256
blue    -> cyan         0       0..255  255         512
cyan    -> green        0       255     255..0      768
green   -> yellow       0..255  255     0          1024
yellow  -> red          255     255..0  0          1280
red     -> magenta      255     0       0..255     1536
magenta -> white        255     0..255  255         256

[Lawliet]

my @map = sort{ $a <=> $::b } keys %map;

Why bother using $::b? I thought it was just shorthand for $main::b (and $::main::b and so on :P).

[BrowserUk]

Because I'm using my $b for one of the rgb triple, and without the ::, perl will see that and attempt to use it instead of $::b, and fail with Can't use "my $b" in sort comparison. I guess I should have used $::a for balance--and now have.

[Lawliet]

Oh, I see. Thanks for explaining it to me (",)

(And you should update the lone subroutine at the top of the node too). Err, you did while I was posting :P