diff options
author | giraffedata <giraffedata@9d0c8265-081b-0410-96cb-a4ca84ce46f8> | 2006-08-19 03:12:28 +0000 |
---|---|---|
committer | giraffedata <giraffedata@9d0c8265-081b-0410-96cb-a4ca84ce46f8> | 2006-08-19 03:12:28 +0000 |
commit | 1fd361a1ea06e44286c213ca1f814f49306fdc43 (patch) | |
tree | 64c8c96cf54d8718847339a403e5e67b922e8c3f /editor/ppmshadow | |
download | netpbm-mirror-1fd361a1ea06e44286c213ca1f814f49306fdc43.tar.gz netpbm-mirror-1fd361a1ea06e44286c213ca1f814f49306fdc43.tar.xz netpbm-mirror-1fd361a1ea06e44286c213ca1f814f49306fdc43.zip |
Create Subversion repository
git-svn-id: http://svn.code.sf.net/p/netpbm/code/trunk@1 9d0c8265-081b-0410-96cb-a4ca84ce46f8
Diffstat (limited to 'editor/ppmshadow')
-rwxr-xr-x | editor/ppmshadow | 273 |
1 files changed, 273 insertions, 0 deletions
diff --git a/editor/ppmshadow b/editor/ppmshadow new file mode 100755 index 00000000..2a32fca0 --- /dev/null +++ b/editor/ppmshadow @@ -0,0 +1,273 @@ +#!/usr/bin/perl -w + +# P P M S H A D O W + +# 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; +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 getDimensions($) { + my ($fileName) = @_; +#----------------------------------------------------------------------------- +# Return the dimensions of the Netpbm image in the named file +#----------------------------------------------------------------------------- + my ($width, $height); + my $pamfileOutput = `pamfile $fileName`; + if ($pamfileOutput =~ m/.*\sP[BGP]M\s.*,\s*(\d*)\sby\s(\d*)/) { + ($width, $height) = ($1, $2); + } else { + die("Unrecognized output from 'pamfile' shell command"); + } + return ($width, $height); +} + + +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 +############################################################################## + + +my $tmpdir = $ENV{TMPDIR} || "/tmp"; +my $ourtmp = "$tmpdir/ppmshadow$$"; +mkdir($ourtmp, 0777) or + die("Unable to create directory for temporary files '$ourtmp"); + +# 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 { + if (defined $ifile) { + die("Duplicate input file specification."); + } + $ifile = $arg; + } +} + +# 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) = getDimensions($infile); + +# Create an all-background-color image (same size as original image) + +my $backgroundfile = "$ourtmp/background.ppm"; +system("pamcut -left=0 -top=0 -width=1 -height=1 $infile | " . + "pamscale -xsize=$sourceImageWidth " . + "-ysize=$sourceImageHeight >$backgroundfile"); + +# Create mask file for background. It is white wherever there is background +# image in the input. + +my $bgmaskfile = "$ourtmp/bgmask.pbm"; +system("pamarith -difference $infile $backgroundfile | pnminvert | ppmtopgm " . + "| pgmtopbm -thresh -value 1.0 >$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 $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 255 $bgmaskfile | " . + "pnmconvol $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; + +# Make mask for foreground + +my $fgmaskfile = "$ourtmp/fgmask.pbm"; +open(STDIN, "<$bgmaskfile") or die(); +open(STDOUT, ">$fgmaskfile") or die(); +system("pnminvert"); + +# Make image which is just foreground; rest is black. + +my $justfgfile = "$ourtmp/justfg.ppm"; +open(STDOUT, ">$justfgfile") or die(); +system("pamarith", "-multiply", $infile, $fgmaskfile); + +unlink($fgmaskfile) unless $keeptemp; +unlink($infile) 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; + +# Knock out (make black) foreground area + +my $allbutfgfile = "$ourtmp/allbutfg.ppm"; +open(STDOUT, ">$allbutfgfile") or die(); +system("pamarith", "-multiply", $shadbackfile, $bgmaskfile); + +unlink($shadbackfile) unless $keeptemp; +unlink($bgmaskfile) unless $keeptemp; + +# Place foreground in blacked out area, send to original Standard Output. + +open(STDOUT, ">&OLDOUT"); + +system("pamarith", "-add", $justfgfile, $allbutfgfile); +unlink($justfgfile) unless $keeptemp; +unlink($allbutfgfile) unless $keeptemp; + +if (!$keeptemp) { + rmdir($ourtmp) or die ("Unable to remove temporary directory '$ourtmp'"); +} |