JezK
Edit File: ppmshadow
#!/bin/sh ############################################################################## # This is essentially a Perl program. We exec the Perl interpreter specifying # this same file as the Perl program and use the -x option to cause the Perl # interpreter to skip down to the Perl code. The reason we do this instead of # just making /usr/bin/perl the script interpreter (instead of /bin/sh) is # that the user may have multiple Perl interpreters and the one he wants to # use is properly located in the PATH. The user's choice of Perl interpreter # may be crucial, such as when the user also has a PERL5LIB environment # variable and it selects modules that work with only a certain main # interpreter program. # # An alternative some people use is to have /usr/bin/env as the script # interpreter. We don't do that because we think the existence and # compatibility of /bin/sh is more reliable. # # Note that we aren't concerned about efficiency because the user who needs # high efficiency can use directly the programs that this program invokes. # ############################################################################## exec perl -w -x -S -- "$0" "$@" #!/usr/bin/perl ############################################################################## # ppmshadow ############################################################################## # # by John Walker -- http://www.fourmilab.ch/ # version = 1.2; # --> with minor changes by Bryan Henderson to adapt to Netbpm. # See above web site for the real John Walker work, named pnmshadow. # # Bryan Henderson later made some major style changes (use strict, etc) and # eliminated most use of shells. See Netbpm HISTORY file. # # Pnmshadow is a brutal sledgehammer implemented in Perl which # adds attractive shadows to images, as often seen in titles # of World-Wide Web pages. This program does not actually # *do* any image processing--it simply invokes components of # Jef Poskanzer's PBMplus package (which must be present on # the path when this script is run) to bludgeon the source # image into a plausible result. # # This program is in the public domain. # ############################################################################## use strict; use File::Temp; require 5.0; # The good open() syntax, with the mode separate from the file name, # came after 5.0. So did mkdir() with default mode. my $true=1; my $false=0; sub doVersionHack($) { my ($argvR) = @_; my $arg1 = $argvR->[0]; if (defined($arg1) && (($arg1 eq "--version") || ($arg1 eq "-version"))) { my $termStatus = system('pamarith', '--version'); exit($termStatus == 0 ? 0 : 1); } } sub imageDimensions($) { my ($fileName) = @_; #----------------------------------------------------------------------------- # Return the dimensions of the Netpbm image in the file named $fileName. #----------------------------------------------------------------------------- my ($width, $height, $depth); my $pamfileOutput = `pamfile $fileName`; if ($pamfileOutput =~ m/.*\sP[BGP]M\s.*,\s*(\d*)\sby\s(\d*)\s*maxval\s(\d*)/) { ($width, $height, $depth) = ($1, $2, $3); } else { die("Unrecognized output from 'pamfile' shell command"); } return ($width, $height, $depth); } sub backgroundColor($) { my ($fileName) = @_; #----------------------------------------------------------------------------- # Return the color of the background of the image in the file named $fileName. #----------------------------------------------------------------------------- # We call the color of the top left pixel the background color. my $ppmhistOut = qx{pamcut 0 0 1 1 $fileName | ppmhist -noheader -float}; my ($ired, $igrn, $iblu, $lum, $count); if ($ppmhistOut =~ m{\s*([01].\d+)\s*([01].\d+)\s*([01].\d+)\s*([01].\d+)\s*(\d+)}) { ($ired, $igrn, $iblu, $lum, $count) = ($1, $2, $3, $4, $5); } else { die("Unrecognized format of output from 'ppmhist' shell command"); } my $irgb = sprintf("rgbi:%f/%f/%f", $ired, $igrn, $iblu); return $irgb; } sub makeConvolutionKernel($$) { my ($convkernelfile, $ckern) = @_; # Create convolution kernel file to generate shadow open(OF, ">$convkernelfile") or die(); printf(OF "P2\n$ckern $ckern\n%d\n", $ckern * $ckern * 2); my $a = ($ckern * $ckern) + 1; my $i; for ($i = 0; $i < $ckern; $i++) { my $j; for ($j = 0; $j < $ckern; $j++) { printf(OF "%d%s", $a, ($j < ($ckern - 1)) ? " " : "\n"); } } close(OF); } ############################################################################## # MAINLINE ############################################################################## doVersionHack(\@ARGV); # Process command line options my $ifile; # Input file name my ($xoffset, $yoffset); my $convolve = 11; # Default blur convolution kernel size my $keeptemp = $false; # Don't preserve intermediate files my $translucent = $false; # Default not translucent while (@ARGV) { my $arg = shift; if ((substr($arg, 0, 1) eq '-') && (length($arg) > 1)) { my $opt; $opt = substr($arg, 1, 1); $opt =~ tr/A-Z/a-z/; if ($opt eq 'b') { # -B n -- Blur size if (!defined($convolve = shift)) { die("Argument missing after -b option\n"); } if (($convolve < 11) && (($convolve & 1) == 0)) { $convolve++; # Round up even kernel specification } } elsif ($opt eq 'k') { # -K -- Keep temporary files $keeptemp = $true; } elsif ($opt eq 't') { # -T -- Translucent image $translucent = $true; } elsif ($opt eq 'x') { # -X n -- X offset if (!defined($xoffset = shift)) { die("Argument missing after -x option\n"); } if ($xoffset < 0) { $xoffset = -$xoffset; } } elsif ($opt eq 'y') { # -Y n -- Y offset if (!defined($yoffset = shift)) { die("Argument missing after -x option\n"); } if ($yoffset < 0) { $yoffset = -$xoffset; } } else { die("Unknown option '$opt'\n"); } } else { if (defined $ifile) { die("Duplicate input file specification."); } $ifile = $arg; } } # Create temporary directory my $tmpdir = $ENV{TMPDIR} || "/tmp"; my $ourtmp; if ($keeptemp) { $ourtmp = "$tmpdir/ppmshadow$$"; mkdir($ourtmp, 0777) or die("Unable to create directory for temporary files '$ourtmp"); } else { $ourtmp = File::Temp::tempdir("$tmpdir/ppmshadowXXXX", CLEANUP=>1); } # Apply defaults for arguments not specified if (!(defined $xoffset)) { # Xoffset defaults to half the blur distance $xoffset = int($convolve / 2); } if (!(defined $yoffset)) { # Yoffset defaults to Xoffset, however specified $yoffset = $xoffset; } # Save the Standard Output open instance so we can use the STDOUT # file descriptor to pass files to our children. open(OLDOUT, ">&STDOUT"); select(OLDOUT); # avoids Perl bug where it says we never use STDOUT my $infile = "$ourtmp/infile.ppm"; if (defined($ifile) && $ifile ne "-") { open(STDIN, "<$ifile") or die(); } open(STDOUT, ">$infile") or die("Unable to open '$infile' as STDOUT"); system("ppmtoppm"); # You would think we could and should close stdin and stdout now, but if # we do that, system() pipelines later on fail mysteriously. They don't # seem to be able to open stdin and stdout pipes properly if stdin and # stdout didn't already exist. 2002.09.07 BJH my ($sourceImageWidth, $sourceImageHeight, $sourceImageDepth) = imageDimensions($infile); my $bgColorIrgb = backgroundColor($infile); # Create an all-background-color image (same size as original image), # named $backgroundfile. my $backgroundfile = "$ourtmp/background.ppm"; system("ppmmake $bgColorIrgb $sourceImageWidth $sourceImageHeight " . "-maxval $sourceImageDepth " . ">$backgroundfile"); # Create mask file for background, named $bgmaskfile. It is a PBM, white # wherever there is background image in the input. my $bgmaskfile = "$ourtmp/bgmask.pbm"; system("ppmchange -remainder=black $bgColorIrgb white $infile | " . "ppmtopgm | pgmtopbm -threshold -value=0.5 >$bgmaskfile"); my $ckern = $convolve <= 11 ? $convolve : 11; my $convkernelfile = "$ourtmp/convkernel.pgm"; makeConvolutionKernel($convkernelfile, $ckern); if ($translucent) { # Convolve the input color image with the kernel # to create a translucent shadow image. system("pnmconvol -quiet $convkernelfile $infile >$ourtmp/blurred.ppm"); unlink("$convkernelfile") unless $keeptemp; while ($ckern < $convolve) { system("pnmsmooth $ourtmp/blurred.ppm >$ourtmp/convolvedx.ppm"); rename("$ourtmp/convolvedx.ppm", "$ourtmp/blurred.ppm"); ++$ckern; } } else { # Convolve the positive mask with the kernel to create shadow my $blurredblackshadfile = "$ourtmp/blurredblackshad.pgm"; system("pamdepth -quiet $sourceImageDepth $bgmaskfile | " . "pnmconvol -quiet $convkernelfile >$blurredblackshadfile"); unlink($convkernelfile) unless $keeptemp; while ($ckern < $convolve) { my $smoothedfile = "$ourtmp/smoothed.pgm"; system("pnmsmooth $blurredblackshadfile >$smoothedfile"); rename($smoothedfile, $blurredblackshadfile); ++$ckern; } # Multiply the shadow by the background color system("pamarith -multiply $blurredblackshadfile $backgroundfile " . ">$ourtmp/blurred.ppm"); unlink($blurredblackshadfile) unless $keeptemp; } # Cut shadow image down to size of our frame. my $shadowfile = "$ourtmp/shadow.ppm"; { my $width = $sourceImageWidth - $xoffset; my $height = $sourceImageHeight - $yoffset; open(STDIN, "<$ourtmp/blurred.ppm") or die(); open(STDOUT, ">$shadowfile") or die(); system("pamcut", "-left=0", "-top=0", "-width=$width", "-height=$height"); } unlink("$ourtmp/blurred.ppm") unless $keeptemp; # Paste shadow onto background. my $shadbackfile = "$ourtmp/shadback.ppm"; open(STDOUT, ">$shadbackfile") or die(); system("pnmpaste", "-replace", $shadowfile, $xoffset, $yoffset, $backgroundfile); unlink($shadowfile) unless $keeptemp; unlink($backgroundfile) unless $keeptemp; # Create composite file, send to original Standard Output. open(STDOUT, ">&OLDOUT"); system("pamcomp -invert -alpha $bgmaskfile $infile $shadbackfile"); unlink($bgmaskfile) unless $keeptemp; unlink($infile) unless $keeptemp; unlink($shadbackfile) unless $keeptemp; if (!$keeptemp) { rmdir($ourtmp) or die ("Unable to remove temporary directory '$ourtmp'"); }