Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

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
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;
}

Comment on random noise background generator
Download Code
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 www.spidertube.com 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

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (6)
As of 2014-09-20 09:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (158 votes), past polls