Has anybody here played with a program called TextTone? It is a small tool that let you create a toning effect in HTML, by providing a text, a start and an end color. It will then wrap this text up in <font> tags which you can paste into one of your pages.

Well, I thought this would be cool to be able to do in perl, to be able to do it on other platforms than Windows, and also to do it on the fly in a CGI program.

Said and done, here is a small sub that will do exactly this:

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

# text_tone( $text, $start_color, $end_color )
#
# Takes a string $text and tones it from $start_color to $end_color, 
# adding <font> tags around each character. Returns the toned string.
# 
# Known "bug": Does not handle special characters such as &ouml; or &#
+255;
# Should be easy to add though.
#
sub text_tone
{
  my ( $text, $start_color, $end_color ) = @_;

  # Regexp to match and capture a 6-digit hex string,
  # with our without a leading '#'.
  my $hex = qr/[0-9a-fA-F]/;
  my $match = qr/^#?($hex{2})($hex{2})($hex{2})$/;

  # Split $start- and $end_color into Red, Green and Blue, 
  # at the same time check so they are valid, in this case,
  # exactly six hexadecimal numbers with a possible leading '#'.
  # $start_colors and $end_colors will hold one "byte" big parts,
  # that is R, G and B.
  # If a match fails, simply returns the original text. Can
  # easily be changed into a warning/error.
  my ( @start_colors ) = $start_color =~ /$match/ or return $text;
  my ( @end_colors ) = $end_color =~ /$match/ or return $text;

  my ( @steps );

  # Convert hex values into decimal, for easier calculations.
  # Compute how big steps there will be between the colors.
  for( 0..2 )
  {
    $start_colors[$_] = hex( $start_colors[$_] );
    $steps[$_] = ( hex( $end_colors[$_] ) - $start_colors[$_] ) / ( le
+ngth( $text ) -1 );
  }

  # This will be our finished "rainbox" text.
  my $rainbow = "";

  # We loop through all the characters, wrapping them in <font> tags
  # to create the toning effect.
  foreach ( split( //, $text ) )
  {
    # Don't waste our time with white space.
    # Will only produce empty font tags.
    if( /\s/ )
    {
      $rainbow .= $_;
    }
    else
    {
      # Put together a hex string from the current permuation of color
+s.
      # We say that we want 2 hex numbers, and pad with zero if too sm
+all,
      # otherwise it will be just one digit sometimes, or padded with 
+space. 
      my $current_color = sprintf( "%02x%02x%02x", @start_colors );

      # Create the <font> tag with the character and color.
      $rainbow .= '<font color="#' . $current_color .'">' . $_ . '</fo
+nt>';
    }

    # Step through the colors.
    for( 0..2 )
    {
      $start_colors[$_] += $steps[$_];
    }
  }

  # return the resulting rainbow string. :)
  return $rainbow;
}
[download]

So, a call like this one:

print &text_tone( "Dog and Pony tries to learn some perl.", "#009966",
+ "#cc3333" );
[download]

Will produce the following:

Dog and Pony tries to learn some perl.

It should really handle HTML escapes too, but that will be for the next version, unless someone here would like a shot at that. :) The trick, as you can see, is to "tone" the R, G, and B parts of the colors independently. There is, as always, more than one way to do this, and since I created the script in PHP first, a few months ago, it probably has suffered some in the translation, possibly making it un-perlish at parts. Feel free to point mistakes out. :)