#! /usr/bin/perl

#                            W I N D E X

#                         Web Image Indexer

#   Windex is a perl script which uses the PBMplus/netpbm image
#   processing toolkit to create an HTML index of the images in
#   a directory.  To use Windex, simply cd to the directory
#   containing the images and run:

#       windex *

#   You can, of course, replace the wild-card with an explicit
#   list of file names, or a selection like "*.png *.jpg".

#   Windex creates an index.html document in the directory
#   which includes index images named "Index-XXX.jpg".  The
#   index images contain uniformly-scaled thumbnails of the
#   images names on the command line.  Each image references
#   a client-side image map which allows you to click on the
#   thumbnail to view the full size source image.  Windex
#   doesn't attempt to index its own index.html and Index-*.jpg
#   images, so you can re-run Windex after adding images to a
#   directory without first cleaning up a previously-made
#   index.

# Windex is based upon Mark Hanson's "icontact", used under the
# following terms:

# Copyright (C) 1992 Mark B. Hanson
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that both the above copyright notice and this permission notice appear in all
# copies and in supporting documentation.  This software is provided "as is"
# without express or implied warranty.

use strict;
use warnings;

my $program = 'windex';
my $derived_from = 'icontact';
my $version = '1.3 (18 March 2020)';
my $copyright = 'Copyright (C) 1992';
my $author = 'Mark B. Hanson (cs62a12@wind.ucsd.edu)';
my $hacked_by = 'John Walker (http://www.fourmilab.ch/)';

#
# default values for parameters that correspond to command line switches
#
# Leave these alone if you want them to match the man page.
#

my $Auto = 1;           # boolean,  0 = use $Columns and $Rows
                        #           1 = dynamically sized to $Xdim, $Ydim
my $Base = 0;           # boolean,  0 = display whole filename in labels
                        #           1 = display basename of filenames in labels
my $Borders = 1;        # boolean,  0 = no spiffy borders around each image
                        #           1 = spiffy borders around each image
my $Ignore = 1;         # boolean,  0 = use configuration file
                        #           1 = don't use configuration file
my $Ident = 1;          # boolean,  0 = don't pad images, just scale them
                        #           1 = pad each image to be the same size
my $Labels = 0;         # boolean,  0 = no labels
                        #           1 = labels
my $Silent = 0;         # boolean,  0 = normal output
                        #           1 = no output except warnings and errors
my $Sort = 1;           # boolean,  0 = don't sort filenames
                        #           1 = sort filenames
my $Uniq = 1;           # boolean,  0 = leave duplicates in file list
                        #           1 = remove duplicates from file list
my $Verbose = 0;        # boolean,  0 = normal output
                        #           1 = show execution
my $White = 0;          # boolean,  0 = black background
                        #           1 = white background
my $Xsame = 0;          # boolean,  0 = don't make all the images the same width
                        #           1 = make all the images the same width
my $Ysame = 0;          # boolean,  0 = don't make all the images the same height
                        #           1 = make all the images the same height

my $Columns = 7;        # n > 0,    number of columns in sheets (!auto mode)
my $Rows = 7;           # n > 0,    number of rows in sheets (!auto mode)

my $Xdim = 780;         # n > 0,    width of max sheet size (auto mode)
my $Ydim = 780;         # n > 0,    height of max sheet size (auto mode)

my $Width = 120;        # n > 0,    max width of each image
my $Height = 120;       # n > 0,    max height of each image

my $Dir =  '.';         # string,   directory to put finished sheets in

my $HTMLfile = 'index.html';    # string,   name for HTML index file

my $HTMLtitle = 'Image Index';  # string,   title for HTML index document

my $Prefix = 'Index-';  # string,   prefix for filename of sheets

my $Offset = 1;         # n > 0,    start at n when numbering the sheets

my $Quality = 30;       # 25 <= n <= 100,    JPEG encoding quality

my $Target = '';        # string,   if non-null, name of target window for image display

my $Tempdir = '/tmp';   # string,   directory to use for temporary files

my $Font = '';          # string,   name of a file to use as a font with pbmtext

my $Format = '.jpg';    # string,   the format in which sheets are to be encoded

my $Namefile = '';      # string,   name of a file from which to get more filenames

my $Quant = 0;          # n >= 0,   number of colors to be left in sheets
                        #           a value of 0 means no quantization


#
# The tables below are filled with common examples that I typed in to save
# you some time and to give you a feel for how icontact decides how to
# {en,de}code files.  Don't worry if your particular set of favorite programs
# and file name extensions is not listed here.
#

#
# associative array to go from file suffix -> ppm.
#

my %decode = (
    'Z',        'trap \'exit 130\' 2; zcat',
    'atk',      'atktopbm',
    'bmp',      'bmptoppm',
    'BMP',      'bmptoppm',
    'brush',    'brushtopbm',
    'cmuwm',    'cmuwmtopbm',
    'fits',     'fitstopgm',
    'fs',       'fstopgm',
    'g3',       'g3topbm',
    'gem',      'gemtopbm',
    'gif',      'giftopnm',
    'GIF',      'giftopnm',
    'gould',    'gouldtoppm',
    'hips',     'hipstopgm',
    'icon',     'icontopbm',
    'ilbm',     'ilbmtoppm',
    'jpg',      'jpegtopnm -quiet',
    'JPG',      'jpegtopnm -quiet',
    'jpeg',     'jpegtopnm -quiet',
    'JPEG',     'jpegtopnm -quiet',
    'lispm',    'lispmtopgm',
    'macp',     'macptopbm',
    'mgr',      'mgrtopbm',
    'mtv',      'mtvtoppm',
    'pam',      'pamtopnm',
    'pbm',      '',
    'pcx',      'pcxtoppm',
    'pgm',      '',
    'pi1',      'pi1toppm',
    'pi3',      'pi3toppm',
    'pict',     'picttoppm',
    'pj',       'pjtoppm',
    'png',      'pngtopnm',
    'ppm',      '',
    'ps',       'pstopnm',
    'qrt',      'qrttoppm',
    'rast',     'rasttopnm',
    'rgb',      'sgitopnm',
    'spc',      'spctoppm',
    'spu',      'sputoppm',
    'tga',      'tgatoppm',
    'tiff',     'tifftopnm',
    'TIFF',     'tifftopnm',
    'xbm',      'xbmtopbm',
    'xim',      'ximtoppm',
    'xpm',      'xpmtoppm',
    'xwd',      'xwdtopnm',
    'ybm',      'ybmtopbm',
    'yuv',      'yuvtoppm',
);


#
# associative array to go from ppm -> file suffix.
#

my %encode = (
    '10x',      'ppmtopgm | pgmtopbm | pbmto10x',
    'Z',        '(compress -v -f; exit 0)',
    'ascii',    'ppmtopgm | pgmtopbm | pbmtoascii',
    'atk',      'ppmtopgm | pgmtopbm | pbmtoatk',
    'bbnbg',    'ppmtopgm | pgmtopbm | pbmtobbnbg',
    'cmuwm',    'ppmtopgm | pgmtopbm | pbmtocmuwm',
    'epson',    'ppmtopgm | pgmtopbm | pbmtoepson',
    'fits',     'ppmtopgm | pgmtofits',
    'fs',       'ppmtopgm | pgmtofs',
    'g3',       'ppmtopgm | pgmtopbm | pbmtog3',
    'gem',      'ppmtopgm | pgmtopbm | pbmtogem',
    'gif',      'ppmtogif',
    'go',       'ppmtopgm | pgmtopbm | pbmtogo',
    'icon',     'ppmtopgm | pgmtopbm | pbmtoicon',
    'icr',      'ppmtoicr',
    'ilbm',     'ppmtoilbm',
    'jpg',      "pnmtojpeg -quality $Quality -progressive",
    'lispm',    'ppmtopgm | pgmtolispm',
    'lj',       'ppmtopgm | pgmtopbm | pbmtolj',
    'macp',     'ppmtopgm | pgmtopbm | pbmtomacp',
    'mgr',      'ppmtopgm | pgmtopbm | pbmtomgr',
    'pbm',      'ppmtopgm | pgmtopbm',
    'pcx',      'ppmtopcx',
    'pgm',      'ppmtopgm',
    'pi1',      'ppmtopi1',
    'pi3',      'ppmtopgm | pgmtopbm | pbmtopi3',
    'pict',     'ppmtopict',
    'pj',       'ppmtopj',
    'plot',     'ppmtopgm | pgmtopbm | pbmtoplot',
    'ppm',      '',
    'png',      'pnmtopng',
    'ps',       'pnmtops',
    'ptx',      'ppmtopgm | pgmtopbm | pbmtoptx',
    'puzz',     'ppmtopuzz',
    'rast',     'pnmtorast',
    'sixel',    'ppmtosixel',
    'tga',      'ppmtotga',
    'tiff',     'pnmtotiff',
    'uil',      'ppmtouil',
    'x10bm',    'ppmtopgm | pgmtopbm | pbmtox10bm',
    'xbm',      'ppmtopgm | pgmtopbm | pbmtoxbm',
    'xpm',      'ppmtoxpm',
    'xwd',      'pnmtoxwd',
    'ybm',      'ppmtopgm | pgmtopbm | pbmtoybm',
    'yuv',      'ppmtoyuv',
    'zinc',     'ppmtopgm | pgmtopbm | pbmtozinc',
);


#
# default quantization values based upon output file suffix.
# if a format's default quant value is the default for the -q switch
# ($Quant), don't bother listing it.
#

my %defquant = (
    'gif',      256,
);


#
# mapping from command line switches to internal variable names
#

my %optvar = (
    'a', 'Auto',    'B', 'Borders', 'b', 'Base',    'c', 'Columns',
    'd', 'Dir',     'F', 'Font',    'f', 'Format',  'g', 'Param',
    'h', 'Height',
    'H', 'HTMLfile',
    'i', 'Ident',   'k', 'Ignore',
    'l', 'Labels',
    'L', 'HTMLtitle',
    'n', 'Namefile','o', 'Offset',
    'P', 'Suffix',  'p', 'Prefix',  'q', 'Quant',   'r', 'Rows',
    'S', 'Sort',    's', 'Silent',  't', 'Tempdir',
    'T', 'Target',
    'u', 'Uniq',
    'v', 'Verbose', 'W', 'White',   'w', 'Width',   'X', 'Xsame',
    'x', 'Xdim',    'Y', 'Ysame',   'y', 'Ydim',
);


# ---------------------------- end of definitions -----------------------------


#
# keep track of the default settings for the usage message
#

my (%d, %opt);
for (values(%optvar)) {
    $d{$_} = eval "\$$_";
}


#
# tell the public who's responsible for this mess...
#

&info("$program-$version $copyright $author") if $Verbose;


#
# assign $Tempdir
#

if ($ENV{'TMPDIR'} && $ENV{'TEMPDIR'}) {
    &warning("both TMPDIR and TEMPDIR are set.  Using TMPDIR.");
    $Tempdir = $ENV{'TMPDIR'};
} else {
    # if neither environment variable is set, set it to itself
    $Tempdir = $ENV{'TMPDIR'} || $ENV{'TEMPDIR'} || $Tempdir;
}

#
# evaluate arguments

@ARGV = &evalargs(@ARGV);

#
# sanity checks (fatal)
#

if (!$Namefile) {
    &fatal("no files specified!") unless @ARGV;
}

my $switch;
foreach $switch ('c', 'h', 'r', 'w', 'x', 'y') {
    my $num = eval "\$$optvar{$switch}";
    if ($num !~ /^\d+$/ || $num < 1) {
        &fatal("-$switch argument must be a positive integer!");
    }
}

foreach $switch ('o', 'q') {
    my $num = eval "\$$optvar{$switch}";
    if ($num !~ /^\d+$/ || $num < 0) {
        &fatal("-$switch argument must be non-negative integer!");
    }
}

foreach ($Tempdir, $Dir) {
    $_ = '/' unless $_;
    &fatal("directory `$_' does not exist!") unless -e $_;
    &fatal("`$_' is not a directory!") unless -d _;
    &fatal("read permission denied on `$_'!") unless -r _;
    &fatal("write permission denied on `$_'!") unless -w _;
}

&fatal('-i and -X switches can\'t be used together.') if ($Ident && $Xsame);
&fatal('-i and -Y switches can\'t be used together.') if ($Ident && $Ysame);
&fatal('-X and -Y switches can\'t be used together.') if ($Xsame && $Ysame);


#
# sanity checks (warnings)
#

if ($Auto) {
    &warning('image width is larger than sheet width \
(your sheets will be one image wide)!') if ($Width > $Xdim);
    &warning('image height is larger than sheet height \
(your sheets will be one image high)!') if ($Height > $Ydim);
    &warning('-r and -a specified!  Ignoring -r.') if $opt{'r'};
    &warning('-c and -a specified!  Ignoring -c.') if $opt{'c'};
} else {
    &warning('-x specified without -a!  Ignoring -x.') if $opt{'x'};
    &warning('-y specified without -a!  Ignoring -y.') if $opt{'y'};
}

&warning('-X and -h specified!  Ignoring -h.') if ($Xsame && $opt{'h'});
&warning('-Y and -w specified!  Ignoring -w.') if ($Ysame && $opt{'w'});

if ($Verbose && $Silent) {
    &warning('-v and -s cancel each other out!');
    $Silent = $Verbose = 0;
}

unless ($Labels) {
    &warning('-F specified without -l!  Ignoring -F.') if ($Font);
    &warning('-b specified without -l!  Ignoring -b.') if ($Base);
}


#
# process output format
#

$Format =~ s/^\.//;

my @suffs = split(/\./, $Format);
my @badext;

if (@badext = grep(!defined($encode{$_}), @suffs)) {
    &fatal(sprintf('unknown extension%s (%s) in output format!',
        ((@badext > 1) ? 's' : ''), &cslist(@badext)));
}

my @encodecmd = grep($_, @encode{@suffs});

$Quant = $defquant{$Format} if (!$opt{'q'} && $defquant{$Format});

unshift(@encodecmd, "ppmquant -fs $Quant") if $Quant;

my $encodecmd = @encodecmd ? ('| ' . join(' | ', @encodecmd) . ' ') : '';


#
# get filenames from named file
#

my (@iqueue, @rqueue);

my @filelist = ();

if ($Namefile) {
    open(NAMEFILE, "<$Namefile") ||
            &fatal("unable to open `$Namefile' to read filenames: $!!");
    chop(@filelist = <NAMEFILE>);
    close(NAMEFILE);
}

unshift(@filelist, @ARGV);

&fatal("no files specified!") unless @filelist;

my $pnmscale;
if ($Xsame) {
    $pnmscale = "pnmscale -xsize $Width";
} elsif ($Ysame) {
    $pnmscale = "pnmscale -ysize $Height";
} else {
    $pnmscale = "pnmscale -xysize $Width $Height";
}


#
# start up the signal handler.
#

$SIG{'HUP'} = $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'catcher';

my @newlist = ();
my $file;

foreach $file (@filelist) {
    push(@newlist, $file);
}
@filelist = @newlist;

#
# uniq filenames
#

my (%sheetname, %esheetname, %basename);

if ($Uniq) {
    my %seen;
    @newlist = ();
    foreach (@filelist) {
        if ($seen{$_}++) {
            &info("removing duplicate `$_' from file list");
            $esheetname{$_} = '';       # use the one that's not shrunk already.
        } else {
            push(@newlist, $_);
        }
    }
    @filelist = @newlist;
}


#
# take the basename's once and for all.
#

foreach (@filelist, values(%sheetname)) {
    $basename{$_} = (/([^\/]*)$/ ? $1 : $_);
}


#
# sort filenames
#

@filelist = ($Base ? sort by_basename @filelist : sort @filelist) if ($Sort);


#
# figure out how big each character is in the specified font
#

my ($pbmtext, $cheight, $invert);
if ($Labels) {
    $pbmtext = 'pbmtext' . ($Font ? " -font '$Font'" : '');
    open(TEXT, "$pbmtext 'ABCDEFGHIJKLMNOPQRSTUVWXYZ._abcdefghijklmnopqrstuvwxyz0123456789' | pnmcrop -white -top -bottom | pnmfile |") ||
        &fatal("can't open `$pbmtext' to determine font size for labels: $!!");

    (<TEXT> =~ /\s+(\d+)\s+by\s+(\d+)\s+/) ||
        &fatal("can't understand `$pbmtext 'M' | pnmfile |' output!");

    close(TEXT);

    my $cwidth = $1;
    $cheight = $2;
    if ($Verbose) {
        &info("label font character size $cwidth X $cheight pixels");
    }

    $invert = $White ? '' : ' | pnminvert';
}


#
# determine the offset to be used for the first sheet.
#

my $scount;
if ($opt{'o'}) {
    $scount = $Offset;
} else {
    $scount = 1;
}


#
# a few initializations...
#

my $background = $White ? 'white' : 'black';

my @stripes = $White ? ('white', 'black', 'white') : ('black', 'white', 'black');

my $temp = "$Tempdir/Windex_ict-$$";

my ($icount, $rcount) = (1, 1);

my ($iqwidth, $iqheight, $rqheight) = (0, 0, 0);

my (@ipqueue, @fpqueue, @rpqueue, @tfie);

my $wrheight = 0;
my ($HTMLmapno, $HTMLxpos, $HTMLypos);

my $pendingHTML = '';


#
# create one border file for all the images if $Ident && $Borders
#

my ($border, $command);
if ($Borders && $Ident) {
    $border = "$Tempdir/Windex_icb-$$";

    my $count = 2;

    $command = sprintf('pbmmake -%s %d %d >%s',
        shift @stripes, ($Width + $count), ($Height + $count), $border);

    &shell($command) || &fatal('unable to create border file!');

    my $color;
    foreach $color (@stripes) {
        $count += 2;

        $command = sprintf('pbmmake -%s %d %d | pnmpaste %s 1 1 >%s',
            $color, ($Width + $count), ($Height + $count), $border, $temp);

        &shell($command) || &fatal('unable to add a layer to border file!');

        &mv($temp, $border) || &fatal("unable to move `$temp' to `$border'!");
    }
}

#   Generate HTML document prologue

    if (defined($HTMLfile)) {
        open(HTML, ">$HTMLfile") || &fatal("unable to open HTML file $HTMLfile");
        $HTMLmapno = $Offset;
        $HTMLxpos = $HTMLypos = 0;
        print HTML <<"EOH";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>$HTMLtitle</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
<map name="map$HTMLmapno" id="map$HTMLmapno">
EOH
    }

#   Process each file

    my ($image, $row);

IMAGE: while ($file = shift @filelist) {
    $image = "$Tempdir/Windex_ici$icount-$$";

    if ($sheetname{$file}) {    # file is to be cut from sheet
        unless (grep(/^$esheetname{$file}$/, @tfie)) {
            &toppm($sheetname{$file}, $esheetname{$file}, 0) || next IMAGE;
        }
        &cut($file, $image) || next IMAGE;
        &rm($esheetname{$file}) unless
            grep(/^$esheetname{$file}$/, @esheetname{@filelist});
    } else {    # file is an image file
        if (defined($HTMLfile)) {
            if ($file eq $HTMLfile) {
                #   Don't try to index HTML file
                next IMAGE;
            }
            if ($file =~ m/^$Prefix.*$Format$/) {
# print("** Ignoring our own file $file\n");
                #   Don't index previously-made index images
                next IMAGE;
            }
        }
        unless (-e $file) {
            &skip("`$file' does not exist!");
            next IMAGE;
        }
        unless (-f _) {
            &skip("`$file' is not a file!");
            next IMAGE;
        }
        &toppm($file, $image, 1) || next IMAGE;
    }

    my $label = ($Base ? $basename{$file} : $file);
    my ($iwidth, $iheight);

    if ($Auto || $Labels || $Borders || $Ident) {
        unless (open(SIZE, "pnmfile $image |")) {
            &skip("can't open `pnmfile $image |' for reading: $!!");
            &rm($image);
            next IMAGE;
        }
        unless ((($iwidth, $iheight) =
            (<SIZE> =~ /\s+(\d+)\s+by\s+(\d+)\s+/))) {
            &skip("can't understand `pnmfile $image |' output!");
            &rm($image);
            close(SIZE);
            next IMAGE;
        }
        close(SIZE);
    }

    if ($Ident) {
        my $xpad = int(($Width - $iwidth) / 2);
        my $ypad = int(($Height - $iheight) / 2);

        $command = sprintf('pbmmake -%s %d %d | pnmpaste %s %d %d >%s',
                $background, $Width, $Height, $image, $xpad, $ypad, $temp);

        unless (&shell($command)) {
            &skip("unable to pad `$file' to ${Width}x$Height!");
            &rm($image, $temp);
            next IMAGE;
        }

        unless (&mv($temp, $image)) {
            &rm($image, $temp);
            next IMAGE;
        }

        $iwidth = $Width;
        $iheight = $Height;
    }

    if ($Borders) {
        if ($Ident) {
            $iwidth += 6;
            $iheight += 6;

            unless (&shell("pnmpaste $image 3 3 $border >$temp")) {
                &skip("unable to add a border to `$file'!");
                &rm($image, $temp);
                next IMAGE;
            }
            unless (&mv($temp, $image)) {
                &rm($image, $temp);
                next IMAGE;
            }
        } else {
        my $color;
            foreach $color (@stripes) {
                $iwidth += 2;
                $iheight += 2;

                $command = sprintf('pbmmake -%s %d %d | pnmpaste %s 1 1 >%s',
                    $color, $iwidth, $iheight, $image, $temp);

                unless (&shell($command)) {
                    &skip("unable to add a layer of border on `$file'!");
                    &rm($image, $temp);
                    next IMAGE;
                }
                unless (&mv($temp, $image)) {
                    &rm($image, $temp);
                    next IMAGE;
                }
            }
        }
    }

    if ($Labels) {
        $command = sprintf(
        '%s \'%s\' | pnmcrop -white -top -bottom | pnminvert | pnmcut -pad 0 0 %d %d | pnminvert %s | pnmcat -%s -tb %s - >%s',
            $pbmtext, $label,
            $iwidth, $cheight,
        $invert, $background, $image, $temp);

        unless (&shell($command)) {
            &skip("unable to attach label to `$file'!");
            &rm($image, $temp);
            next IMAGE;
        }
        unless (&mv($temp, $image)) {
            &rm($image, $temp);
            next IMAGE;
        }
        $iheight += $cheight;
    }


    if ($Auto) {
        if ($iqwidth + $iwidth > $Xdim) {
            $HTMLxpos = 0;
            if (@iqueue) {
                &image2row;
                $rcount++;
                $wrheight = $iqheight;
                $HTMLypos += $iqheight;
                &pushimage;
                ($iqwidth, $iqheight) = ($iwidth, $iheight);
            } else {
                &pushimage;
                &image2row;
                $rcount++;
                $wrheight = $iheight;
                $iqwidth = $iqheight = 0;
            }
            if ($rqheight + $wrheight > $Ydim) {
                if (@rqueue) {
                    &row2sheet;
                    &pushrow;
                    $rqheight = $wrheight;
                } else {
                    &pushrow;
                    &row2sheet;
                    $rqheight = 0;
                }
            } else {
                &pushrow;
                $rqheight += $wrheight;
            }
        } else {
            &pushimage;
            $iqwidth += $iwidth;
            $iqheight = $iheight if ($iheight > $iqheight);
        }

        if (defined($HTMLfile)) {
            if ($HTMLypos + $wrheight > $Ydim) {
                my $sheet = sprintf("%s/%s%03d.%s", $Dir, $Prefix, $HTMLmapno, $Format);
                my $mn = $HTMLmapno + 1;

                $sheet =~ s-\./--;
                $pendingHTML .= <<"EOH";
</map>
<p />
<hr width="60" />
<p />
<center>
<img src="$sheet" usemap="#map$HTMLmapno" width="<WIDTH>" height="<HEIGHT>" border="0" alt="Index image $HTMLmapno" />
</center>
<map name="map$mn" id="map$mn">
EOH

                $HTMLmapno++;
                $HTMLypos = 0;
            }
            my ($nx, $ny) = ($HTMLxpos + $iwidth, $HTMLypos + $iheight);
        my $tgt = '';
        if ($Target ne '') {
            $tgt = " target=\"$Target\"";
        }
            $pendingHTML .= "    <area shape=\"rect\" coords=\"$HTMLxpos,$HTMLypos,$nx,$ny\" href=\"$file\" alt=\"$file\"$tgt />\n";
            $HTMLxpos = $nx;
        }
    } else {
        &pushimage;

    if (defined($HTMLfile)) {
            my ($nx, $ny) = ($HTMLxpos + $iwidth, $HTMLypos + $iheight);
        my $tgt = '';
        if ($Target ne '') {
            $tgt = " target=\"$Target\"";
        }
            $pendingHTML .= "    <area shape=\"rect\" coords=\"$HTMLxpos,$HTMLypos,$nx,$ny\" href=\"$file\" alt=\"$file\"$tgt />\n";
            $HTMLxpos = $nx;
    }

        if (($icount % $Columns) == 0) {
            &image2row;
        $HTMLypos += $iheight;
            &pushrow;
        if (($rcount % $Rows) == 0) {
            if (defined($HTMLfile)) {
                    my $sheet = sprintf("%s/%s%03d.%s", $Dir, $Prefix, $HTMLmapno, $Format);
                    my $mn = $HTMLmapno + 1;

                    $sheet =~ s-\./--;
                    $pendingHTML .= <<"EOH";
</map>
<p />
<hr width="60" />
<p />
<center>
<img src="$sheet" usemap="#map$HTMLmapno" width="<WIDTH>" height="<HEIGHT>" border="0" alt="Index image $HTMLmapno" />
</center>
<map name="map$mn" id="map$mn">
EOH

                    $HTMLmapno++;
                    $HTMLypos = 0;
                }
                &row2sheet;
        }

            $rcount++;
        $HTMLxpos = 0;
        }
    }

    $icount++;
}

if (@iqueue) {
    &image2row;
    if ($Auto && $rqheight + $iqheight > $Ydim) {
        &row2sheet;
    if (defined($HTMLfile)) {
            my $sheet = sprintf("%s/%s%03d.%s", $Dir, $Prefix, $HTMLmapno, $Format);
#       my ($s, $width, $height);

            $sheet =~ s-\./--;

            $pendingHTML .= <<"EOH";
</map>
<p />
<hr width="60" />
<p />
<center>
<img src="$sheet" usemap="#map$HTMLmapno" width="<WIDTH>" height="<HEIGHT>"  border="0" alt="Index image $HTMLmapno" />
</center>
EOH
        }
    }
    &pushrow;
}

if (@rqueue) {
    if (defined($HTMLfile)) {
        my ($sheet) = sprintf("%s/%s%03d.%s", $Dir, $Prefix, $HTMLmapno, $Format);
#   my ($s, $width, $height);

        $sheet =~ s-\./--;

        $pendingHTML .= <<"EOH";
</map>
<p />
<hr width="60" />
<p />
<center>
<img src="$sheet" usemap="#map$HTMLmapno" width="<WIDTH>" height="<HEIGHT>"  border="0" alt="Index image $HTMLmapno" />
</center>
EOH
    }
    &row2sheet;
}

&cleanup;

if (defined($HTMLfile)) {
    print(HTML "</body>\n</html>\n");
}

exit(0);

&catcher('HEY, THIS CAN\'T HAPPEN');    # just to get rid of the warning...

# --------------------------- end of main program -----------------------------

sub by_basename {
    $basename{$a} cmp $basename{$b};
}

sub by_number {
    $a <=> $b;
}

sub catcher {
    &cleanup;
    &fatal("caught a SIG@_ -- shutting down!");
}

sub cleanup {
    foreach (@tfie) { &warning("can't unlink `$_': $!!") unless unlink; }
}

sub cslist {
    local($") = ", ";
    "@_";
}

sub cut {
    my ($input, $output) = @_;

    &info("cutting `$input'");
    if (!&shell("pnmcut $esheetname{$input} >$output")) {
        &skip("can't cut from $esheetname{$input}");
        &rm($output);
        return 0;
    }
    return 1;
}

sub evalargs {
    my @args = @_;

    while ($_ = $args[0], ($_ && /^[-+]/)) {
        shift @args;
        last if /^--$/;

        if (/^[-+]help$/) {                                 # `h' special case
            &usage;
        } elsif (/^[-+]([cdFfhHKLnoPpqrtTwxy])$/) {            # argument
            if (@args) {
                eval "\$opt{'$1'} = 1; \$$optvar{$1} = shift \@args";
            } else {
                &fatal("no argument given for -$1 switch!");
            }
        } elsif (/^([-+])([aBbgiklOSsuvWXY])(.*)$/) {       # no argument
            my $val = ($1 eq '-') ? 1 : 0;
            my $backon = length($3) ? "; unshift(\@args, '$1$3')" : '';
            eval "\$$optvar{$2} = $val$backon";
        } else {                                            # unknown
            warn "$program: FATAL ERROR: unknown option: `$_'!\n";
            &usage;
        }
    }
    @args;
}

sub fatal {
    die "$program: FATAL ERROR: ", @_, "\n";
}

sub image2row {
    &info("assembling row $rcount");
    $row = "$Tempdir/Windex_icr$rcount-$$";
    unless (&shell("pnmcat -$background -lr -jbottom " .
                    join(' ', @{iqueue}) . " >$row")) {
        &skip("can't assemble row $rcount!");
        &rm($row);
    }
    &rm(@iqueue);
    @iqueue = ();
}

sub info {
    warn "$program: ", @_, "\n" unless $Silent;
}

sub mv {
    my ($src, $dest) = @_;

    unless (rename($src, $dest)) {
        &skip("unable to rename `$src' to `$dest': $!!");
        return 0;
    }

    &tfdelete($src);
    &tfadd($dest);
    1;
}

sub on {
    my ($num) = @_;

    $num ? 'on' : 'off';
}

sub pushimage {
    push(@iqueue, $image);
}


sub pushrow {
    push(@rqueue, $row);
}

sub rm {
    foreach $file (@_) {
        &tfdelete($file);
        &warning("can't unlink `$file': $!!") unless unlink($file);
    }
}

sub row2sheet {
    my ($sheet) = sprintf("%s/%s%03d.%s", $Dir, $Prefix, $scount, $Format);
    &info("assembling `$sheet'");
    unless (&shell("pnmcat -jleft -$background -tb " .
                    join(' ', @{rqueue}) . " $encodecmd >$sheet")) {
        &skip("can't assemble sheet $scount!");
        &rm($sheet);
    }

    &tfdelete($sheet);  # save the sheets!
    $scount++;
    &rm(@rqueue);
    @rqueue = ();

    if ($pendingHTML ne '') {
        my $s;
        if ($Format eq 'jpg') {
            $s = `jpegtopnm -quiet $sheet | pnmfile`;
        } elsif ($Format eq 'png') {
            $s = `pngtopnm -quiet $sheet | pnmfile`;
        } elsif ($Format eq 'gif') {
            $s = `giftopnm -quiet $sheet | pnmfile`;
        }
        $s =~ m/\D*(\d+) by (\d+)\s/;
        my ($width, $height) = ($1, $2);
        $pendingHTML =~ s/<WIDTH>/$width/;
        $pendingHTML =~ s/<HEIGHT>/$height/;
        print(HTML $pendingHTML);
        $pendingHTML = '';
    }
}

sub shell {
    my ($command) = @_;

    &tfadd($1) if ($command =~ /\s+>\s+(\S+)$/);

    if ($Verbose) {
        &info($command);
    } else {
        if ($Verbose) {
            $command = "($command) 2>/dev/null";
    }
    }

    system($command);

    if ($? & 255) {
        &warning("`$command' was killed by signal: ", ($? & 127), '.',
            ($? & 128) ? "core dumped." : '');
        return 0;
    } elsif (my $status = ($? >> 8)) {
        if ($status & 128) {
            &cleanup;
            &fatal("`$command' was terminated abnormally by signal: ",
                ($status & 127));
        } else {
            &warning("`$command' terminated with exit status: $status");
            return 0;
        }
    }
    1;
}

sub skip {
    &warning(@_, "  Skipping.");
}

sub tfadd {
    my ($file) = @_;
    push(@tfie, $file) unless grep(/^$file$/, @tfie);
}

sub tfdelete {
    my ($file) = @_;
    @tfie = grep(!/^$file$/, @tfie);
}

sub toppm {
    my ($input, $output, $shrink) = @_;

    my (@suffs) = split(/\./, $basename{$input});
    @suffs = pop(@suffs);

    unless (@suffs) {
        &skip("no extension on `$input'!");
        return 0;
    }

    if (@badext = grep(!defined($decode{$_}), @suffs)) {
        &skip(sprintf('unknown extension%s (%s) on `%s\'!',
            ((@badext > 1) ? 's' : ''), &cslist(@badext), $input));
        return 0;
    }

    my @decodecmd = grep($_, reverse @decode{@suffs});

    my ($init) = (@decodecmd && ($decodecmd[0] =~ tr/|/|/) == 0) ?
        (shift @decodecmd) . " '$input'" :
        "cat '$input'";

    my ($decodecmd);
    if ($shrink) {
        $decodecmd = join(' | ', ($init, @decodecmd, "$pnmscale >$output"));
        &info("shrinking `$input'");
    } else {
        $decodecmd = join(' | ', ($init, @decodecmd)) . " >$output";
        &info("expanding `$input'");
    }

    unless (&shell($decodecmd)) {
        &skip("can't decode `$input'!");
        &rm($output);
        return 0;
    }
    1;
}

sub usage {
    die "usage: $program [options] [image file ...]
[options] consists of:
-a, +a\t automatically size sheets to the size of the screen.  default = ",
    &on($d{'Auto'}), "
-B, +B\t put borders around each image.  default = ", &on($d{'Borders'}), "
-b, +b\t take the basename of the filenames.  default = ", &on($d{'Base'}), "
-c #\t number of columns of images in each sheet.  default = $d{'Columns'}
-d dir\t put sheets in `dir'.  default = `$d{'Dir'}'
-f str\t `str' is the file format of the sheets.  default = `$d{'Format'}'
-F file\t font file for labels.  default = `",
    ($d{'Font'} || 'pbmtext\'s internal font'), "'
-h #\t height of each small image in pixels.  default = $d{'Height'}
-H name\t Create HTML file named name.html.  default = `$d{'HTMLfile'}'
-i, +i\t make images the same size.  default = ", &on($d{'Ident'}), "
-l, +l\t put labels under the images.  default = ", &on($d{'Labels'}), "
-L text\t use `text' as title for HTML index.  Default = \"Image Index\"
-n file\t get filenames from `file'.  default = none
-o #\t start at this number when naming sheets.  default = $d{'Offset'}
-p name\t name of the sheets. default = `$d{'Prefix'}'
-q #\t number of colors in each sheet.  default = $d{'Quant'}
-r #\t number of rows of images in each sheet.  default = $d{'Rows'}
-S, +S\t sort all the filenames.  default = ", &on($d{'Sort'}), "
-s, +s\t be silent.  default = ", &on($d{'Silent'}), "
-t dir\t use `dir' to hold temporary files.  default = `$d{'Tempdir'}'
-T name\t use `name' as target window for images.  Default = \"\" (open images in main window)
-u, +u\t remove duplicate file names from file list.  default = ",
    &on($d{'Uniq'}), "
-v, +v\t be verbose.  default = ", &on($d{'Verbose'}), "
-W, +W\t use a ", (!$d{'White'} ? "white" : "black"),
    " background for the contact sheets.  default = ",
    ($d{'White'} ? "white" : "black"), "
-w #\t width of each small image in pixels.  default = $d{'Width'}
-X, +X\t make images the same width.  default = ", &on($d{'Ysame'}), "
-x #\t image width in pixels.  default = $d{'Xdim'}
-Y, +Y\t make images the same height.  default = ", &on($d{'Ysame'}), "
-y #\t image height in pixels.  default = $d{'Ydim'}
";
}

sub warning {
    warn "$program: WARNING: ", @_, "\n";
}
