December 2010 Archives

Chained Gradients

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

Daily WTF

I often read the “Daily WTF” because there’s something satisfying about seeing other people’s bad code. “See? Our code isn’t as bad as all this!” It’s not as fun when you find “Daily WTF” moments in your codebase.

Today, one of my coworkers asked about a piece of code that wasn’t giving the expected results. It’s a part of some really old code that would be done differently given the time to rewrite it. Any way, there are a series of if/elsif/else clauses that check various things. One of those things is to validate some data against a known constraint. This particular section is supposed to validate that the given data falls within the range of a valid UINT (UINT8, UINT16, etc).

elsif ( $constraint =~ /^UINT(\d+)/ )
{   
    $start = 0;
    $end = ( 0x1 << ( $1 - 1 ) );
}

That looks right, doesn’t it? Maybe… If you just glance at it…

Start with 1 and bit shift it left $1 - 1 times. So if we are validating a UINT8, we take 1 and bit shift it left 7 times which gives us… 128. Uh, that’s not right.

It should be written like this:

elsif ( $constraint =~ /^UINT(\d+)/ )
{   
    $start = 0;
    $end = ( 0x1 << $1 ) - 1;
}

Start with 1 and bit shift it left $1 times and subtract 1. So given a UINT8 again, we take a 1 and bit shift it left 8 times and subtract 1 leaving us with 255. Good.

It might be better if we did away with the bit shifts altogether though and did it using a power of 2 like this instead:

elsif ( $constraint =~ /^UINT(\d+)/ )
{   
    $start = 0;
    $end = 2 ** $1 - 1;
}

I haven’t looked at the commit to see who made this mistake because there’s about a 50/50 chance that it was me.

About Mr. Muskrat

user-pic 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.)