1 files changed, 83 insertions, 51 deletions
diff --git a/editor/ppmshadow b/editor/ppmshadow
index 62cdf8b8..ae6b1b0f 100755
--- a/editor/ppmshadow
+++ b/editor/ppmshadow
@@ -48,6 +48,7 @@ exec perl -w -x -S -- "$0" "$@"
 ##############################################################################
 
 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.
@@ -55,22 +56,60 @@ require 5.0;
 my $true=1; my $false=0;
 
 
-sub getDimensions($) {
+
+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 named file
+#  Return the dimensions of the Netpbm image in the file named $fileName.
 #-----------------------------------------------------------------------------
-    my ($width, $height);
+    my ($width, $height, $depth);
     my $pamfileOutput = `pamfile $fileName`;
-    if ($pamfileOutput =~ m/.*\sP[BGP]M\s.*,\s*(\d*)\sby\s(\d*)/) {
-        ($width, $height) = ($1, $2);
+    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);
+    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) = @_;
 
@@ -95,15 +134,10 @@ sub makeConvolutionKernel($$) {
 #                           MAINLINE
 ##############################################################################
 
-
-my $tmpdir = $ENV{TMPDIR} || "/tmp";
-my $ourtmp = "$tmpdir/ppmshadow$$";
-mkdir($ourtmp, 0777) or
-    die("Unable to create directory for temporary files '$ourtmp");
+doVersionHack(\@ARGV);
 
 #   Process command line options
 
-
 my $ifile; # Input file name
 my ($xoffset, $yoffset);
 
@@ -113,6 +147,7 @@ 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);
@@ -142,6 +177,8 @@ while (@ARGV) {
             if ($yoffset < 0) {
                 $yoffset = -$xoffset;
             }
+        } else {
+            die("Unknown option '$opt'\n");
         }
     } else {
         if (defined $ifile) {
@@ -151,6 +188,19 @@ while (@ARGV) {
     }
 }
 
+# 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", UNLINK=>1);
+}
+
 #   Apply defaults for arguments not specified
 
 if (!(defined $xoffset)) {
@@ -181,21 +231,25 @@ system("ppmtoppm");
 # 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);
+my ($sourceImageWidth, $sourceImageHeight, $sourceImageDepth) =
+    imageDimensions($infile);
+
+my $bgColorIrgb = backgroundColor($infile);
 
-#   Create an all-background-color image (same size as original image)
+# Create an all-background-color image (same size as original image),
+# named $backgroundfile. 
 
 my $backgroundfile = "$ourtmp/background.ppm";
-system("pamcut -left=0 -top=0 -width=1 -height=1 $infile | " .
-       "pamscale -xsize=$sourceImageWidth " .
-       "-ysize=$sourceImageHeight >$backgroundfile");
+system("ppmmake $bgColorIrgb $sourceImageWidth $sourceImageHeight " .
+    "-maxval $sourceImageDepth " .
+    ">$backgroundfile");
 
-#   Create mask file for background.  It is white wherever there is background
-#   image in the input.
+# 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("pamarith -difference $infile $backgroundfile | pnminvert | ppmtopgm " .
-       "| pgmtopbm -thresh -value 1.0 >$bgmaskfile");
+system("ppmchange -remainder=black $bgColorIrgb white $infile | " .
+       "ppmtopgm | pgmtopbm -threshold -value=0.5 >$bgmaskfile"); 
 
 my $ckern = $convolve <= 11 ? $convolve : 11;
 
@@ -208,7 +262,7 @@ if ($translucent) {
     #   Convolve the input color image with the kernel
     #   to create a translucent shadow image.
 
-    system("pnmconvol $convkernelfile $infile >$ourtmp/blurred.ppm");
+    system("pnmconvol -quiet $convkernelfile $infile >$ourtmp/blurred.ppm");
     unlink("$convkernelfile") unless $keeptemp;
     while ($ckern < $convolve) {
         system("pnmsmooth $ourtmp/blurred.ppm >$ourtmp/convolvedx.ppm");
@@ -220,8 +274,8 @@ if ($translucent) {
     #   Convolve the positive mask with the kernel to create shadow
  
     my $blurredblackshadfile = "$ourtmp/blurredblackshad.pgm";
-    system("pamdepth -quiet 255 $bgmaskfile | " .
-           "pnmconvol $convkernelfile >$blurredblackshadfile");
+    system("pamdepth -quiet $sourceImageDepth $bgmaskfile | " .
+           "pnmconvol -quiet $convkernelfile >$blurredblackshadfile");
     unlink($convkernelfile) unless $keeptemp;
 
     while ($ckern < $convolve) {
@@ -251,21 +305,6 @@ my $shadowfile = "$ourtmp/shadow.ppm";
 }
 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.
 
@@ -276,22 +315,15 @@ system("pnmpaste", "-replace", $shadowfile, $xoffset, $yoffset,
 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.
+#   Create composite file, send to original Standard Output.
 
 open(STDOUT, ">&OLDOUT");
 
-system("pamarith", "-add", $justfgfile, $allbutfgfile);
-unlink($justfgfile) unless $keeptemp;
-unlink($allbutfgfile) unless $keeptemp;
+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'");