#!/usr/bin/perl -w
# @(#)$Id: icontact,v 5.9 1999/09/11 23:45:51 mark Exp $

#    icontact - image contact sheet maker
#    Copyright (C) 1992-1999  Mark B. Hanson (mbh@panix.com)
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

require 5.004;

use strict;

my $program = 'icontact';
my $version = '1.5 (1999-09-11)';
my $copyright = 'Copyright (C) 1992-1999';
my $author = 'Mark B. Hanson (mbh@panix.com)';
my $license = 'Licensed under the terms of the GNU General Public License.';
my $terms = 'Read COPYING or http://www.gnu.org/copyleft/gpl.html for terms.';
my $warranty = 'NO WARRANTY!';

#
# default values for parameters that correspond to command line switches
# (You don't want to change these here; use a configuration file instead.)
#

my $AutoOff = 0;    # boolean,	0 = sheet numbers start with 0
		    #		1 = start with next highest number
my $Auto = 0;	    # 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 = 0;    # boolean,	0 = no spiffy borders around each image
		    #		1 = spiffy borders around each image
my $Ignore = 0;	    # boolean,	0 = use configuration file
		    #		1 = don't use configuration file
my $Ident = 0;	    # boolean,	0 = don't pad images, just scale them
		    #		1 = pad each image to be the same size
my $ICUniq = 0;	    # boolean,	0 = leave duplicates in file list
		    #		1 = remove duplicates, ignoring case
my $Labels = 0;	    # boolean,	0 = no labels
		    #		1 = labels
my $Left = 0;	    # boolean,	0 = center justify rows
		    #		1 = left justify rows
my $More = 0;	    # boolean,	0 = no additional information in second label
		    #		1 = additional information in second label
my $NoScale = 0;    # boolean,	0 = scale the input images
		    #		1 = don't scale the input images
my $Param = 0;	    # boolean,	0 = no parameter files for sheets
		    #		1 = generate parameter files for sheets
my $Right = 0;	    # boolean,	0 = center justify rows
		    #		1 = right justify rows
my $Silent = 0;	    # boolean,	0 = normal output
		    #		1 = no output except warnings and errors
my $Sort = 0;	    # boolean,	0 = don't sort filenames
		    #		1 = sort filenames
my $Uniq = 0;	    # boolean,	0 = leave duplicates in file list
		    #		1 = remove duplicates, considering case
my $Verbose = 0;    # boolean,	0 = normal output
		    #		1 = show output of child commands
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 = 1152;    # n > 0,	width of max sheet size (auto mode)
my $Ydim = 900;	    # n > 0,	height of max sheet size (auto mode)

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

my $Config =	    # string,	name of the configuration file
	'~/.icrc';

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

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

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

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

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

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

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

my $Suffix =	    # string,	suffix of parameter files
	'.icp';

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

my $Qprog =	    # string,	quantization program that takes the number of
    'ppmquant -fs'; #		colors as an argument

my $DefFmt = '.gif';# string,	default format to use if image has no suffix.

my $Stripe =	    # string,	list of colors to be used for borders
    'black white black';

my $Text = 'white'; # string,	color of text for labels

my $Back = 'black'; # string,	default color for background

my $Pad = $Back;    # string,	color to use for padding area when using -i

my $Nice = 0;	    # n,	nice value for children

my $Mult = 0;	    # n,	factor by which to scale all the images


#
# 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.  Like it says in the man
# page: `icontact is highly configurable.'  Use a configuration file to make
# icontact use any set of programs and filename extensions you want.
# This way, when new releases of icontact come out, you won't have to
# roll your changes into the new version -- your preferences will be read
# from your configuration file automatically.
#

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

my %decode = (
    'Z',	'trap \'exit 130\' 2; uncompress -c',
    'atk',	'atktopbm',
    'brush',	'brushtopbm',
    'cmuwm',	'cmuwmtopbm',
    'fits',	'fitstopgm',
    'fs',	'fstopgm',
    'g3',	'g3topbm',
    'gem',	'gemtopbm',
    'gif',	'giftopnm',
    'gould',	'gouldtoppm',
    'gz',	'gunzip -cv',
    'hips',	'hipstopgm',
    'icon',	'icontopbm',
    'ilbm',	'ilbmtoppm',
    'jpg',	'djpeg',
    'lispm',	'lispmtopgm',
    'macp',	'macptopbm',
    'mgr',	'mgrtopbm',
    'mtv',	'mtvtoppm',
    'pbm',	'',
    'pcd',	'hpcdtoppm -2 -a',
    'pcx',	'pcxtoppm',
    'pgm',	'',
    'pi1',	'pi1toppm',
    'pi3',	'pi3toppm',
    'pict',	'picttoppm',
    'pj',	'pjtoppm',
    'ppm',	'',
    'ps',	'| gs -q -r90 -sDEVICE=ppmraw -sOutputFile=- -dSAFER -',
    'qrt',	'qrttoppm',
    'rast',	'rasttopnm',
    'spc',	'spctoppm',
    'spu',	'sputoppm',
    'tga',	'tgatoppm',
    'tiff',	'tifftopnm',
    'tif',	'tifftopnm',
    'xbm',	'xbmtopbm',
    'xim',	'ximtoppm',
    'xpm',	'xpmtoppm',
    'xwd',	'xwdtopnm',
    'xv',	'xvtoppm',
    'ybm',	'ybmtopbm',
    'yuv',	'yuvtoppm',
);


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

my %encode = (
    '10x',	'ppmtopgm | pgmtopbm | pbmto10x',
    'Z',	'(compress -vf; Z=$?; test $Z -eq 2 && exit 0; exit $Z)',
    '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',
    'gz',	'gzip -9cv',
    'icon',	'ppmtopgm | pgmtopbm | pbmtoicon',
    'icr',	'ppmtoicr',
    'ilbm',	'ppmtoilbm',
    'jpg',	'cjpeg -o',
    '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',	'',
    'ps',	'pnmtops',
    'ptx',	'ppmtopgm | pgmtopbm | pbmtoptx',
    'puzz',	'ppmtopuzz',
    'rast',	'pnmtorast',
    'sixel',	'ppmtosixel',
    'tga',	'ppmtotga',
    'tiff',	'pnmtotiff',
    'tif',	'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', 'Back',
    'c', 'Columns', 'D', 'DefFmt',  'd', 'Dir',     'F', 'Font',
    'f', 'Format',  'g', 'Param',   'h', 'Height',  'I', 'Pad',
    'i', 'Ident',   'K', 'Config',  'k', 'Ignore',  'L', 'Left',
    'l', 'Labels',  'M', 'Mult',    'm', 'More',    'N', 'Nice',
    'n', 'Namefile','O', 'AutoOff', 'o', 'Offset',  'P', 'Suffix',
    'p', 'Prefix',  'q', 'Quant',   'Q', 'Qprog',   'R', 'Right',
    'r', 'Rows',    'S', 'Sort',    's', 'Silent',  'T', 'Text',
    't', 'Tempdir', 'U', 'ICUniq',  'u', 'Uniq',    'v', 'Verbose',
    'w', 'Width',   'X', 'Xsame',   'x', 'Xdim',    'Y', 'Ysame',
    'y', 'Ydim',    'Z', 'NoScale', 'z', 'Stripe',
);


#
# signal names
#

use Config;

my @signals = split(' ', $Config{sig_name});


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


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

my %d;

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


#
# evaluate command line arguments before processing the 
# configuration file to pick up the -k and -K switches
#

my %opt;

&evalargs(@ARGV);


#
# process the configuration file
#

unless ($Ignore) {
    if ($Config =~ m|^~/|) {
	my $home = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7];

	unless ($home) {
	    &fatal('yikes! Can\'t find your home directory!');
	}
	$home =~ s|/$||;
	$Config =~ s|^~|$home|;
    }

    if (-e $Config) {
	if (-f _) {
	    if (open(CONFIG, "<$Config")) {
		my $c;
		my $f;
		my $head;
		my $quoted;
		my $tail;
		my $v;
		my @switches;

		while (<CONFIG>) {
		    next if (/^\s*#/ || /^\s*$/);
		    s/#.*$//;
		    if (($f, $v) = /^\s*quantize\s+(\S+)\s+(\d+)\s*$/) {
			$f =~ s/^\.//;
			$defquant{$f} = $v;
		    } elsif (($f, $c) = /^\s*encode\s+(\S+)\s+(.*)\s*$/) {
			$f =~ s/^\.//;
			$encode{$f} = $c;
		    } elsif (($f, $c) = /^\s*decode\s+(\S+)\s+(.*)\s*$/) {
			$f =~ s/^\.//;
			$decode{$f} = $c;
		    } elsif (/^\s*switches\s+(.+)\s*$/) {
			@switches = ();
			$tail = $1;
			$quoted = 0;
			while ($tail) {
			    ($head, $tail) = split(/"/, $tail , 2);
			    push(@switches,
				$quoted ? $head : split(' ', $head));
			    $quoted = !$quoted;
			}
			while (@switches = &evalargs(@switches)) {
			    &warning('Ignoring `', shift @switches,
				"' on line $. of $Config");
			}
		    } else {
			&warning("can't understand line $. of `$Config'");
		    }
		}
		close CONFIG;
	    } else {
		&warning("can't open `$Config': $!!");
	    }
	} else {
	    &warning("`$Config' is not a file!  Configuration file ignored.");
	}
    }
}


#
# evaluate command line arguments again after processing the
# configuration file so their values take precedence (yes, this is ugly)
#

@ARGV = &evalargs(@ARGV);


#
# tell the public who's responsible for this mess...
# (we have to wait until we know if $Verbose is defined or not)
#

if ($Verbose) {
    &info("$program-$version");
    &info("$copyright $author");
    &info("  $license");
    &info("  $terms");
    &info("  $warranty");
}


#
# assign $Tempdir
#

unless ($opt{'t'}) {
    if ($ENV{'TMPDIR'} && $ENV{'TEMPDIR'}) {
	&warning('both TMPDIR and TEMPDIR are set.  Using TMPDIR.');
    }
    $Tempdir = $ENV{'TMPDIR'} || $ENV{'TEMPDIR'} || $Tempdir;
}


#
# sanity checks (fatal)
#

my $switch;
my $num;

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

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

if ($Nice) {
    unless ($Nice =~ /^-?\d+$/) {
	&fatal("your nice value must be an integer!");
    }
    if (($Nice < 0) && ($< != 0)) {
	&fatal("sorry, your nice value must be positive!");
    }
}

if ($opt{'M'} && ($Mult !~ /^(((\d*\.)?\d+)|(\d+(\.\d*)?))$/ || $Mult == 0)) {
    &fatal("-M argument must be a positive number!");
}

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("font file `$Font' does not exist!") if ($Font && !-e $Font);
&fatal("filename file `$Namefile' does not exist!")
    if ($Namefile && !-e $Namefile);

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

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

&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);

&fatal('-O and -o switches can\'t be used together.')
    if ($opt{'o'} && $AutoOff);


#
# sanity checks (warnings)
#

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

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

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('-a and -r specified!  Ignoring -r.') if $opt{'r'};
    &warning('-a and -c 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'};
}

if ($opt{'z'} && !$Borders) {
    &warning('-z specified without -B!  Ignoring -z.');
}

unless ($Labels || $More) {
    &warning('-F specified without -l or -m!  Ignoring -F.') if $Font;
    &warning('-T specified without -l or -m!  Ignoring -T.') if $opt{'T'};
}
unless ($Labels) {
    &warning('-b specified without -l!  Ignoring -b.') if $Base;
}

&warning('-I specified without -i!  Ignoring -I.') if ($opt{'I'} && !$Ident);

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

&warning('-u and -U specified!  Ignoring -u.') if ($Uniq && $ICUniq);

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

if ($Left && $Right) {
    &warning('-R and -L cancel each other out!');
    $Left = $Right = 0;
}


#
# strip leading dot from $DefFmt and $Format
#

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

#
# process output format
#

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

if (@badext = grep(!defined($encode{$_}), @suffs)) {
    &fatal(sprintf('unrecognized 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, "$Qprog $Quant") if $Quant;

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


#
# get filenames from named file
#

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;

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


#
# start up the signal handler.
#

my @tfie;

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


#
# look for and process parameter files listed as arguments
#

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

my @newlist;
my $pcount = 1;

my $file;

my %sheetname;
my %esheetname;
my %parameters;

my $sn;
my $fn;
my @xywh;

foreach $file (@filelist) {
    unless ($file =~ /\.$Suffix$/) {
	push(@newlist, $file);
	next;
    }

    unless (open(PARAM, "<$file")) {
	&skip("can't open `$file' for reading: $!");
	next;
    }

    while (<PARAM>) {
	next if (/^\s*#/ || /^\s*$/);
	s/#.*$//;
	if (($fn, @xywh) = /^\s*(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*$/) {
	    push(@newlist, $fn);
	    $esheetname{$fn} = "$Tempdir/icp$pcount-$$";
	    $parameters{$fn} = "@xywh";
	    ($sn = $file) =~ s/\.$Suffix$//;
	    if ($sheetname{$fn}) {
		&warning("`$fn' will be cut from `$sn' instead of `",
			$sheetname{$fn}, "'!");
	    }
	    $sheetname{$fn} = $sn;
	} else {
	    &warning("can't understand line $. of `$file'!");
	}
    }
    close(PARAM);
    $pcount++;
}
@filelist = @newlist;


#
# take the basenames once and for all.
#

my %basename;

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


#
# uniq filenames
#

if ($Uniq || $ICUniq) {
    my %seen;
    my $target;

    @newlist = ();

    foreach (@filelist) {
	$target = $Base ? $basename{$_} : $_;
	$target =~ tr/A-Z/a-z/ if ($ICUniq);
	if ($seen{$target}++) {
	    &info("removing duplicate `$_' from file list");
	} else {
	    push(@newlist, $_);
	}
    }
    @filelist = @newlist;
}


#
# sort filenames
#

if ($Sort) {
    if ($Base) {
	@filelist = sort by_basename @filelist;
    } else {
	@filelist = sort @filelist;
    }
}


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

my $pbmtext;
my $colorize;
my $cwidth;
my $cheight;

if ($Labels || $More) {
    $pbmtext = 'pbmtext' . ($Font ? " -font '$Font'" : ' -builtin fixed');
    open(TEXT, "$pbmtext 'M' | pnmfile |") || 
	&fatal("can't run `$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);

    $cwidth = int($1 / 3);
    $cheight = $2;

    if (($Text eq 'black') && ($Back eq 'white')) {
	$colorize = '';
    } elsif (($Text eq 'white') && ($Back eq 'black')) {
	$colorize = " | pnminvert";
    } else {
	$colorize = " | pnmdepth 255 | pgmtoppm $Text-$Back";
    }
}


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

my $scount;

if ($opt{'o'}) {
    $scount = $Offset;
} elsif ($AutoOff) {
    opendir(DESTDIR, $Dir) ||
	&fatal("can't open destination directory to find offset: $!!");

    my ($last) = reverse sort grep(/^$Prefix([0-9]+)\.$Format$/,
	    readdir(DESTDIR));

    closedir(DESTDIR);

    if ($last) {
	$last =~ /^$Prefix([0-9]+)\.$Format$/;
	$scount = $1 + 1;
    } else {
	$scount = 1;
    }
} else {
    $scount = 1;
}


#
# figure out what color borders to use
#

my $stripes = my @stripe = split(' ', $Stripe) if $Borders;


#
# a few initializations...
#

my $just = $Left ? ' -jl' : ($Right ? ' -jr' : '');

my $temp = "$Tempdir/ict-$$";
my $backtemp = "$Tempdir/icc-$$";

my $icount = 1;
my $rcount = 1;

my $iqwidth = 0;
my $iqheight = 0;
my $rqheight = 0;

my @ipqueue;
my @rpqueue;
my @fpqueue;

my @iqueue;
my @rqueue;

my $ziwidth;
my $ziheight;
my $zxoff;
my $zyoff;

my $iwidth;
my $iheight;

my $miwidth;
my $miheight;

my $image;
my $row;


#
# create one pad file for all the images if $Ident
#

my $pad;
my $command;

if ($Ident) {
    $pad = "$Tempdir/ice-$$";

    $command = "ppmmake $Pad $Width $Height > $pad";

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


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

my $border;

if ($Borders && $Ident) {
    my $count = 2;
    my $color;

    $border = "$Tempdir/icb-$$";

    $command = sprintf('ppmmake %s %d %d > %s',
	$stripe[$[], ($Width + $count), ($Height + $count), $border);

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

    foreach $color (@stripe[$[+1..$#stripe]) {
	$count += 2;

	$command = sprintf('ppmmake %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);
    }
}


#
# process each file
#

my $bg;
my $color;
my $label;
my $over;
my $padlabel;
my $slots;
my $wrheight;
my $xpad;
my $ypad;
my @labellist;

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

    if ($sheetname{$file}) {
	# file is to be cut from sheet

	unless (grep(($_ eq $esheetname{$file}), @tfie)) {
	    &toppm($sheetname{$file}, $esheetname{$file}, 0) || next IMAGE;
	}
	&cut($file, $image) || next IMAGE;
	&rm($esheetname{$file}) unless
	    grep(($_ eq $esheetname{$file}), @esheetname{@filelist});
    } else {
	# file is a plain image file

	unless (-e $file) {
	    &skip("`$file' does not exist");
	    next IMAGE;
	}
	unless (-f _) {
	    &skip("`$file' is not a file");
	    next IMAGE;
	}
	&toppm($file, $image, !$NoScale) || next IMAGE;
    }

    if ($Auto || $Labels || $Borders || $Ident || $More || $Param ||
	    (($Back ne 'black') && ($Back ne 'white'))) {
	($iwidth, $iheight) = &pnmfile($image);
	if (($iwidth == 0) && ($iheight == 0)) {
	    &skip("can't find size of `$image'");
	    &rm($image);
	    next IMAGE;
	}

	if ($Param || (($Back ne 'black') && ($Back ne 'white'))) {
	    ($zxoff, $zyoff, $ziwidth, $ziheight) = (0, 0, $iwidth, $iheight);
	}
    }

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

	$command = sprintf('pnmpaste %s %d %d %s > %s', $image, $xpad, $ypad,
	    $pad, $temp);

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

	&mv($temp, $image);

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

	if ($Param || (($Back ne 'black') && ($Back ne 'white'))) {
	    $zxoff += $xpad;
	    $zyoff += $ypad;
	}

    }

    if ($Borders) {
	if ($Ident) {
	    $iwidth += $stripes * 2;
	    $iheight += $stripes * 2;

	    $command = sprintf('pnmpaste %s %d %d %s > %s', $image, $stripes,
		$stripes, $border, $temp);

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

	    &mv($temp, $image);
	} else {
	    foreach $color (@stripe) {
		$iwidth += 2;
		$iheight += 2;

		$command = sprintf('ppmmake %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;
		}

		&mv($temp, $image);
	    }
	}

	if ($Param || (($Back ne 'black') && ($Back ne 'white'))) {
	    $zxoff += $stripes;
	    $zyoff += $stripes;
	}
    }

    @labellist = ();

    if ($Labels) {
	push(@labellist, ($Base ? $basename{$file} : $file));
    }
    if ($More) {
	push(@labellist, sprintf("%dx%d", $miwidth, $miheight));
    }

    foreach $label (@labellist) {
	$slots = int($iwidth / $cwidth);

	if (($Back eq 'black') || ($Back eq 'white')) {
	    $padlabel = '';
	    $bg = "-$Back ";
	} else {
	    $command = sprintf('ppmmake %s %s %s > %s', $Back, $iwidth,
		$cheight, $backtemp);
	    unless (&shell($command)) {
		&skip("unable to create color label pad for `$file'");
		&rm($image, $backtemp);
		next IMAGE;
	    }
	    if (($slots - length($label)) >= 2) {
		$over = int(($iwidth - $cwidth * (length($label) + 2)) / 2);
	    } else {
		$over = int(($iwidth - $cwidth * $slots) / 2);
	    }
	    $padlabel = " | pnmpaste - $over 0 $backtemp";
	    $bg = '';
	}

	# pbmtext won't accept "-" as the first character of the text
	$label =~ s/^-/_/;

	if (($slots - length($label)) >= 2) {
	    $command = sprintf('%s \'%s\'%s%s | pnmcat %s-tb %s - > %s',
		$pbmtext, $label, $colorize, $padlabel,
		$bg, $image, $temp);
	} else {
	    $command = sprintf(
		'%s \'%s\'%s | pnmcut %d 0 %d %d%s | pnmcat %s-tb %s - > %s',
		$pbmtext, substr($label, 0, $slots), $colorize,
		$cwidth, ($cwidth * $slots), $cheight, $padlabel,
		$bg, $image, $temp);
	}

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

	&mv($temp, $image);

	$iheight += $cheight;
    }

    if ($Auto) {
	if ($iqwidth + $iwidth > $Xdim) {
	    if (@iqueue) {
		&image2row;
		$rcount++;
		$wrheight = $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);
	}
    } else {
	&pushimage;
	if (($icount % $Columns) == 0) {
	    &image2row;
	    &pushrow;
	    &row2sheet if (($rcount % $Rows) == 0);
	    $rcount++;
	}
    }

    $icount++;
}

if (@iqueue) {
    &image2row;
    &row2sheet if ($Auto && $rqheight + $iqheight > $Ydim);
    &pushrow;
}
&row2sheet if @rqueue;

&cleanup;

exit(0);	

&catcher('IMPOSSIBLE!');    # just to get rid of the warning...


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


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


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


sub catcher {
    &fatal("caught a SIG$_[0] -- shutting down!");
} # catcher


sub cleanup {
    &rm(@tfie);
} # cleanup


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


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

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


sub evalargs {
    my @args = @_;
    my $val;
    my $backon;

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

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


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


sub image2row {
    my $bg;
    my $toeval;

    $row = "$Tempdir/icr$rcount-$$";
    &info("assembling row $rcount");

    if (($Back eq 'black') || ($Back eq 'white')) {
	$bg = "-$Back ";
    } else {
	my $h;
	my $i;
	my $tallest = -1;
	my $w;

	foreach (@ipqueue) {
	    $h = $_->{iheight};
	    $tallest = $h if ($h > $tallest);
	}

	for ($i = 0; $i < @iqueue; $i++) {
	    $w = $ipqueue[$i]->{iwidth};
	    $h = $ipqueue[$i]->{iheight};
	    if ($h < $tallest) {
		$command = sprintf('ppmmake %s %d %d | pnmcat -tb - %s > %s',
		    $Back, $w, $tallest - $h,
		    $iqueue[$i], $backtemp);
		if (&shell($command)) {
		    &mv($backtemp, $iqueue[$i]);
		} else {
		    &warning("can't add color padding to $iqueue[$i]!");
		    &rm($backtemp);
		}
	    }
	}
	$bg = '';
    }

    # no sense in invoking pnmcat if there's only one file
    $toeval = (@iqueue > 1) ?
	'&shell("pnmcat $bg-lr -jb @iqueue > $row")' :
	'&mv(@iqueue, $row); @iqueue = (); 1';

    if (eval $toeval) {
	if ($Param || (($Back ne 'black') && ($Back ne 'white'))) {
	    push(@fpqueue, @ipqueue);
	    @ipqueue = ();
	}
    } else {
	&skip("can't assemble row $rcount");
	&rm($row);
    }
    &rm(@iqueue);
    @iqueue = ();
} # image2row


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


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

    &info("moving $src to $dest") if $Verbose;

    unless (rename($src, $dest)) {
	&fatal("unable to move `$src' to `$dest': $!!");
    }

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


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

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


sub pushimage {
    push(@iqueue, $image);
    if ($Param || (($Back ne 'black') && ($Back ne 'white'))) {
	push(@ipqueue, {
	    basename => $basename{$file},
	    rcount => $rcount,
	    iwidth => $iwidth,
	    iheight => $iheight,
	    zxoff => $zxoff,
	    zyoff => $zyoff,
	    ziwidth => $ziwidth,
	    ziheight => $ziheight
	});
    }
} # pushimage


sub pushrow {
    push(@rqueue, $row);
    if ($Param || (($Back ne 'black') && ($Back ne 'white'))) {
	push(@rpqueue, @fpqueue);
	@fpqueue = ();
    }
} # pushrow


sub pnmfile {
    my ($ppm) = @_;
    my $width;
    my $height;

    unless (open(SIZE, "pnmfile $ppm |")) {
	&warning("can't open `pnmfile $ppm |' for reading: $!!");
	return (0, 0);
    }

    unless ((($width, $height) = (<SIZE> =~ /\s+(\d+)\s+by\s+(\d+)\s+/))) {
	&warning("can't understand `pnmfile $ppm |' output!");
	close(SIZE);
	return (0, 0);
    }
    close(SIZE);

    ($width, $height);
} # pnmfile


sub rm {
    my @tbd = @_;

    &info('unlinking ', &cslist(@tbd)) if (@tbd && $Verbose);

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


sub row2sheet {
    my $bg;
    my $h;
    my $r;
    my $sheet;
    my $w;
    my $widest;
    my %height;
    my %width;

    $sheet = sprintf('%s/%s%03d.%s', $Dir, $Prefix, $scount, $Format);
    &info("assembling `$sheet'");

    if (($Back eq 'black') || ($Back eq 'white')) {
	$bg = "-$Back ";
    } else {
	my $i;
	my $f;

	# This would all be a heck of a lot easer if pnmcat took an 
	# arbitrary color as an argument.

	$f = 0;
	foreach (@rpqueue) {
	    $r = $_->{rcount};
	    $w = $_->{iwidth};
	    $h = $_->{iheight};
	    $f = $r unless $f;
	    $width{$r} = $width{$r} ? ($width{$r} + $w) : $w;
	    $height{$r} = $h if (!$height{$r} || $h > $height{$r});
	}
	($widest) = reverse sort by_number values(%width);

	for ($i = 0; $i < @rqueue; $i++) {
	    if ($width{$f + $i} < $widest) {
		$command = sprintf('ppmmake %s %d %d | pnmpaste %s %d 0 - > %s',
		    $Back, $widest, $height{$f + $i},
		    $rqueue[$i],
		    $Left ? 0 :
			$Right ? $widest - $width{$f + $i} :
			    int(($widest - $width{$f + $i}) / 2),
		    $backtemp);
		if (&shell($command)) {
		    &mv($backtemp, $rqueue[$i]);
		} else {
		    &warning("can't add color padding to $rqueue[$i]!");
		    &rm($backtemp);
		}
	    }
	}
	$bg = '';
    }

    # no sense in invoking pnmcat if we've only got one row
    $command = (@rqueue > 1) ? "pnmcat $bg-tb$just" : "cat";

    if (&shell("$command @rqueue $encodecmd> $sheet")) {
	my $pfile;

	# save the sheets from my kludge!
	&tfdelete($sheet);

	if ($Param) {
	    $pfile = "$sheet.$Suffix";
	    &info("creating `$pfile'");
	    if (open(PARAM, ">$pfile")) {
		foreach (@rpqueue) {
		    $r = $_->{rcount};
		    $w = $_->{iwidth};
		    $h = $_->{iheight};
		    $width{$r} = $width{$r} ? ($width{$r} + $w) : $w;
		    $height{$r} = $h if (!$height{$r} || $h > $height{$r});
		}

		my $xoff;
		my $yoff = 0;
		my $pastr = -1;
		($widest) = reverse sort by_number values(%width);

		my $n;
		my $zx;
		my $zy;
		my $zw;
		my $zh;

		foreach (@rpqueue) {
		    $n = $_->{basename};
		    $r = $_->{rcount};
		    $w = $_->{iwidth};
		    $h = $_->{iheight};
		    $zx = $_->{zxoff};
		    $zy = $_->{zyoff};
		    $zw = $_->{ziwidth};
		    $zh = $_->{ziheight};
		    if ($r != $pastr) {
			$pastr = $r;
			$xoff = 0;
			$yoff += $height{$r};
		    }
		    printf(PARAM "%s %d %d %d %d\n", $n,
			($Left ? 0 :
			    $Right ? int($widest - $width{$r}) :
				int(($widest - $width{$r}) / 2)) + $xoff + $zx,
			$yoff - $h + $zy, $zw, $zh);
		    $xoff += $w;
		}

		@rpqueue = ();
		close(PARAM);
	    } else {
		&warning("can't open `$pfile' for writing: $!!");
	    }
	} elsif (($Back ne 'black') || ($Back ne 'white')) {
		@rpqueue = ();
	}
    } else {
	&skip("can't assemble sheet $scount");
	&rm($sheet);
    }
    $scount++;
    &rm(@rqueue);
    @rqueue = ();
} # row2sheet


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

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

    $command = "nice -$Nice " . $command if $Nice;

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

    $pid = fork;

    if ($pid == -1) {
	&warning("fork failed: $!!");
	return 0;
    }

    if ($pid == 0) {
	{ exec $command }
	&warning("`exec $command' failed: $!!");
	return 0;
    }

    waitpid($pid, 0);

    if ($? & 255) {
	&warning("`$command' was killed by a SIG", $signals[$? & 127], '!', 
	    ($? & 128) ? '  core dumped.' : '');
	return 0;
    } elsif ($? >>= 8) {
	&warning("`$command' terminated with exit status: $?!");
	return 0;
    }
    1;
} # shell


sub skip {
    &warning(@_, '!  Skipping.');
} # skip


sub tfadd {
    my ($temporary) = @_;

    push(@tfie, $temporary) unless grep(($_ eq $temporary), @tfie);
} # tfadd


sub tfdelete {
    my ($temporary) = @_;

    @tfie = grep(($_ ne $temporary), @tfie);
} # tfdelete


sub toppm {
    my ($input, $output, $shrink) = @_;
    my $cmd;
    my $decoded;
    my $init;
    my @decodecmd;

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

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

	if (@suffs = grep(defined($decode{$_}), @suffs)) {
	    &warning(sprintf('assuming `%s\' is a `.%s\' file.',
		$input, join('.', @suffs)));
	}
    }

    unless (@suffs) {
	&warning("no extension on `$input'!",
	    "  assuming it is a `.$DefFmt' file.");
	@suffs = ($DefFmt);
    }

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

    if (@decodecmd && ($decodecmd[0] =~ tr/|/|/) == 0) {
	$init = (shift @decodecmd) . " '$input'";
    } else {
	$init = "cat '$input'";
    }

    foreach $cmd (@decodecmd) {
	$cmd =~ s/^\s*\|\s*//;
	$cmd =~ s/\s*\|\s*$//;
    }

    if ($shrink) {
	if ($More) {
	    $command = join(' | ', ($init, @decodecmd)) . " > $temp";
	    &info("decoding `$input'");
	    $decoded = $temp;
	} else {
	    $command = join(' | ', ($init, @decodecmd, "$pnmscale > $output"));
	    &info("scaling `$input'");
	    $decoded = $output;
	}
    } else {
	$command = join(' | ', ($init, @decodecmd)) . " > $output";
	&info("decoding `$input'");
	$decoded = $output;
    }

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

    if ($More) {
	($miwidth, $miheight) = &pnmfile($decoded);
	if (($miwidth == 0) && ($miheight == 0)) {
	    &warning("can't find size of `$decoded'!");
	    &rm($decoded);
	    return 0;
	}

	if ($shrink) {
	    $command = "$pnmscale $temp > $output";
	    unless (&shell($command)) {
		&warning("can't shrink `$temp'!");
		&rm($temp);
		&rm($output);
		return 0;
	    }
	    &rm($temp);
	}
    }
    1;
} # toppm


#
# 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, A, E, e, G, H, J, j, V, and W
# have not been used.  Yet.
#
sub usage {
    die "usage: $program [switches] [{image file | parameter file} ...]
[switches] consist 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 color color of the background.  default = `$d{'Back'}' 
-c #\t number of columns of images in each sheet.  default = $d{'Columns'}
-D suff\t use `suff' as the file format if image has no suffix.  default = `",
    $d{'DefFmt'}, "'
-d dir\t put sheets in `dir'.  default = `$d{'Dir'}'
-F file\t font file for labels.  default = `",
    ($d{'Font'} || 'pbmtext\'s internal font'), "'
-f suff\t use `suff' as the file format of the sheets.  default = `$d{'Format'}'
-g, +g\t generate parameter files for sheets.  default = ", &on($d{'Param'}), "
-h #\t height of each small image in pixels.  default = $d{'Height'}
-I color color of the area around images when using -i.  default = `$d{'Pad'}'
-i, +i\t pad the images so they are the same size.  default = ",
    &on($d{'Ident'}), "
-K file\t use `file' as the configuration file.  default = `$d{'Config'}'
-k, +k\t don't reference the configuration file.  default = ",
    &on($d{'Ignore'}), "
-L, +L\t left justify all the rows.  default = ", &on($d{'Left'}), "
-l, +l\t add a label containing the file name of the image.  default = ",
    &on($d{'Labels'}), "
-M scale resize all the images to `scale'*100 percent.  default = `",
    ($d{'Mult'} || 'don\'t scale.'), "'
-m, +m\t add a label containing the size of the image.  default = ",
    &on($d{'More'}), "
-N #\t run child processes at this nice value.  default = $d{'Nice'}
-n file\t get filenames from `file'.  default = none
-O, +O\t find the number for the first sheet automatically.  default = ",
    &on($d{'AutoOff'}), "
-o #\t start at this number when naming sheets.  default = $d{'Offset'}
-P suff\t suffix of parameter files.  default = `$d{'Suffix'}'
-p name\t name of the sheets. default = `$d{'Prefix'}'
-Q prog\t the quantization program.  default = `$d{'Qprog'}'
-q #\t number of colors in each sheet.  default = $d{'Quant'}
-R, +R\t right justify all the rows.  default = ", &on($d{'Right'}), "
-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 color color of label text.  default = `$d{'Text'}'
-t dir\t use `dir' to hold temporary files.  default = `$d{'Tempdir'}'
-U, +U\t remove duplicate names from file list, ignoring case.  default = ",
    &on($d{'ICUniq'}), "
-u, +u\t remove duplicate names from file list, keeping case.  default = ",
    &on($d{'Uniq'}), "
-v, +v\t be verbose.  default = ", &on($d{'Verbose'}), "
-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 screen width in pixels.  default = $d{'Xdim'}
-Y, +Y\t make images the same height.  default = ", &on($d{'Ysame'}), "
-y #\t screen height in pixels.  default = $d{'Ydim'}
-Z, +Z\t don't resize the input images.  default = ", &on($d{'NoScale'}), "
-z list\t list of colors for border stripes.  default = `$d{'Stripe'}'
";
} # usage


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