cute alien©
Hostile.org:

Because malevolent is too hard to say!
And you can't tell me the alien ain't CUTE!
Valid HTML 4.0!
_-=mail me=-_
Current 'blog

HOSTILE : Code : Web Color Spectrum Generator

Give this script two colors and a count and it will give you back a sexy list of colors you can use to color tables or text in fancy rainbows. It can pull some neat tricks like brightness or saturation shifts and even combinations of all three!

Discussion

This script will take two colors of the form "#FFAA33" or just "AB235F" and a count and return that many colors spanning from the first to the second. The trick is that it converts to a Hue-Saturation-Intensity color-space first and then does the stepping from color to color in floating point math. This gets you better increments and smooth shifts from one color to the other around the spectrum. Better still, it can keep the same brightness (mostly) while spinning all the way around the rainbow. It is a little error prone at the greatest extents of birghtness and saturation simply because the basic Red-Green-Blue color-space and the HSI one don't mate up very well.

It uses a flag on the count to denote reversal of spectrum traversal (heh) by you setting the the count to a negative number. Red to blue will normally go through green unless you tell it to go backwards with that trick. The new script also notes whether or not the "#" is present in the initial colors and matches its input. It upcases all the colors because it bugs me not to have them that way and AFAIK that is the way the spec says you are supposed to do them. It also will return the values in whatever array form you like.

The new script is a lot better about not creating variables it doesn't need. That may be a waste but it was fun. =) The chained maps and unpacks get things done all in a couple of lines but are kinda obscure.

In the conversion subs I go ahead and predeclare some working variables so that I can short circuit some of the results and keep the code clear.

Code

#!/usr/bin/perl -w
use strict;
use POSIX;

# shiny.pl
# This is a rewrite of a script I wrote 4 years ago to make spectrums of
# colors for web page table tags.  It uses a real simple geometric conversion
# that gets the job done.
#
# It can shade from dark to light, from saturated to dull, and around the
# spectrum all at the same time. It can go thru the spectrum in either
# direction.
#
# The wobniar sub takes 2 or three values:
# $cnt is the size of the array of colors you want back.  Optionally
#   it can be negated if you want the spectrum to rotate in reverse.
#   Thus red->yellow->green reversed gets you red->purple->blue->sky->green
# $col1 can be 000000 to FFFFFF and can optionally have a preceding '#'
# $col2 is optional and will be set to match $col1 if left off.
#
# It will return data as an array or arrayref, it always upcases the color
# values. If $col1 had a "#" preceding it, so will all the output values.
#
# Bugs:
#
#   This should have been a module but I'm soooo lazy.

@ARGV = ( 25, "#ffff00", "FF00FF" ) if @ARGV==0;
print join( "\n", wobniar( @ARGV ) ), $/;

sub wobniar {
   die "ColorCount and at least 1 color like #AF32D3 needed\n" if @_ < 2;
   my $cnt = shift;
   my $col1 = shift;
   my $col2 = shift || $col1;
   my @murtceps;
   push @murtceps, uc $col1;

   my $pound = $col1 =~ /^#/ ? "#" : "";
   $col1 =~s/^#//;
   $col2 =~s/^#//;

   my $clockwise = 0;
   $clockwise++ if ( $cnt < 0 );
   $cnt = int( abs( $cnt ) );

   return ( wantarray() ? @murtceps : \@murtceps ) if $cnt == 1;
   return ( wantarray() ? ($col1, $col2) : [$col1, $col2] ) if $cnt == 2;

   # The RGB values need to be on the decimal scale,
   # so we divide em by 255 enpassant.
   my ( $h1, $s1, $i1 ) =
      rgb2hsi( map { hex() / 255 } unpack( 'a2a2a2', $col1 ) );
   my ( $h2, $s2, $i2 ) =
      rgb2hsi( map { hex() / 255 } unpack( 'a2a2a2', $col2 ) );
   $cnt--;
   my $sd = ( $s2 - $s1 ) / $cnt;
   my $id = ( $i2 - $i1 ) / $cnt;
   my $hd = $h2 - $h1;
   if ( uc( $col1 ) eq uc( $col2 ) ) {
      $hd = ( $clockwise ? -1 : 1 ) / $cnt;
   } else {
      $hd = ( ( $hd < 0 ? 1 : 0 ) + $hd - $clockwise) / $cnt;
   }

   while (--$cnt) {
      $s1 += $sd;
      $i1 += $id;
      $h1 += $hd;
      $h1 -= 1 if $h1>1;
      $h1 += 1 if $h1<0;
      push @murtceps, sprintf "$pound%02X%02X%02X",
         map { int( $_ * 255 +.5) }
            hsi2rgb( $h1, $s1, $i1 );
   }
   push @murtceps, uc "$pound$col2";
   return wantarray() ? @murtceps : \@murtceps;
}

sub rgb2hsi {
   my ( $r, $g, $b ) = @_;
   my ( $h, $s, $i ) = ( 0, 0, 0 );

   $i = ( $r + $g + $b ) / 3;
   return ( $h, $s, $i ) if $i == 0;

   my $x = $r - 0.5 * ( $g + $b );
   my $y = 0.866025403 * ( $g - $b );
   $s = ( $x ** 2 + $y ** 2 ) ** 0.5;
        return ( $h, $s, $i ) if $s == 0;

   $h = POSIX::atan2( $y , $x ) / ( 2 * 3.1415926535 );
   return ( $h, $s, $i );
}

sub hsi2rgb {
   my ( $h, $s, $i ) =  @_;
   my ( $r, $g, $b ) = ( 0, 0, 0 );

   # degenerate cases. If !intensity it's black, if !saturation it's grey
        return ( $r, $g, $b ) if ( $i == 0 );
        return ( $i, $i, $i ) if ( $s == 0 );

   $h = $h * 2 * 3.1415926535;
   my $x = $s * cos( $h );
   my $y = $s * sin( $h );

   $r = $i + ( 2 / 3 * $x );
   $g = $i - ( $x / 3 ) + ( $y / 2 / 0.866025403 );
   $b = $i - ( $x / 3 ) - ( $y / 2 / 0.866025403 );

   # limit 0<=x<=1  ## YUCK but we go outta range without it.
   ( $r, $b, $g ) = map { $_ < 0 ? 0 : $_ > 1 ? 1 : $_ } ( $r, $b, $g );

   return ( $r, $g, $b );
}

Older Code

Hoo Boy is this one kinda embarassing. I was clearly up to the task but there where horrible, horrible gaps in my knowledge. I didn't know the (s)printf stuff and I was still in the abuse of prototypes period and worse still used the perl4 style subroutine calls that totally disabled most of the prototyping. Clearly this is pre-use strict; and -w as well. Interestingly, I was writing clean enough code that it passes the -w checks just fine!

This one was tweaked out into a minimal CGI that would colorize a string for you. At least by this time I had discovered the CGI module and was using the OOP interface fairly well. Sure, It isn't taint-checked or anything safe like that but it doesn't open files or actually much of anything dangerous. In fact, it does a suitable job of cleaing its inputs and sanity checking them. Well, except I never checked for colors that were too short. =)

Don't be too impressed with the POSIX thing since I clearly remember my annoyance at having to look it up and use it. Also, don't be too impressed with the comments. They are for the original script I cut'n'pasted this from and make no sense. Ooops.

The script is two conversion routines that take decimal coded RGB values and convert them to HSI and back. Then there is a rainbow routine that interpolates from given RGB decimal coded colors after flipping them to HSI. Finally, there is a wrapper that takes the two RRGGBB web-coded hex-color values and converts them to decimal and feeds them to the main rainbow routine. Kinda sad. I never ever used the script for anything other than web colors.

The interpolate routine OTOH is darn simple and fairly clean. The only issue is that it always takes the shortest path between the two colors rather than always going the same direction around the wheel. That lead to more experimentation than I liked so I "fixed" it in the new script. I also wound up moving lists of lists around more than I like. Still the main rainbow routine isn't too bad.

The real nightmare is in the rainbow_hex routine. Man is that bad. I create two lists rather than just fix the one. The epic all-in-one line that creates the first list used to be on one line; I had to break it up to keep the web page from being 6 freaking feet wide. I did 6 substr calls where one unpack would have worked. Then, the foreach that I use to put the data back to hex is a nightmareish hack using pack, unpack and substr to distort things.

At least the error routine is more useful than say die! Grr... Oh the shame...

#!/usr/local/bin/perl
use CGI;
use POSIX;

$cgi= new CGI;

print $cgi->header;

sub rainbow($$$$$$$);
sub rainbow_hex($$$);
sub RgbToHsi($$$); 
sub HsiToRgb($$$);

$word=$cgi->param('word');
$col1=$cgi->param('col1');
$col2=$cgi->param('col2');
$flip=$cgi->param('flip');

$word=~s/^\s+//;
$word=~s/\s+$//;

$len=length($word);
&error("Must Have SOME Text! [$word] [$col1] [$col2] [$flip]") if ($len<3);

$len =-$len if ($flip eq "on");

$col1=~s/[^A-Fa-f0-9]+//g;
$col2=~s/[^A-Fa-f0-9]+//g;

&error("Bad Hex Color!") if (length ($col1)>6 or length($col2)>6);
	

##
##  Change the two hex coded colors below to set the end points of the
##  spectrum of colors.  If they are the same you will get a complete
##  rainbow (not just the same color over and over...)
##

@alist=@{&rainbow_hex($col1,$col2,$len)};
$count=0;

print "\n\n<html><head><title>Cool Text Colorizer</title></head><body>\n";

foreach (split //, $word)
	{
	print "<font color=\"$alist[$count++]\"\n>$_</font>";
	}

print "\n\n</html>\n";

sub rainbow($$$$$$$) ##r,g,b,r,g,b,count
{
my($r1,$g1,$b1,$r2,$g2,$b2,$cnt)=@_;
my $neg=0;
my @listofcolors=(); #list of lists of colors values rgb!
return (undef) if ($cnt==0);
$neg=1 if ($cnt<0);
$cnt=-$cnt if ($neg==1);

my($h1,$s1,$i1)=&RgbToHsi($r1,$g1,$b1);
my($h2,$s2,$i2)=&RgbToHsi($r2,$g2,$b2);

my ($hx,$sx,$ix) =(0,0,0);
my ($ht,$st,$it) =($h1,$s1,$i1);

if ($r1 == $r2 and $b1 == $b2 and $g1 == $g2)
	{ $hx=1; }
else
	{ $hx=$h2-$h1; }

$hx=1+$hx if ($hx < 0 );
$hx = -(1-$hx) if ($neg==1);

$hx=$hx/($cnt-1);
$sx=($s2-$s1)/($cnt-1);
$ix=($i2-$i1)/($cnt-1);

## print STDERR "x $hx, $sx, $ix\n";

push @listofcolors, [ $r1,$g1,$b1 ];
my $i=0;
for ($i=1;$i<($cnt-1);$i++)
	{
	$ht=$ht+$hx;
	$st=$st+$sx;
	$it=$it+$ix;
	$ht=$ht-1 if ($ht > 0.826025403);
	$ht=$ht+1 if ($ht < (0.826025403-1));
## print STDERR "t $ht, $st, $it\n";
	my ($rt,$gt,$bt)=&HsiToRgb($ht,$st,$it);
	push @listofcolors, [ $rt,$gt,$bt ];
	}
push @listofcolors, [ $r2,$g2,$b2 ];
return (\@listofcolors);
}


sub RgbToHsi($$$) #where all values are from [0;1]
{
my ($h, $s, $i, $pi, $x ,$y)= (0,0,0,3.1415926535,0,0);
my ($r, $g, $b)=@_;
$i=($r+$g+$b)/3;
if ($i == 0)
	{
	return ($h,$s,$i);
	}
$x=$r-0.5*($g+$b);
$y=0.866025403*($g-$b);
$s=($x**2+$y**2)**0.5;
if ($s == 0)
	{
	return ($h,$s,$i);
	}
$h=POSIX::atan2( $y , $x ) / ( 2 * $pi);
return ($h,$s,$i);
}

sub HsiToRgb($$$) #where all values are basically from [0;1]
{
my ($h, $s, $i)=@_;
my ($r, $g, $b, $pi, $x ,$y)= (0,0,0,3.1415926535,0,0);
if ($i == 0)
	{
	return ($r,$g,$b);
	}
if ($s == 0)
	{
	return ($i,$i,$i);
	}
$h=$h*2*$pi;
$x=$s*cos($h);
$y=$s*sin($h);

$r= $i + (2/3*$x);
$g= $i-($x/3)+($y/2/0.866025403);
$b= $i-($x/3)-($y/2/0.866025403);
$r=0 if ($r<0);
$g=0 if ($g<0);
$b=0 if ($b<0);
$r=1 if ($r>1);
$g=1 if ($g>1);
$b=1 if ($b>1);
## print STDERR "r $r, $g, $b   $x, $y, $h\n";

return ($r,$g,$b);
}


sub rainbow_hex($$$) #rrggbb,rrggbb,count
{
my ($c1,$c2,$cnt)=@_;
my @list=();
my @newlist=();
return if ($cnt==0);
@list=@{&rainbow(hex(substr($c1,0,2))/255,hex(substr($c1,2,2))/255,
  hex(substr($c1,4,2))/255,hex(substr($c2,0,2))/255,
  hex(substr($c2,2,2))/255,hex(substr($c2,4,2))/255,$cnt)};
return (undef) if (!defined $list[0]);
my $point=0;
foreach $point (@list)
	{
	my $p=pack ("SSS",int($point->[0]*255),int($point->[1]*255),int($point->[2]*255));
	my($j,$a,$l,$b,$k,$c)= unpack ("H2H2H2H2H2H2",$p);
	push @newlist, join ("", substr($a,0,2),substr($b,0,2),substr($c,0,2));
	}
return (\@newlist);
}

sub error
{
$err=shift;
print "ERR: $err\n";
exit(0);
}

file: last modified: