#!/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 backround 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 = chomp($ourtmp = `mktemp -d -t PPMshadow.XXXXXX`);
if($? >> 8) {
die "Can't create directory for temporary files";
}
} else {
$ourtmp = File::Temp::tempdir("$tmpdir/PPMshadow.XXXXXX", UNLINK=>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'");
}