Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

random noise background generator

by cogent (Monk)
on Dec 08, 2000 at 02:12 UTC ( #45624=sourcecode: print w/replies, xml ) Need Help??
Category: CGI Programming
Author/Contact Info David "cogent" Hand

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

# noise background
# images/noise3.cgi
#        Created: 2000-1107-1502  David Hand  <mailto:davidhand@davidh>
#      Commented: 2000-1207-1519  David Hand  <mailto:davidhand@davidh>
#      De-Sucked: 2001-0701-2058  David Hand  <mailto:davidhand@davidh>
# 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+\%?

my $DEFAULT_HEIGHT      = "100";

my @widths = split (/$DELIM_IN/, &detaint('widths', $request,
                                          $DEFAULT_WIDTHS, $NUMBER_REG
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];
                    $currleft, 0,
                    $currright, $height-1,
        $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
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;


# 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
        } else {
                for (my $x = $x1; $x <= $x2; $x++) {
                        for (my $y = $y1; $y <= $y2; $y++) {
                                         $x, $y,


# 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

        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
                my $luminance = $rgb[0]*0.3 + $rgb[1]*0.59 + $rgb[2]*0
                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
#   in, since I'd put in the inverse function.  Don't know where to pu
#   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
        my $hex = unpack('H6', $temp);  # unpack the binary into hex f

        return $hex;
Replies are listed 'Best First'.
Re: random noise background generator
by quidity (Pilgrim) on Dec 08, 2000 at 06:44 UTC

    Before anyone fails to run this on a windows box, for cross platform usefulness you'll need to modify the following:

    # PNG print $request->header(-type=>'image/png'); print $image->png;

    To be:

    # PNG print $request->header(-type=>'image/png'); binmode STDOUT; print $image->png;

    I like the useles but pretty output though. I remember spending far too much time making QBasic turn an old 386 into a broken TV by using a simillar trick once.

      Hey, good point. Thanks for the input. Change made.

Re: random noise background generator
by Anonymous Monk on Dec 30, 2000 at 04:06 UTC
    Cool...would you like to share your script with us?
      I have no idea why it went away. It's back, now.
      A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (9)
As of 2021-01-20 11:01 GMT
Find Nodes?
    Voting Booth?