diff options
author | giraffedata <giraffedata@9d0c8265-081b-0410-96cb-a4ca84ce46f8> | 2023-06-28 17:21:21 +0000 |
---|---|---|
committer | giraffedata <giraffedata@9d0c8265-081b-0410-96cb-a4ca84ce46f8> | 2023-06-28 17:21:21 +0000 |
commit | 0d513aca5cbbb8db0a9d127e101ac3b534cc8bf0 (patch) | |
tree | 3e8db9f13fb33464324c6986e7d80540a42a86c7 /editor/ppmshadow | |
parent | 7dd37058c4c8e0f6ca272e329162a52f958e4951 (diff) | |
download | netpbm-mirror-0d513aca5cbbb8db0a9d127e101ac3b534cc8bf0.tar.gz netpbm-mirror-0d513aca5cbbb8db0a9d127e101ac3b534cc8bf0.tar.xz netpbm-mirror-0d513aca5cbbb8db0a9d127e101ac3b534cc8bf0.zip |
promote Stable to Super Stable
git-svn-id: http://svn.code.sf.net/p/netpbm/code/super_stable@4557 9d0c8265-081b-0410-96cb-a4ca84ce46f8
Diffstat (limited to 'editor/ppmshadow')
-rwxr-xr-x | editor/ppmshadow | 134 |
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'"); |