Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

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.
        am random noise generator i will give you a code beacuase your a background generator pls. make it nice beacuase ant time i save background in my friendster like the background hello kitty it is ugly the background is covered by the picture beacuase i see a background generator in it give me background but it is ugly the backgrounds in my space if im saving a code and after i save it in customize my profile i can not see anything and pls. random noise make it nice as the other backgrounds
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://45624]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2018-01-17 02:18 GMT
Find Nodes?
    Voting Booth?
    How did you see in the new year?

    Results (194 votes). Check out past polls.