Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Web Color Spectrum Generator

by extremely (Priest)
on Apr 06, 2001 at 21:01 UTC ( #70521=sourcecode: print w/ replies, xml ) Need Help??

Category: HTML Utility
Author/Contact Info Mark Mills <extremely+pm@hostile.org> http://www.hostile.org/
Description: This is a simple little color generator much like the ones discussed in this node Shading with HTML colors - color_munge. This one can do spectral rotation from red to green to blue without shifting brightness or can do all kinds of wacky color shifts. It can go thru the spectrum in either direction too. I'll post the code on my website too, and maybe even a CGI that you can tinker with. As a bonus I'll put up the original code for you to laugh at on the site this weekend.
#!/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 con
+version
# 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 c
+olor
# values. If $col1 had a "#" preceding it, so will all the output valu
+es.
#
# 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 g
+rey
        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 );
}

Comment on Web Color Spectrum Generator
Download Code
Re: Web Color Spectrum Generator
by grinder (Bishop) on Apr 11, 2001 at 12:26 UTC

    Oh, this reminds me of this.

    I would only suggest encapsulating the various mathematical constants such as

    use constant PI => 4 * atan2(1,1);

    --
    g r i n d e r

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (6)
As of 2014-09-01 23:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (18 votes), past polls