#!/usr/bin/perl #By Ben Jacobs 2001 # "Use": Colors a string with a gradient. The user inputs #the string and two colors in hexedcimal. # Comments welcome, I know this isn't a very efficient #script but it's the best I could come up with. # Update 5/24/01: Fixed a bug in the HTML code. Before there was an # extra Tag that was messing some browsers up # Update 5/23/01: You can now see this script in action at # http://dooberwah.perlmonk.org/cgi-bin/gradient.pl. # Update 5/22/01: Added in the use of the abs function instead # of writing my own function to do the exact same thing. use strict; #use warnings; use CGI; sub hexify { my $red = shift; my $green = shift; my $blue = shift; my $hexed = sprintf("%.2x%.2x%.2x", $red, $green, $blue); } sub color { my $string = shift; my $FromColor = shift; my $ToColor = shift; my @letters = split //, $string; my ($fromR, $fromG, $fromB) = $FromColor =~/(\w{2})(\w{2})(\w{2})/; my ($toR, $toG, $toB) = $ToColor =~ /(\w{2})(\w{2})(\w{2})/; $fromR = hex($fromR); $toR = hex($toR); $fromG = hex($fromG); $toG = hex($toG); $fromB = hex($fromB); $toB = hex($toB); my $rstep; my $gstep; my $bstep; $rstep = abs($fromR - $toR) / length($string); $gstep = abs($fromG - $toG) / length($string); $rstep = abs($fromB - $toB) / length($string); my $happystring; my $r; my $g; my $b; foreach my $letter (@letters) { if($r == 1) { $fromR -= $rstep; } else { $fromR += $rstep; } if($g == 1) { $fromG -= $rstep; } else { $fromG += $gstep; } if($b == 1) { $fromB -= $bstep; } else { $fromB += $bstep; } if ( $fromR > 255) { $r = 1; }elsif ( $fromR < 0) { $r = 0; } if ( $fromG > 255) { $g = 1; }elsif ( $fromG < 0) { $g = 0; } if ( $fromB > 255) { $b = 1; }elsif ( $fromB < 0) { $b = 0; } my $hexcolors = hexify($fromR, $fromG, $fromB); $happystring .= "$letter"; } $happystring; } my %input = CGI::Vars(); my $string = %input->{'string'}; my $fromcolor = %input->{'fromcolor'}; my $tocolor = %input->{'tocolor'}; print "Content type: text/html\n\n"; print "Text Gradient\n"; print "\n"; print "
\n"; print "String
\n"; print "FromColor
\n"; print "ToColor
\n"; print "\n"; print "
\n"; print color($string, $fromcolor, $tocolor) . "
\n"; print "\n";