#!/afs/athena/contrib/perl/p

# 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.

$program = 'icontact';
$version = '1.2 (14jun92)';
$copyright = 'Copyright (C) 1992';
$author = 'Mark B. Hanson (cs62a12@wind.ucsd.edu)';


#
# default values for parameters that correspond to command line switches
#
# Leave these alone if you want them to match the man page.
# Use a configuration file to customize icontact to your liking.
#

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

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

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

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

$Config = '';       # string,   name of an alternate configuration file

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

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

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

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

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

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

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

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

$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.  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.
#

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

%decode = (
    'Z',        'trap \'exit 130\' 2; zcat',
    'atk',      'atktopbm',
    'brush',    'brushtopbm',
    'cmuwm',    'cmuwmtopbm',
    'fits',     'fitstopgm',
    'fs',       'fstopgm',
    'g3',       'g3topbm',
    'gem',      'gemtopbm',
    'gif',      'giftoppm',
    'gould',    'gouldtoppm',
    'hips',     'hipstopgm',
    'icon',     'icontopbm',
    'ilbm',     'ilbmtoppm',
    'jpg',      'djpeg',
    'lispm',    'lispmtopgm',
    'macp',     'macptopbm',
    'mgr',      'mgrtopbm',
    'mtv',      'mtvtoppm',
    'pbm',      '',
    'pcx',      'pcxtoppm',
    'pgm',      '',
    'pi1',      'pi1toppm',
    'pi3',      'pi3toppm',
    'pict',     'picttoppm',
    'pj',       'pjtoppm',
    'ppm',      '',
    'qrt',      'qrttoppm',
    'rast',     'rasttopnm',
    'spc',      'spctoppm',
    'spu',      'sputoppm',
    'tga',      'tgatoppm',
    'tiff',     'tifftopnm',
    'xbm',      'xbmtopbm',
    'xim',      'ximtoppm',
    'xpm',      'xpmtoppm',
    'xwd',      'xwdtopnm',
    'ybm',      'ybmtopbm',
    'yuv',      'yuvtoppm',
);


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

%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',      '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',
    '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.
#

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


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

%optvar = (
    'a', 'Auto',    'B', 'Borders', 'b', 'Base',    'c', 'Columns',
    'd', 'Dir',     'F', 'Font',    'f', 'Format',  'g', 'Param',
    'h', 'Height',  'i', 'Ident',   'K', 'Config',  'k', 'Ignore',
    'l', 'Labels',  'n', 'Namefile','O', 'AutoOff', 'o', 'Offset',
    'P', 'Suffix',  'p', 'Prefix',  'q', 'Quant',   'r', 'Rows',
    'S', 'Sort',    's', 'Silent',  't', 'Tempdir', '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
#

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 before processing the configuration file
# to get the -k and -K options
#

&evalargs(@ARGV);


#
# process the configuration file
#

unless ($Ignore) {
    local($home) = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7];
    local($cfile) = $Config || ($home && "$home/.icrc");

    if ($cfile) {
	if (-f $cfile) {
	    if (-e _) {
		if (open(CONFIG, "<$cfile")) {
		    local($v, $f, $c, $line, @switches);
		    for ($line = 1; $_ = <CONFIG>; $line++) {
			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 = split(/\s+/, $1);
			    while (@switches = &evalargs(@switches)) {
				&warning('Ignoring `', shift @switches,
				    "' on line $line of $cfile");
			    }
			} else {
			    &warning("can't understand line $line of `$cfile'");
			}
		    }
		    close CONFIG;
		} else {
		    &warning("can't open `$cfile': $!!");
		}
	    }
	} else {
	    &warning("`$cfile' is not a file!  Configuration file not used.");
	}
    } else {
	&warning("can't find your home directory!",
	    'Configuration file not found.');
    }
}


#
# evaluate arguments after processing the configuration file
# (yeah, this is sort of ugly.)
#

@ARGV = &evalargs(@ARGV);


#
# sanity checks (fatal)
#

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

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

&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 ($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/^\.//;

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

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

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

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

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

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


#
# get filenames from named file
#

@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;

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';


#
# look for and process parameter files
#

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

@newlist = ();
$pcount = 1;

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

    unless (open(PARAM, "<$file")) {
	&skip("can't open `$file' for reading: $!!");
	next;
    }
    
    local($fn, @xywh, $line);
    for ($line = 1; $_ = <PARAM>; $line++) {
	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";
	    ($sheetname{$fn} = $file) =~ s/\.$Suffix$//;
	} else {
	    &warning("can't understand line $line of `$file'!");
	}
    }
    close(PARAM);
    $pcount++;
}
@filelist = @newlist;


#
# uniq filenames
#

if ($Uniq) {
    local(%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
#

if ($Labels) {
    $pbmtext = 'pbmtext' . ($Font ? " -font '$Font'" : '');
    open(TEXT, "$pbmtext 'M' | 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);

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

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


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

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

    local($last) =
	reverse sort grep(/^$Prefix([0-9]{3,})\.$Format$/, readdir(DESTDIR));

    closedir(DESTDIR);

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


#
# a few initializations...
#

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

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

$temp = "$Tempdir/ict-$$";

$icount = $rcount = 1;

$iqwidth = $iqheight = $rqheight = 0;

@ipqueue = @fpqueue = @rpqueue = ();

@tfie = ();


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

if ($Borders && $Ident) {
    $border = "$Tempdir/icb-$$";

    local($count) = 2;

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

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

    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'!");
    }
}


#
# process each file
#

IMAGE: while ($file = shift @filelist) {
    $image = "$Tempdir/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
	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;
    }

    $label = ($Base ? $basename{$file} : $file);

    if ($Auto || $Labels || $Borders || $Param || $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);

	($zxoff, $zyoff, $ziwidth, $ziheight) = (0, 0, $iwidth, $iheight)
	    if ($Param);
    }

    if ($Ident) {
	$xpad = int(($Width - $iwidth) / 2);
	$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 ($Param) {
	    $zxoff += $xpad;
	    $zyoff += $ypad;
	}

    }

    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 {
	    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 ($Param) {
	    $zxoff += 3;
	    $zyoff += 3;
	}
    }

    if ($Labels) {
	$slots = int($iwidth / $cwidth);

	if ($slots - length($label) > 1) {
	    $command = sprintf('%s \'%s\'%s | pnmcat -%s -tb %s - > %s',
		$pbmtext, $label, $invert, $background, $image, $temp);
	} else {
	    $command = sprintf(
	    '%s \'%s\'%s | pnmcut %d 0 %d %d | pnmcat -%s -tb %s - > %s',
		$pbmtext, substr($label, 0, $slots), $invert, $cwidth,
		($cwidth * $slots), $cheight, $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) {
	    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('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 {
    local($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;
}


sub evalargs {
    local(@args) = @_;

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

	if (/^[-+]help$/) {                                 # `h' special case
	    &usage;
	} elsif (/^[-+]([cdFfhKnoPpqrtwxy])$/) {            # argument
	    if (@args) {
		eval "\$opt{'$1'} = 1; \$$optvar{$1} = shift \@args";
	    } else {
		&fatal("no argument given for -$1 switch!");
	    }
	} elsif (/^([-+])([aBbgiklOSsuvWXY])(.*)$/) {       # no argument
	    $val = ($1 eq '-');
	    $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/icr$rcount-$$";
    unless (&shell("pnmcat -$background -lr -jbottom @iqueue > $row")) {
	&skip("can't assemble row $rcount!");
	&rm($row);
    }
    if ($Param) {
	push(@fpqueue, @ipqueue);
	@ipqueue = ();
    }
    &rm(@iqueue);
    @iqueue = ();
}


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


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

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

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


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

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


sub pushimage {
    push(@iqueue, $image);
    if ($Param) {
	push(@ipqueue, pack("a255I7", $label, $rcount, $iwidth, $iheight,
			    $zxoff, $zyoff, $ziwidth, $ziheight));
    }
}


sub pushrow {
    push(@rqueue, $row);
    if ($Param) {
	push(@rpqueue, @fpqueue);
	@fpqueue = ();
    }
}


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


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

    if ($Param) {
	local($pfile) = "$sheet.$Suffix";
	&info("creating `$pfile'");
	if (open(PARAM, ">$pfile")) {
	    local(%height, %width, $r, $h, $w, $n, $zx, $zy, $zw, $zh);

	    foreach (@rpqueue) {
		($n, $r, $w, $h, $zx, $zy, $zw, $zh) = unpack("A255I7", $_);
		$width{$r} = $width{$r} ? ($width{$r} + $w) : $w;
		$height{$r} = $h if (!$height{$r} || $h > $height{$r});
	    }

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

	    foreach (@rpqueue) {
		($n, $r, $w, $h, $zx, $zy, $zw, $zh) = unpack("A255I7", $_);
		if ($r != $pastr) {
		    $pastr = $r;
		    $xoff = 0;
		    $yoff += $height{$r};
		}
		printf(PARAM "%-40s %5d %5d %5d %5d\n", $n,
			int(($widest - $width{$r}) / 2) + $xoff + $zx,
			$yoff - $h + $zy,
			$zw, $zh);
		$xoff += $w;
	    }

	    @rpqueue = ();
	    close(PARAM);
	} else {
	    &warning("can't open $pfile: $!!\n");
	}
    }
    $scount++;
    &rm(@rqueue);
    @rqueue = ();
}


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

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

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

    system $command;

    if ($? & 255) {
	&warning("`$command' was killed by signal: ", ($? & 127), '.', 
	    ($? & 128) ? "core dumped." : '');
	return 0;
    } elsif ($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 {
    local($file) = @_;
    push(@tfie, $file) unless grep(/^$file$/, @tfie);
}


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


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

    local(@suffs) = split(/\./, $basename{$input});
    shift @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;
    }

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

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

    local($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 | parameter 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'), "'
-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, +i\t make images the same size.  default = ", &on($d{'Ident'}), "
-K file\t use `file' as the configuration file.  default = `",
    ($d{'Config'} || '~/.icrc'), "'
-k, +k\t don't reference the configuration file.  default = ",
    &on($d{'Ignore'}), "
-l, +l\t put labels under the images.  default = ", &on($d{'Labels'}), "
-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 #\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'}'
-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 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'}
";
}


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