| Description: |
CGI to create a random "noise" PNG as a background image. Fully configurable through CGI parameters. As an example, see the background image at my own Web site. (Netscape 4 totally screws up my CSS, but that doesn't impact the background image. And Non-CSS-enabled browsers probably can't see it at all. Check out the raw image, instead.)
There are three parameters:
- height: The height of the image (in a background image, set high enough so that the repeat doesn't look too bad).
- widths: The widths of the left gutter, the left border, the primary "noise" section, the right border, and the right gutter, in that order, separated by commas.
- colors: The colors available for each section. Each color within a section is separated by commas; each section is separated by underscores.
Colors are specified as hex triples, HTML-style.
|
#! /usr/local/bin/perl
# davidhand.com
# noise background
# images/noise3.cgi
#
# Created: 2000-1107-1502 David Hand <mailto:davidhand@davidh
+and.com>
# Commented: 2000-1207-1519 David Hand <mailto:davidhand@davidh
+and.com>
# De-Sucked: 2001-0701-2058 David Hand <mailto:davidhand@davidh
+and.com>
#
# Copyright (c) 2000, 2001 David Hand
use strict;
use warnings;
use CGI;
use GD;
use List::Util qw(sum);
#=====================================================================
+========
# Get Parameters
#---------------------------------------------------------------------
+--------
my $request = CGI->new();
my $DELIM_OUT = '_';
my $DELIM_IN = ',';
my $NUMBER_REGEX = "((?:\\d+$DELIM_IN?)+)";
my $HEX_TRIPLE_REGEX = "((?:(?:(?:0x|#)?[A-Fa-f0-9]{6}(?:\\(\\d+\%?
+\\))?$DELIM_IN?)*$DELIM_OUT?)*)";
my $DEFAULT_WIDTHS = "0${DELIM_IN}0${DELIM_IN}100${DELIM_IN}0${DE
+LIM_IN}0";
my $DEFAULT_COLORS = "#FFFFFF${DELIM_OUT}#000000${DELIM_OUT}#FFFF
+FF${DELIM_IN}#000000${DELIM_OUT}#000000${DELIM_OUT}#FFFFFF";
my $DEFAULT_HEIGHT = "100";
my @widths = split (/$DELIM_IN/, &detaint('widths', $request,
$DEFAULT_WIDTHS, $NUMBER_REG
+EX));
my @colors = map ({ [ split /$DELIM_IN/ ]; }
split (/$DELIM_OUT/,
&detaint('colors', $request,
$DEFAULT_COLORS, $HEX_TRIPLE_REGEX
)
)
);
# height parameter
my $height = &detaint('height', $request,
$DEFAULT_HEIGHT, $NUMBER_REGEX);
#=====================================================================
+========
# Process Image
#---------------------------------------------------------------------
+--------
my $image = GD::Image->new( sum(@widths), $height);
foreach my $colorlist (@colors) {
&allocate_colors($image, $colorlist);
}
my $currleft = 0;
my $currright = $widths[1] - 1;
for (my $i = 0; $i < @colors; ++$i) {
$currright += $widths[$i];
&paint_rect($image,
$currleft, 0,
$currright, $height-1,
$colors[$i],
);
$currleft += $widths[$i];
}
# Aww, hell. We've gone to all this work. Might as well spit out the
+ PNG.
binmode STDOUT;
print $request->header(-type=>'image/png');
print $image->png;
#=====================================================================
+========
# Helper Functions
#---------------------------------------------------------------------
+--------
# Get & detaint a CGI param, complete with a default if it's not defin
+ed.
sub detaint
{
my $param = shift;
my $request = shift;
my $default = scalar (@_) ? shift : "";
my $regex = scalar (@_) ? shift : "";
my $return = "";
if (defined ($return = $request->param($param))) {
($return) = $return =~ /$regex/;
return $return;
} else {
return $default;
}
}
# It's important to register your colors, in an indexed color format.
# The trick here is that we don't want to register a color that's
# already been registered.
sub allocate_colors
{
my ($image, $colors_ref) = @_;
my $candidate;
foreach my $hex (@{$colors_ref}) {
if (($candidate = $image->colorExact(&hex2rgb($hex)))
+== -1) {
$hex = $image->colorAllocate(&hex2rgb($hex));
} else {
$hex = $candidate;
}
}
return;
}
# Paint a rectangle. If we're painting with a single color, don't go
# to the extra effort of calculating a random number, or of painting
# pixel-by-pixel.
sub paint_rect
{
my $image = shift;
my $x1 = shift; my $y1 = shift;
my $x2 = shift; my $y2 = shift;
my $colors_ref = shift;
my $colorcount = scalar @{$colors_ref};
return if $x2 <= $x1; # refuse to create a zero- or negative-
+size box
return if $y2 <= $y1;
if ($colorcount == 1) {
$image->filledRectangle($x1, $y1, $x2, $y2, $colors_re
+f->[0]);
} else {
for (my $x = $x1; $x <= $x2; $x++) {
for (my $y = $y1; $y <= $y2; $y++) {
$image->setPixel(
$x, $y,
$colors_ref->[int(rand($color
+count))]
);
}
}
}
return;
}
# convert an HTML-style hexidecimal to a decimal triplet
sub hex2rgb
{
my $hex = shift;
$hex =~ s/^(0x|#)//;
my $temp = pack('H6', $hex); # pack the hex into raw binary
my @rgb = unpack('C3', $temp); # unpack the binary into a tri
+ple
if (wantarray) {
# if we want an array, do what this program was
# originally intended to do
return @rgb;
} else {
# if the user asks for a scalar, give her something
# useful, rather than a constant 3 (the length of the
# above array, in all situations).
# luminance calculation from _Grokking the GIMP_, p. 1
+52
my $luminance = $rgb[0]*0.3 + $rgb[1]*0.59 + $rgb[2]*0
+.11;
return $luminance;
}
}
# convert a decimal triplet to an HTML-style hexidecimal
# YEAH, I KNOW: this isn't called anywhere. I just figured I'd put i
+t
# in, since I'd put in the inverse function. Don't know where to pu
+t
# them, permanently, so this'll do for now.
sub rgb2hex
{
my @rgb = @_[0..2];
my $temp = pack('CCC', @rgb); # pack the triple into raw bin
+ary
my $hex = unpack('H6', $temp); # unpack the binary into hex f
+ormat
return $hex;
}
|
