Chained Gradients

By Mr. Muskrat on December 9, 2010 3:46 AM

Earlier I replied to Ovid’s post Perl101: Red to Green Gradient about how to create a gradient that is closer to being accurate. (Rafaël had pointed out that Ovid’s didn’t properly deal with hue and intensity.) The problem with the more accurate approach is that Ovid wanted one that shifted from red to yellow to green and my version did not do that.

So I give you a better (although still not 100% accurate) solution. It has not yet been optimized. It may have bugs. Your mileage may vary. Some conditions and limitations may apply. Yadda yadda yadda.

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw( min max );

my $red     = [ 0xFF, 0x00, 0x00 ];
my $yellow  = [ 0xFF, 0xFF, 0x00 ];
my $green   = [ 0x00, 0xFF, 0x00 ];
my $cyan    = [ 0x00, 0xFF, 0xFF ];
my $blue    = [ 0x00, 0x00, 0xFF ];
my $magenta = [ 0xFF, 0x00, 0xFF ];

my $steps = 16;

#my $colors = chained_gradients( $steps * 3, $red, $green, $blue ); # change me!
my $colors = chained_gradients( $steps * 2, $red, $yellow, $green ); # change me!
#my $colors = chained_gradients( $steps, $red, $green ); # change me!

open my $html, '>', 'colors.html';
print $html "<html><head><title>colors</title></head><body><table>\n";
for my $color ( @{ $colors } )
{
    printf "%02X%02X%02X  [ %1\$3s, %2\$3s, %3\$3s ]  h: %3s, s: %3s, v: %3s\n", @{ $color }, @{ to_hsv( $color ) };
    printf $html qq{<tr><td style="background-color:#%02X%02X%02X">%1\$02X%2\$02X%3\$02X</td></tr>\n}, @{ $color };
}
print $html "</table></body></html>\n";
close $html;

sub step
{
    my ( $steps, $first, $last ) = @_;

    $steps--;

    my $sign = $last <=> $first;
    my $step = $first == $last ? 0 : int( ( $first + $last ) / $steps );

    return $sign == 0 ? $step : $sign * $step;
}

sub gradient
{
    my ( $steps, $first, $last ) = @_;

    my $step = [ 
    step( $steps, $first->[0], $last->[0] ), 
    step( $steps, $first->[1], $last->[1] ), 
    step( $steps, $first->[2], $last->[2] ),
    ];

    my $gradients = [ ( undef ) x $steps ];
    for my $curr ( 0 .. $#{ $gradients } )
    {
    my $prev = $curr - 1;
    if ( $curr == 0 )
    {
        $gradients->[$curr] = $first;
    }
    elsif ( $curr == $#{ $gradients } )
    {
        $gradients->[$curr] = $last;
    }
    else
    {
        $gradients->[$curr] = [ 
            $gradients->[$prev][0] + $step->[0], 
            $gradients->[$prev][1] + $step->[1], 
            $gradients->[$prev][2] + $step->[2],
        ];
    }
    }

    return $gradients;
}

sub chained_gradients
{
    my ( $steps, @colors ) = @_;

    my $max = $#colors;
    $steps = int( $steps / $max );
    my $sections = $#colors - 1;

    my @gradients;
    while ( @colors >= 2 )
    {
    my $start = shift @colors;
    my $end = $colors[0];
    my $step = ( @colors == $max ) ? $steps + 1 : $steps;

    push @gradients, gradient( $step, $start, $end );
    }

    for my $curr ( 1 .. $sections )
    {
    my $prev = $curr - 1;
    my $ndx = ( $curr == 1 ) ? $steps : $steps - 1;
    if (
        $gradients[$curr]->[0][0] == $gradients[$prev]->[$ndx][0] &&
        $gradients[$curr]->[0][1] == $gradients[$prev]->[$ndx][1] &&
        $gradients[$curr]->[0][2] == $gradients[$prev]->[$ndx][2]
    )
    {
        $#{ $gradients[$prev] }--;
    }
    }

    my $gradients;
    for my $i ( 0 .. $max )
    {
    my $grad = $gradients[$i];
    for my $j ( 0 .. $#{ $grad } )
    {
        push @{ $gradients }, $grad->[$j];
    }
    }

    return $gradients;

}

# Algorithm found at http://www.cs.rit.edu/~ncs/color/t_convert.html
sub to_hsv 
{
    my $color = shift;
    my ( $h, $s, $v );

    my $min = min( @{ $color } );
    my $max = max( @{ $color } );

    $v = int( ( $max / 255 ) * 100 );

    my $delta = $max - $min;

    if ( $max == 0 )
    {
    # red = green = blue = 0 
    # s = 0, v is undef
    $s = 0;
    $h = -1;
    }
    else
    {
    $s = int( ( $delta / $max ) * 100 );

    if ( $color->[0] == $max )
    {
        $h = ( $color->[1] - $color->[2] ) / $delta; # between yellow & magenta
    }
    elsif ( $color->[1] == $max )
    {
        $h = 2 + ( $color->[2] - $color->[0] ) / $delta; # between cyan & yellow
    }
    else
    {
        $h = 4 + ( $color->[0] - $color->[1] ) / $delta; # between magenta & cyan
    }

    $h = int ( $h * 60 ); # degrees

    if ( $h < 0 )
    {
        $h += 360;
    }

    }

    return [ $h, $s, $v ];
}

It will print out the hex, RGB and HSV values for the colors you pass into chained_gradients. It also creates a very basic HTML file containing a table of your colors.

Here’s the output.

FF0000  [ 255,   0,   0 ]  h:   0, s: 100, v: 100
FF0F00  [ 255,  15,   0 ]  h:   3, s: 100, v: 100
FF1E00  [ 255,  30,   0 ]  h:   7, s: 100, v: 100
FF2D00  [ 255,  45,   0 ]  h:  10, s: 100, v: 100
FF3C00  [ 255,  60,   0 ]  h:  14, s: 100, v: 100
FF4B00  [ 255,  75,   0 ]  h:  17, s: 100, v: 100
FF5A00  [ 255,  90,   0 ]  h:  21, s: 100, v: 100
FF6900  [ 255, 105,   0 ]  h:  24, s: 100, v: 100
FF7800  [ 255, 120,   0 ]  h:  28, s: 100, v: 100
FF8700  [ 255, 135,   0 ]  h:  31, s: 100, v: 100
FF9600  [ 255, 150,   0 ]  h:  35, s: 100, v: 100
FFA500  [ 255, 165,   0 ]  h:  38, s: 100, v: 100
FFB400  [ 255, 180,   0 ]  h:  42, s: 100, v: 100
FFC300  [ 255, 195,   0 ]  h:  45, s: 100, v: 100
FFD200  [ 255, 210,   0 ]  h:  49, s: 100, v: 100
FFE100  [ 255, 225,   0 ]  h:  52, s: 100, v: 100
FFFF00  [ 255, 255,   0 ]  h:  60, s: 100, v: 100
EEFF00  [ 238, 255,   0 ]  h:  64, s: 100, v: 100
DDFF00  [ 221, 255,   0 ]  h:  68, s: 100, v: 100
CCFF00  [ 204, 255,   0 ]  h:  72, s: 100, v: 100
BBFF00  [ 187, 255,   0 ]  h:  76, s: 100, v: 100
AAFF00  [ 170, 255,   0 ]  h:  80, s: 100, v: 100
99FF00  [ 153, 255,   0 ]  h:  84, s: 100, v: 100
88FF00  [ 136, 255,   0 ]  h:  88, s: 100, v: 100
77FF00  [ 119, 255,   0 ]  h:  92, s: 100, v: 100
66FF00  [ 102, 255,   0 ]  h:  96, s: 100, v: 100
55FF00  [  85, 255,   0 ]  h: 100, s: 100, v: 100
44FF00  [  68, 255,   0 ]  h: 104, s: 100, v: 100
33FF00  [  51, 255,   0 ]  h: 108, s: 100, v: 100
22FF00  [  34, 255,   0 ]  h: 112, s: 100, v: 100
11FF00  [  17, 255,   0 ]  h: 116, s: 100, v: 100
00FF00  [   0, 255,   0 ]  h: 120, s: 100, v: 100

Here’s the HTML table that it generated.

FF0000

FF0F00

FF1E00

FF2D00

FF3C00

FF4B00

FF5A00

FF6900

FF7800

FF8700

FF9600

FFA500

FFB400

FFC300

FFD200

FFE100

FFFF00

EEFF00

DDFF00

CCFF00

BBFF00

AAFF00

99FF00

88FF00

77FF00

66FF00

55FF00

44FF00

33FF00

22FF00

11FF00

00FF00

2 comments

2 Comments

leonerd | December 9, 2010 5:19 PM | Reply

You may or maynot be aware of Convert::Color, but that makes the above program rather much simpler:

#!/usr/bin/perl

use strict;

use warnings;

use Convert::Color;

my $steps = 32;

my @start = Convert::Color->new( "rgb8:ff0000" )->as_hsv->hsv;

my @end   = Convert::Color->new( "rgb8:00ffff" )->as_hsv->hsv;

print qq[\n];

foreach ( 0 .. $steps ) {

   my $alpha = $_ / $steps;

   my $col = Convert::Color->new( "hsv:" . join ",", map { (1-$alpha) * $start[$_] + $alpha * $end[$_] } 0 .. 2 );

   my $hex = $col->as_rgb8->hex;

   printf qq[#%s\n], $hex, $hex;

print qq[\n];

This is just two points at either end of a gradient, but it should be a fairly simple extension task to allow more than two points anchored at some value between 0 and 1, and to alpha-blend accordingly. It does however give a "wrong" result in that case. A more correct way to alpha-blend two points in HSL or HSV space would be to put them somewhere in the cylindrical or (bi-)conic space implied, and interpolate along a path there.

Mr. Muskrat | December 9, 2010 8:49 PM | Reply

Hi Paul.

Yes, I am aware of Convert::Color. I started with Ovid's code and it was supposed to just be a quick hack. After a few iterations, I ended up with what you see above. Had I realized up-front how involved it would end up, I probably would have used one of the many fine color modules from CPAN but then again, I wouldn't have learned how to translate RGB to HSV. (That's something that was already on my to do list.)

Looking back at the original thread, Ovid has received some additional comments that are also enlightening.

Name

Email Address

URL

Remember personal info?

Comments (You may use HTML tags for style)

About Mr. Muskrat

I'm married with 2 girls. By day, I work as a Senior Design Engineer (full time Perl programmer) for EFJohnson Technologies, a Land Mobile Radio company, in the Dallas/Fort Worth area. By night, I play various games as the mood strikes me. (Lately it's CPAN smoke testing.)

More info »

Mr. Muskrat