#!/usr/local/bin/perl
#
# contact.perl - take a list of image files from stdin and convert into
# interlaced/transparent GIF contact sheets and imagemap files
#
# WARNING: USE AT YOUR OWN RISK.
#
# author: kwhite@csi.uottawa.ca
# many useful hints and ideas: rck@sgi.com
#
$WIDTH = 572; # maximum width of contact sheet
$HEIGHT = 572; # maximum height
$PICW = 64; # maximum width of preview images
$PICH = 64; # maximum height
$WW = 2; # White Width of border around preview images
$BW = 3; # Black Width of border (will become transparent)
$TP = 3; # padding around image name text
$BDFFILE = "/home1/X11R6/xc/fonts/bdf/75dpi/helvBO12.bdf";
# bdf file to use for image name font
$DITHER = "ppmdither";
$SERVER = "http://www.csi.uottawa.ca";
$LOCPREFIX = "$SERVER/ftppub/beermats";
$INDEX = "index.html";
$TEXT = "text.html";
$MAP = "map.html";
$CGIIMAGEMAP = "cgi-bin/imagemap";
$RCFILE = ".contact.perlrc";
$quiet = 0; # set this to 0 to see the action
$wanttext = 1; # set this to 1 to create the $TEXT file
$wantindex = 1; # set this to 1 to create the $INDEX file
$deletesmall = 1; # set this to 1 to delete the created icons
$smalldir = ""; # set this to the directory where the icons will
# be kept. If this is set to NULL, $TMP will be used
$addtext2pic = 1; # set this to 0 if you don't want the filename
# in the images
$shadowshift = 1; # how far to offset the text shadow (black) image
$makeitfit = 0; # make this 1 to automatically work out PICW and PICH
# based on WIDTH and HEIGHT and the number of readable
# input image files
$TMP = "/tmp" unless $TMP = $ENV{"TMPDIR"};
# pbmtext uses 7 pixels per character plus one each size for padding
# so the maximum number of characters we can have in a name is
# $MAXNAMELEN = int($PICW / 7) - 2;
#
# that's what it *used* to be, it's now different with netpbm...
@files=<>;
#print "@files ($#files)\n";
&readrcfile;
$smalldir = $TMP unless $smalldir;
@files = &checkfiles(@files);
&makeitfit(*files) if $makeitfit;
&makeindex(@files) if $wantindex;
&maketext(@files) if $wanttext;
@smallfiles = &makesmall(@files);
&showsmall(@smallfiles) unless $quiet;
@deletefiles = @smallfiles if $deletesmall;
while (@list = &hjustify(*smallfiles, $WIDTH)) {
#print "hjustify: @list\n";
@list = &haddtopleft(@list);
#print "haddtopleft: @list\n";
push(@vlist, ($#list - 1) / 3, @list)
}
open(MAP, "> $MAP");
print MAP " Exciting clickable image map
Exciting clickable image map
\n";
$num = 0;
while (@list = &vjustify(*vlist, $HEIGHT)) {
#print "vjustify: @list\n";
@list = &vaddtopleft(@list);
#print "vaddtopleft = @list\n";
&makegifnmap(*list, $num++);
}
print MAP "\n";
close(MAP);
unlink(@deletefiles);
exit 0;
############
sub makesmall {
local(@files) = @_;
#print "ppmmake \\#000 $WIDTH $HEIGHT > $TMP/x$contact.ppm\n";
#
# make the small preview images with padding and text
#
foreach $i (@files) {
#chop $i; # this has been done by checkfiles
$converttoppm = &converter($i);
if (!$converttoppm) {
print "No converter for $i\n";
next;
}
$i =~ /([^\/]+)$/;
$smallfile = "$smalldir/$1.small";
$name = $1;
$orig_file{$smallfile} = $name;
push(@smallfiles, $smallfile);
if (-r $smallfile) {
($pic_xsize, $pic_ysize) =
`pnmfile $smallfile` =~ /(\d+) by (\d+)/;
if ($pic_xsize && $pic_ysize &&
($pic_xsize + 2 * ($WW + $BW) <= $PICW) &&
($pic_ysize + 2 * ($WW + $BW) <= $PICH)) {
$pic_xsize{$smallfile} = $pic_xsize;
$pic_ysize{$smallfile} = $pic_ysize;
print "Using existing $name icon\n" unless $quiet;
next;
}
else {
print "Existing $name icon wrong format\n" unless $quiet && $pic_xsize && $pic_ysize;
print "Existing $name icon too large\n" if (!$quiet && ($pic_xsize && $pic_ysize));
}
}
system "$converttoppm $i | pnmscale -xysize $PICW $PICH | \
pnmpad -white -l$WW -r$WW -t$WW -b$WW | \
pnmpad -black -l$BW -r$BW -t$BW -b$BW > $smallfile";
($pic_xsize, $pic_ysize) = `pnmfile $smallfile` =~ /(\d+) by (\d+)/;
$pic_xsize{$smallfile} = $pic_xsize; $pic_ysize{$smallfile} = $pic_ysize;
#print "ppmmake 000 $pic_xsize $pic_ysize\n";
print "$name $pic_xsize x $pic_ysize\n" unless $quiet;
next unless $addtext2pic;
if (!$pbmtext) {
if ($BDFFILE && -r $BDFFILE) {
$pbmtext = "pbmtext -font $BDFFILE";
}
else {
$pbmtext = "pbmtext";
}
}
# $MAXNAMELEN = int($pic_xsize / 7) - 2;
# $name = (length($name) > $MAXNAMELEN) ? substr($name, 0, $MAXNAMELEN) : $name;
system "ppmmake \\#000 $pic_xsize $pic_ysize | pnmdepth 8 > $TMP/t0.ppm";
# system "pnmpaste $TMP/y.ppm 0 0 $TMP/t0.ppm > $TMP/z.ppm";
# system "mv $TMP/z.ppm $TMP/y.ppm";
($xx, $yy) = (`$pbmtext $name | pnmcrop 2>/dev/null | \
pnmfile` =~ /(\d+) by (\d+)/);
#print "text size wants to be $xx by $yy\n" unless $quiet;
$tw = &MIN($xx, $pic_xsize - 2*($WW+$BW+$TP) - $shadowshift);
#print "text width to be $tw\n" unless $quiet;
system "$pbmtext $name | pnmcrop 2>/dev/null | pnmcut 0 0 $tw $yy | \
pnmpad -l$TP -r$TP -b$TP -t$TP -white > $TMP/t1.pbm";
($txt_xsize, $txt_ysize) = `pnmfile $TMP/t1.pbm` =~ /(\d+) by (\d+)/;
system "ppmmake \\#555 $txt_xsize $txt_ysize | pnmdepth 8 > $TMP/t1.ppm";
$xx = $WW + $BW; $yy = $WW + $BW;
system "pnmpaste $TMP/t1.ppm $xx $yy $TMP/t0.ppm > $TMP/t2.ppm";
system "pnmarith 2>/dev/null -subtract $smallfile $TMP/t2.ppm > $TMP/z.ppm";
rename("$TMP/z.ppm", "$smallfile");
system "pnminvert < $TMP/t1.pbm > $TMP/t2.pbm";
system "pbmmake -black $pic_xsize $pic_ysize > $TMP/t3.pbm";
system "pnmpaste $TMP/t2.pbm $xx $yy $TMP/t3.pbm > $TMP/t1.pbm";
$xx += $shadowshift; $yy += $shadowshift;
system "pnmpaste $TMP/t2.pbm $xx $yy $TMP/t3.pbm > $TMP/t4.pbm";
system "pnmarith 2>/dev/null -subtract $smallfile $TMP/t4.pbm > $TMP/t5.ppm";
system "pnmarith 2>/dev/null -add $TMP/t1.pbm $TMP/t5.ppm > $smallfile";
unlink <$TMP/t?.p[bp]m>;
}
@smallfiles;
}
###########
sub showsmall {
local(@smallfiles) = @_;
local($i);
foreach $i (@smallfiles) {
print "$i $pic_xsize{$i} $pic_ysize{$i}\n" unless $quiet;
}
}
###########
sub hjustify {
local(*smallfiles, $width) = @_;
local($y) = 0;
local($x) = 0;
local(@files);
local($file);
while ($file = shift(@smallfiles)) {
#print "doing $file\n";
if (($pic_xsize{$file} + $x) > $width) {
unshift(@smallfiles, $file);
#print "@files x = $x, maxy = $y\n";
return ($x, $y, @files);
}
else {
push(@files, $file);
$y = $pic_ysize{$file} if $pic_ysize{$file} > $y;
$x += $pic_xsize{$file};
}
}
if (@files) {
#print "shifted out @files x = $x, maxy = $y\n";
($x, $y, @files);
}
else {
@files;
}
}
##############
sub vjustify {
local(*vlist, $height) = @_;
local($x, $y, $curx, $cury, $i, @list, $file, $picx, $picy);
$curx = $cury = 0;
while ($i = shift(@vlist)) {
#print "vjustify: doing $i @vlist...\n";
$x = shift(@vlist); $y = shift(@vlist);
if ($y + $cury > $height) {
unshift(@vlist, $i, $x, $y);
#print "returning $curx $cury @list\n";
return ($curx, $cury, @list);
}
$curx = $x if $x > $curx;
push(@list, $i, $x, $y);
while ($i--) {
$file = shift(@vlist);
$picx = shift(@vlist);
$picy = shift(@vlist);
push(@list, $file, $picx, $picy + $cury);
}
$cury += $y;
}
if (@list) {
#print "shifted out $curx $cury @list\n";
($curx, $cury, @list);
}
else {
@list;
}
}
##############
sub haddtopleft {
local(@list) = @_;
local(@topleft);
local($width, $height, $x, $y);
$width = shift(@list);
$height = shift(@list);
push(@topleft, $width, $height);
$x = 0;
while ($file = shift(@list)) {
$y = int(($height - $pic_ysize{$file}) / 2);
push(@topleft, $file, $x, $y);
$x += $pic_xsize{$file};
}
@topleft;
}
###############
sub vaddtopleft {
local(@list) = @_;
local(@topleft);
local($fullwidth, $fullheight, $width, $height, $x, $y, $file);
$fullwidth = shift(@list);
$fullheight = shift(@list);
push(@topleft, $fullwidth, $fullheight);
while ($i = shift(@list)) {
$width = shift(@list);
$height = shift(@list);
push(@topleft, $i, $width, $height);
while ($i--) {
$file = shift(@list);
$x = shift(@list);
$y = shift(@list);
$x += int(($fullwidth - $width) / 2);
push(@topleft, $file, $x, $y);
}
}
@topleft;
}
exit 0;
###################
sub makegifnmap {
local(*list, $num) = @_;
local($file, @files, @acfiles, $i, $start);
local(@maskfiles, $masknum, @maskacfiles);
local($firstfile, $lastfile);
open(IMAGEMAP, "> all$num.map");
print "making gif and map $num\n" unless $quiet;
$start = 0;
$totwidth = shift(@list);
$totheight = shift(@list);
while ($i = shift(@list)) {
@files = ();
@maskfiles = ();
$masknum = 0;
shift(@list); shift(@list);
while ($i--) {
$file = shift(@list);
$firstfile = $file unless $firstfile;
$lastfile = $file;
$x = shift(@list);
$y = shift(@list);
push(@files, $file);
$xx = $pic_xsize{$file} + $x;
$yy = $pic_ysize{$file} + $y;
print IMAGEMAP "rect $LOCPREFIX/$orig_file{$file} $x,$y $xx,$yy\n";
$xx = $pic_xsize{$file} - (2 * $BW);
$yy = $pic_ysize{$file} - (2 * $BW);
system("pbmmake -black $xx $yy | \
pnmpad -white -l$BW -r$BW -t$BW -b$BW > $TMP/mask$masknum.pbm");
push(@maskfiles, "$TMP/mask$masknum.pbm");
++$masknum;
}
system("pnmcat -lr -black @files > $TMP/$start.across");
system("pnmcat -lr -white @maskfiles > $TMP/mask$start.across");
unlink(@maskfiles);
push(@acfiles, "$TMP/$start.across");
push(@maskacfiles, "$TMP/mask$start.across");
++$start;
}
# system("pnmcat -tb -black @acfiles | ppmtopgm | \
# pgmtopbm -thresh -value 0.999 | pnminvert | pbmmask > $TMP/mask.pbm");
system("pnmcat -tb -white @maskacfiles > $TMP/mask.pbm");
($x, $y) = `pnmfile $TMP/mask.pbm` =~ /(\d+) by (\d+)/;
system "ppmmake \\#868 $x $y | pnmdepth 8 | \
pnmarith 2>/dev/null -mult - $TMP/mask.pbm > $TMP/mask.ppm";
print "making transparent gif\n" unless $quiet;
system "pnmcat -tb -black @acfiles | pnmdepth 255 | $DITHER | \
pnmarith 2>/dev/null -add - $TMP/mask.ppm | \
ppmtogif -transparent \\#868 -interlace > all$num.gif";
unlink(@acfiles, @maskacfiles, "$TMP/mask.ppm", "$TMP/mask.pbm");
print IMAGEMAP "default $LOCPREFIX/$orig_file{$firstfile}\n";
close(IMAGEMAP);
print MAP "\n";
if ($firstfile ne $lastfile) {
print MAP "$orig_file{$firstfile} .. $orig_file{$lastfile}
";
}
else {
print MAP "$orig_file{$firstfile}
\n";
}
print MAP "
";
}
############
sub makeindex {
local(@files) = @_;
open(INDEX, "> $INDEX");
print INDEX "
Images
Images
These images are availalable via:
You can find out more about how this was
done automatically.
\n";
close INDEX;
}
#############
sub maketext {
local(@files) = @_;
local($file, $name, $converttoppm, $x, $y, $size, $line);
open(TEXT, "> $TEXT");
print TEXT "
Dull text mode
Dull text mode
\n";
while ($file = shift(@files)) {
# chop($file); # this has been done by checkfiles
($name) = ($file =~ /([^\/]+)$/);
if ($size = (stat($file))[7]) {
$size = int($size / 1024);
$size = "${size}K";
}
else {
$size = "unknown size";
}
$converttoppm = &converter($file);
($x, $y) = `$converttoppm $file | pnmfile` =~ /(\d+) by (\d+)/;
print TEXT "\t- $name ($x by $y pixels -- $size)\n";
print "adding $name ($x by $y) to $TEXT\n" unless $quiet;
}
print TEXT "
Are you sure you wouldn't rather have nice image mode?
\n";
close(TEXT);
}
#########
sub converter {
local($file) = @_;
local($converttoppm);
$converttoppm = "";
$converttoppm = "djpeg" if $file =~ /\.jpg$/i;
$converttoppm = "giftopnm" if $file =~ /\.gif$/i;
$converttoppm;
}
########
sub MAX {
local($a, $b) = @_;
$a > $b ? $a : $b;
}
########
sub MIN {
local($a, $b) = @_;
$a < $b ? $a : $b;
}
###############
sub checkfiles {
local(@files) = @_;
local(@checkedfiles);
local($file);
foreach $file (@files) {
chop($file) if $file =~ /[\r\n]$/;
#print "Checking $file\n" unless $quiet;
if (-r $file) {
push(@checkedfiles, $file);
print "$file readable\n" unless $quiet;
next;
}
elsif ($file =~ /[ \t]/) {
print "Hmmm, whitespace in filenames. ls -C perchance?\n" unless $quiet || $beencute;
++$beencute;
push(@checkedfiles, &checkfiles(split(' ', $file)));
}
else {
print "$file unreadable\n" unless $quiet;
}
}
@checkedfiles;
}
########
sub readrcfile {
if (-r "$RCFILE") {
do "$RCFILE";
}
elsif (-r "$ENV{'HOME'}/$RCFILE") {
do "$ENV{'HOME'}/$RCFILE";
}
}
#########
sub makeitfit {
local(*files) = @_;
local($numfiles) = $#files + 1;
local($nx, $ny);
#print "PICW/PICH currently $PICW/$PICH, WIDTH/HEIGHT currently $WIDTH/$HEIGHT\n";
#print "We need to fit $numfiles in there...\n";
$nx = int(sqrt($numfiles * $WIDTH / $HEIGHT) + 0.999999);
$ny = int($numfiles/$nx + 0.999999);
print "we'll have roughly $nx across, and $ny down\n" unless $quiet;
$PICW = int($WIDTH/$nx) - 2*($BW + $WW);
$PICH = int($HEIGHT/$ny) - 2*($BW + $WW);
print "each preview image will be at most $PICW by $PICH within the $WIDTH by $HEIGHT image\n" unless $quiet;
}