Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

ColorRamp1785

by BrowserUk (Pope)
on Nov 19, 2008 at 06:55 UTC ( #724491=snippet: print w/ replies, xml ) Need Help??

Description:

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


Comment on ColorRamp1785
Select or Download Code
Re: ColorRamp1785
by Lawliet (Curate) on Nov 19, 2008 at 20:11 UTC
    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).

    I'm so adjective, I verb nouns!

    chomp; # nom nom nom

      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.


      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

        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

        I'm so adjective, I verb nouns!

        chomp; # nom nom nom

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://724491]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (6)
As of 2015-07-02 00:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (25 votes), past polls