1 files changed, 209 insertions, 0 deletions
diff --git a/editor/pnmquantall b/editor/pnmquantall
new file mode 100755
index 00000000..2f1a3adf
--- /dev/null
+++ b/editor/pnmquantall
@@ -0,0 +1,209 @@
+#!/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
+##############################################################################
+#                                  pnmquantall  
+##############################################################################
+#
+# HISTORY:
+#
+# This was in the original 1989 Pbmplus as a C shell program.  In Netpbm 9.13
+# (April 2001), it was converted to Bash.  (Actually, it was thought to be
+# Bourne shell, but it used arrays).  In Netpbm 10.58 (March 2012), it was
+# converted to Perl for better portability.
+#
+# The 2012 Perl conversion also changed the name from Ppmquantall to
+# Pnmquantall.  It had already handled non-PPM input files for many years.
+#
+# The original program was more complex:  Because in those days Pnmcolormap
+# and Pnmremap did not exist, Ppmquantall concatenated all the input images
+# together and ran Ppmquant (later Pnmquant) on the combination.  It then
+# split the combination image apart to make one output image per input image.
+# Today, Pnmquant is just a combination of Pnmcolormap and Pnmremap, and
+# we are able to use them better separately in Ppmquantall: We still make
+# the combination image, but use it only to compute the colormap with
+# Pnmcolormap.  We then apply that colormap separately to each input image
+# to produce an output image.
+#
+# Bryan Henderson wrote the current version from scratch in March 2012
+# and contributed it to the public domain.
+#
+##############################################################################
+
+use strict;
+use warnings;
+use English;
+use Fcntl;  # gets open flags
+use File::Copy;
+
+my $TRUE=1; my $FALSE = 0;
+
+
+
+sub parseArgs($$$$) {
+    my ($argvR, $extR, $newColorCtR, $fileNamesR) = @_;
+
+    my @argv = @{$argvR};
+
+    my $firstArgPos;
+
+    if (@argv > 0 && $argv[0] eq "-ext") {
+        if (@argv < 2) {
+            print STDERR ("-ext requires a value\n");
+        exit(100);
+        } else {
+            $$extR = $argv[1];
+            $firstArgPos = 2;
+        }
+    } else {
+        $$extR = "";
+        $firstArgPos = 0;
+    }
+
+    if (@argv < $firstArgPos + 2) {
+        print STDERR ("Not enough arguments.  You need at least the number " .
+                      "of colors and one file name\n");
+        exit(100);
+    }
+    
+    $$newColorCtR = $argv[$firstArgPos];
+
+    @{$fileNamesR} = @argv[$firstArgPos + 1 .. @argv-1];
+}
+
+
+
+sub tempFile($) {
+
+    # We trust Perl's File::Temp to do a better job of creating the temp
+    # file, but it doesn't exist before Perl 5.6.1.
+
+    if (eval { require File::Temp; 1 }) {
+        return File::Temp::tempfile("pnmquant_XXXX", 
+                                    SUFFIX=>".pnm", 
+                                    DIR=>File::Spec->tmpdir(),
+                                    UNLINK=>$TRUE);
+    } else {
+        my ($suffix) = @_;
+        my $fileName;
+        local *file;  # For some inexplicable reason, must be local, not my
+        my $i;
+        $i = 0;
+        do {
+            $fileName = File::Spec->tmpdir() . "/pnmquant_" . $i++ . $suffix;
+        } until sysopen(*file, $fileName, O_RDWR|O_CREAT|O_EXCL);
+
+        return(*file, $fileName);
+    }
+}
+
+
+
+sub makeColorMap($$$$) {
+    my ($fileNamesR, $newColorCt, $colorMapFileName, $errorR) = @_;
+
+    my $pnmcatCmd = "pnmcat -topbottom -white -jleft @{$fileNamesR}";
+
+    my $pnmcolormapCmd = "pnmcolormap $newColorCt";
+
+    my $makeMapCmd = "$pnmcatCmd | $pnmcolormapCmd >$colorMapFileName";
+
+    my $termStatus = system($makeMapCmd);
+
+    if ($termStatus != 0) {
+        $$errorR =
+            "Shell command to create the color map failed:  '$makeMapCmd'.";
+    }
+}
+
+
+ 
+sub remapFiles($$$$) {
+    my ($fileNamesR, $colorMapFileName, $ext, $errorR) = @_;
+
+    my ($outputFh, $outputFileName) = tempFile("pnm");
+    if (!defined($outputFh)) {
+        $$errorR = "Unable to create temporary file.  Errno=$ERRNO";
+    } else {
+        for (my $i = 0; $i < @{$fileNamesR} && !$$errorR; ++$i) {
+            my $inFileName = $fileNamesR->[$i];
+
+            my $pnmremapCmd =
+                "pnmremap '$inFileName' -mapfile=$colorMapFileName " .
+                ">$outputFileName";
+
+            my $pnmremapTermStatus = system($pnmremapCmd);
+
+            if ($pnmremapTermStatus != 0) {
+                $errorR =
+                    "Shell command to quantize '$inFileName'  failed:  " .
+                    "'$pnmremapCmd'";
+            } else {
+                my $newFileName = $inFileName . $ext;
+
+                unlink($newFileName);
+                File::Copy::move($outputFileName, $newFileName)
+                    or $errorR = "Rename to '$newFileName' failed.";
+            }
+        }
+        unlink($outputFileName);  # In case something failed
+    }
+}
+
+
+
+###############################################################################
+#                             MAINLINE
+###############################################################################
+
+my $progError;
+
+parseArgs(\@ARGV, \my $ext, \my $newColorCt, \my @fileNames);
+
+my ($colorMapFh, $colorMapFileName) = tempFile("pnm");
+if (!defined($colorMapFh)) {
+    $progError = "Unable to create temporary file.  Errno=$ERRNO";
+}
+
+if (!$progError) {
+    makeColorMap(\@fileNames, $newColorCt, $colorMapFileName, \$progError);
+}
+print ("got color map\n");
+if (!$progError) {
+    remapFiles(\@fileNames, $colorMapFileName, $ext, \$progError);
+}
+
+my $exitStatus;
+
+if ($progError) {
+    print STDERR ("Failed.  $progError\n");
+    $exitStatus = 1;
+} else {
+    $exitStatus = 0;
+}
+
+unlink($colorMapFileName);
+
+exit($exitStatus);