#!/usr/contrib/bin/perl

# Photomosaic program, 1/11/99, version 1.2, by Eric Haines, erich@acm.org
#
# This program takes an image (which we call the target image) and a set of
# "pixel" images and composes a large mosaic image from the pixel images which
# make up the target image. See http://www.photomosaic.com for some commercial
# examples. This program currently handles only grayscale photomosaics.
# My photomosaic of Don Greenberg, etc, is at
# http://www.acm.org/tog/editors/erich/DPG/DPG.html

# Preparation:
# You need to create a target image and a set of pixel images. All images
# must be grayscale, and must be saved as PGM (Portable Grayscale bitmap)
# binary (P5) format - this is what this script reads in. All pixel images
# must be the same size. Personally, I've only used 64x64, so you're taking
# your chances if you use some other size. Picking a power of 2 is good
# because then you can easily downsample using this program's $subsample
# parameter (see Options). The pixel images should be stored with a suffix
# ".pnm". The target image is best stored with suffix ".pgm" (just to
# differentiate it). Actually, it would probably be best to reverse these,
# but that's how I did it and how the program's set up to read them.
#
# Tools I used for preparing images (Wintel):
# - Perl itself: get it from http://www.perl.org for your machine.
# - Hypersnap, shareware at http://www.hyperionics.com - in gathering images
#   from the web I occasionally ran into a JPEG that Paint Shop Pro could not
#   read. I used this screen capture tool along with Netscape in those cases.
# - Paint Shop Pro, shareware at http://www.jasc.com - handy for cropping and
#   resizing images. The subsampling stinks (it simply grabs pixels instead of
#   blending samples), so you'll want to blur images before reducing them to
#   64x64.
# - Image Alchemy, shareware at http://www.handmadesw.com - good for batch
#   conversion of images to various formats. Unfortunately it does not have
#   a good way of automatically squaring off rectangular images. For that
#   process I mostly used:
# - JASC Image Robot, shareware at http://www.jasc.com - not great, but better
#   than doing hundreds of images by hand.
# If you're on Unix, check http://www.acm.org/tog/Software.html for image
# manipulation packages (NetPBM, xv, ImageMagick, and GIMP come to mind).

# Usage: perl photomosaic.prl target_image.pgm
# This will read the target_image.pgm and will read all *.pnm images in the
# current directory as pixel images, then will create the photomosaic image
# and call it target_image.pgm.pgm. Note that this output image will be HUGE,
# for example a 64x75 target image with 64x64 image pixels will generate a
# file about 60 MB in size. To view this file you can use Paint Shop Pro or
# some other viewer; I recommend that you then save this image to GIF or PNG
# to reduce its size (it'll be about 12 MB then).
#
# Other files output include target_image.pgm.txt, which summarizes pixel
# image average color and usage, and target_image.pgm.html, which gives an
# HTML document of usage and thumbnails. The HTML document assumes there are
# GIF images corresponding to each .pnm file available, and also assumes that
# the pixel image file names are Firstname_Lastname.some_other_info.pnm.

# Options:
# Just edit this script to change some options:
# - Change $min_pix to change the minimum number of times a pixel image will
#   appear in the mosaic. For example, if you're making a photomosaic with
#   pixel images consisting of members of a class, you definitely want to
#   make sure this is set to more than 0 so everyone gets used at least once.
# - Change $subsample from 1 to however much you want to subsample the
#   input images. That is, if you subsample by 4, each input 64x64 pixel image
#   will be output as a 16x16 (64/4) image. This is nice for making lower-res
#   "preview" versions of the image, either for web page viewing or just to
#   see if things are working properly.
# - Change $gamma_power to a higher value if you want to use gamma correction.
#   For example, 2.2 is the recommended sRGB value. 1.6 seems to make sense
#   on my screen, but that's partly because the black level can't be zeroed
#   on it. That said, I've turned off this option by setting it to 1. In
#   trying various gammas, I was finding that using it just seemed to darken
#   the photomosaic. The idea is that the images read in get converted from
#   gamma-corrected (viewing) space to linear space, get manipulated in this
#   space and then dithered against the target image (also linearized), and
#   this should result in better gray level matching.

# Algorithm:
# Read in given file and all *.pnm image files in directory
# Figure out gamma (lower) linear value of each image
# Dither the goal image with respect to palette of images
# Output the goal image made up of palette of images

# To do list:
# - More error checking, e.g. make sure all pixel images input are the same size
# - Add code that automatically adds an all-white and all-black pixel image as
#   needed.
# - Make dithering work a bit better (do a zig-zag).
# - Better image matching. I tried experiments with checking which images would
#   best fit into a higher-res version of the image. For example, say you had
#   a 400x400 image. You could make this image out of 100x100 pixel images, and
#   then use the 4x4 target samples to find the best pixel image match. A pixel
#   with an eye, where one part of the pixel was dark, might better match with
#   one pixel image over another. In practice this didn't work out: most pixels
#   have minimal contrast within the subpixel image, so pixel images with low
#   contrast were favored over ones with high contrast. Better might be to
#   use this subpixel (4x4) matching only when the subpixel has high contrast
#   within it, so that high contrast images have a better chance of getting
#   used otherwise.
# - Color (which leads to a lot of prep work, as the pixel image palette has to
#   be large and widely varied in order to capture the target image).

# History: 1.1 released 9/29/98
#          1.2 released 1/11/99, fixing a bug where subsampling was not working
#              (many thanks to Adam Kingry for pointing this out)

$| = 1 ;        # turn off output buffering, so we see results if piped, etc

# if you want to ensure that each pixel image gets used some minimum number
# of times, set $min_pix.
# $min_pix = 0 ;	# don't enforce a minimum
$min_pix = 6 ;	# minimum number of times to use image.

# if 64x64 pixel images should be output as 8x8 (good for a web-site sized
# "preview" image).
$subsample = 1 ;	# no subsampling
# $subsample = 4 ;	# turn 64 x 64 into 16x16
# $subsample = 8 ;	# turn 64 x 64 into 8x8

# change to say 2.2 or 1.6 or similar for gamma corrected computations
$gamma_power = 1.0 ;


$threshhold = -1 ;	# closeness for "matching"

$gamma[0] = 0 ;
$ungamma[0] = 0 ;
for ($i = 1 ; $i < 256 ; $i++ ) {
    $gamma[$i] = 255 * exp(log($i/255)/$gamma_power) ;
    $ungamma[$i] = 255 * exp(log($i/255)*$gamma_power) ;
    # $gamma[$i] = $i ;   # no gamma
    # $ungamma[$i] = $i ;   # no gamma
}


#
# First get name of file to turn into an image
#

if ( $#ARGV < 0 ) {
    &USAGE() ;
    exit 1 ;
}

$image_file = shift(@ARGV) ;
$outfile = $image_file . ".pgm" ;
$infofile = $image_file . ".txt" ;
$htmlfile = $image_file . ".html" ;


&READ_PGM( $image_file ) ;
printf "read mosaic basis $image_file\n" ;
for ( $i = 0; $i < $readlen ; $i++ ) {
    $target_array[$i] = $array[$i] ;
    $target_linear_array[$i] = $target_backup_linear_array[$i] = $ungamma[$array[$i]] ;
}
$target_len = $readlen ;
$target_xres = $xres ;
$target_yres = $yres ;


$read_from = 0 ;
$palno = 0 ;

printf "reading directory\n" ;
&READ_DIR('.') ;

&DITHER_TARGET() ;	# forms $target_dither_array

&MAKE_MOSAIC() ;

&MAKE_HTML() ;

exit 0 ;





sub USAGE {
    printf "usage: perl make_mos.prl filename.pnm\n" ;
    printf "By running this program in a directory with a set of .pnm files\n" ;
    printf "(which are in fact supposed to be binary PGM files, P5 type,\n" ;
    printf "all of equal size, e.g. 64x64), this program will read in\n" ;
    printf "filename.pnm as the thing to make into a mosaic and will read in\n" ;
    printf "all the other *.pnm files as pixels. Dithering will occur, as\n" ;
    printf "will a repetitive process which assures that all input pixels\n" ;
    printf "get used at least $min_pix times (controlled by min_pix in the code).\n" ;
    printf "The input image is then dithered with the palette of pixel\n" ;
    printf "images' gray levels, then output into filename.pnm.pgm.\n" ;
    printf "This file than can be read in by most apps (e.g. Paint Shop Pro,\n" ;
    printf "at http://www.jasc.com/) and viewed and converted as you wish.\n" ;
}

sub READ_DIR {
    local($localdir) = '.' ;
#    local($dirfilename) ;
#    $dirfilename = $localdir . 'junk.txt' ;
    opendir THISDIR, $localdir or die "cannot open directory $localdir: $!" ;
    @allfiles = readdir THISDIR ;
    closedir THISDIR ;
#   `ls $localdir > $dirfilename` ;
#printf "dir $localdir > $dirfilename\n" ;

    do {
	$fname = shift (@allfiles) ;
	if ( $fname =~ /\.\w+$/ ) {
	    if ( $& eq '.pnm' || $& eq '.PNM' ) {
		if ( $image_file ne $fname ) {
		    READ_PIXEL( $fname ) ;
		    printf "read pixel $palno $fname, average %s\n",$pal_avg[$palno-1];
		}
	    }
	}
    } while ( $fname ne '' ) ;
}


sub READ_PIXEL {
    local($pixelname) = @_[0] ;

    $pal_name[$palno] = $pixelname ;
    &READ_PGM( $pixelname ) ;
    $avg = 0 ;
    for ( $i = 0; $i < $readlen ; $i++ ) {
	$avg += $ungamma[$array[$i+$read_from]] ;
    }
    $pal_avg[$palno] = $avg / $readlen ;
    $read_from += $readlen ;
    $palno++ ;
}


sub DITHER_TARGET {
    # now floyd-steinberg dither
Redo:
    for ( $y = 0 ; $y < $target_yres ; $y++ ) {
	$yoff = $y * $target_xres ;
	for ( $x = 0 ; $x < $target_xres ; $x++ ) {
	    $idx = $yoff + $x + 1 ;
	    $trueval = int($target_linear_array[$idx] + 0.5) ;
	    if ( $trueval < 0 ) {
		$trueval = 0 ;
	    } elsif ( $trueval > 255 ) {
		$trueval = 255 ;
	    }
	    $mindiff = 1000 ;
	    for ( $pal = 0 ; $pal < $palno ; $pal++ ) {
		$diff = abs( $pal_avg[$pal] - $trueval ) ;
		if ( $diff < $mindiff ) {
		    $mindiff = $diff ;
		    $close_pal_val = $pal_avg[$pal] ;
		    $minpal = $pal ;
		}
	    }
	    # see if a similar entry's min_pix is lower
	    if ( $min_pix > 0 && $pal_usage[$minpal] >= $min_pix ) {
		$found_one = 0 ;
		for ( $pal = 0 ; !$found_one && $pal < $palno ; $pal++ ) {
		    if ( $pal != $minpal && $pal_usage[$pal] < $min_pix ) {
			$closeness = abs(int($pal_avg[$pal]) - int($pal_avg[$minpal])) ;
			if ( $closeness <= $threshhold ) {
			    $close_pal_val = $pal_avg[$pal] ;
			    $minpal = $pal ;
			    $found_one = 1 ;
			}
		    }
		}
	    }

	    $target_dither_array[$idx] = $minpal ;
	    $pal_usage[$minpal]++ ;	# for output later
	    if ( $close_pal_val != $trueval ) {
		$diff = $trueval - $close_pal_val ;
		
		# now move the diff outwards
		if ( $x > 0 ) {
		    $target_linear_array[$idx+$xres-1] += $diff * 3 / 16 ;
		}
		$target_linear_array[$idx+$xres] += $diff * 5 / 16 ;
		if ( $x < $xres-1 ) {
		    $target_linear_array[$idx+$xres+1] += $diff * 1 / 16 ;
		    $target_linear_array[$idx+1] += $diff * 7 / 16 ;
		}
	    }
	}
    }


    #threshhold check
    $badness = 0 ;
    if ( $min_pix > 0 ) {
	for ( $i = 0 ; $i < $palno ; $i++ ) {
	    if ( $pal_usage[$i] == 0 ) {
		$space = ' ' x (40-length($pal_name[$i])) ;
		printf "UNUSED: %7d\t$pal_name[$i]%s%6.2f\t%5d\n",$i+1,$space,$pal_avg[$i],$pal_usage[$i] ;
		$badness = 1 ;
	    }
	}

	if ( $badness ) {
	    $threshhold++ ;
	    printf "someone didn't get used, upping threshhold to $threshhold\n" ;
	    undef @pal_usage ;
	    for ( $y = 0 ; $y < $target_yres ; $y++ ) {
		$yoff = $y * $target_xres ;
		for ( $x = 0 ; $x < $target_xres ; $x++ ) {
		    $idx = $yoff + $x + 1 ;
			
		    $target_linear_array[$idx] = $target_backup_linear_array[$idx] ;
		}
	    }
	    goto Redo ;
	}
    }

    open(INFOFILE,"> $infofile") || die "can't open $infofile: $!\n";
    printf "\n#\tName\t\t\t\t\tLin.Avg\tGam.Avg\tUses\n";
    printf INFOFILE "#\tName\t\t\t\t\tLin.Avg\tGam.Avg\tUses\n";
    for ( $i = 0 ; $i < $palno ; $i++ ) {
	if ( $pal_avg[$i] > 0 ) {
	    $gamma = 255 * exp(log($pal_avg[$i]/255)/$gamma_power) ;
	} else {
	    $gamma = 0 ;
	}
	$space = ' ' x (40-length($pal_name[$i])) ;
        printf "%7d\t$pal_name[$i]%s%6.2f\t%6.2f\t%5d\n",$i+1,$space,$pal_avg[$i],$gamma,$pal_usage[$i] ;
        printf INFOFILE "%7d\t$pal_name[$i]%s%6.2f\t%6.2f\t%5d\n",$i+1,$space,$pal_avg[$i],$gamma,$pal_usage[$i] ;
    }

    close INFOFILE
}

sub MAKE_MOSAIC {

    $big_xres = $xres * $target_xres ;
    $big_yres = $yres * $target_yres ;


# write header
    $srcfile = $outfile ;
    $srcfile = "> " . $srcfile ;
    open(SRCFILE,$srcfile) || die "can't open $srcfile: $!\n";

    #write file

    printf "writing to file $srcfile\n" ;
    printf SRCFILE "P2\n%d %d\n255\n", $big_xres/$subsample, $big_yres/$subsample ;


    # go through picture and fill it in
    $rescale = ($subsample*$subsample) ;
    for ( $target_y = 0 ; $target_y < $target_yres ; $target_y++ ) {
	$ct = 0 ;
	for ( $target_x = 0 ; $target_x < $target_xres ; $target_x++ ) {
	    $dxoff = $target_x * $xres ;

	    # get the pixel index, use to offset into pixel data array
	    $pal_val = $target_dither_array[$target_y*$target_xres+$target_x] ;

	    $in_idx = $readlen * $pal_val ;

	    # fill in each "pixel"
	    for ( $y = 0 ; $y < $yres ; $y++ ) {
		# $out_idx = $dxoff + $y*$big_xres ;
		$out_idx = $dxoff + int($y/$subsample)*$big_xres ;
		for ( $x = 0 ; $x < $xres ; $x++, $out_idx++, $in_idx++, $ct++ ) {
		    $out_array[int($out_idx/$subsample)] += $array[$in_idx] ;
		}
	    }
	}
	for ( $i = 0 ; $i < $ct/$rescale; $i++ ) {
	    printf SRCFILE "%d ", int($out_array[$i] / $rescale + 0.5) ;
	    $out_array[$i] = 0 ;
	    if ( $i % 16 == 15 ) {
		printf SRCFILE "\n" ;
	    }
	}
	printf SRCFILE "\n" ;
	printf "line %d of $target_yres done\n", $target_y+1 ;
    }


    close SRCFILE ;

}

sub MAKE_HTML {
    open(HTMLFILE,"> $htmlfile") || die "can't open $htmlfile: $!\n";
    printf HTMLFILE "<HTML>\n<HEAD><TITLE>Photomosaic of $image_file</TITLE></HEAD>\n<BODY>\n" ;
    printf HTMLFILE "<table>\n\n<tr><td><B>Image</B></td>\n" ;
    printf HTMLFILE "<td><B>Name</B></td>\n" ;
    printf HTMLFILE "<td><B>Times used</B></td>\n" ;
    printf HTMLFILE "<td><B>Grayscale value</B></td></tr>\n" ;


    for ( $i = 0 ; $i < $palno ; $i++ ) {
	$key = substr($pal_name[$i],0,-4) ;
	@keyfld = split /[_.]/,$key ;
	$firstname = shift(@keyfld) ;
	$lastname = shift(@keyfld) ;
	$rest = join ' ',@keyfld ;

	if ( length($rest) > 0 ) {
	    $truekey = $lastname . ', ' . $firstname . ' - ' . $rest ;
	} else {
	    $truekey = $lastname . ', ' . $firstname ;
	}

	$num_uses{$truekey} = $pal_usage[$i] ;
	$pixel_val{$truekey} = sprintf("%6.2f",$pal_avg[$i]) ;
	$filename{$truekey} = $key . '.gif' ;
	$name{$truekey} = $truekey ;
    }

    foreach $key ( sort keys %name ) {
	printf HTMLFILE "<tr><td><img src=\"$filename{$key}\" width=$xres height=$xres alt=\"$name{$key}\"></td>\n" ;
	printf HTMLFILE "<td>$name{$key}</td>\n" ;
	printf HTMLFILE "<td align=center>$num_uses{$key}</td>\n" ;
	printf HTMLFILE "<td align=center>$pixel_val{$key}</td></tr>\n\n\n" ;
    }

    printf HTMLFILE "</table>\n" ;
    printf HTMLFILE "</BODY>\n" ;

    close HTMLFILE ;
}



# reads array[] from a file, returns $readlen, $xres, $yres
sub READ_PGM {
    local($srcfile) = @_[0] ;
    unless (open(SRCFILE,$srcfile)) {
        print "can't open $srcfile: $!\n";
        exit ;
    }

    # read header
    $cont = 1 ;
    $headersize = 0 ;

    if ( $_ = <SRCFILE> ) {
	$headersize += length( $_ ) ;
	chop ;
	if ( $_ ne 'P5' ) {
	    printf "$srcfile is not a PGM file - header was '$_'\n" ;
	    exit ;
	}
    }

    if ( $cont && ($_ = <SRCFILE>) ) {
	# get rid of comment line from PSP
	if ( substr($_,0,1) eq '#' ) {
	    $headersize += length( $_ ) ;
	    $_ = <SRCFILE> ;
	}
	$headersize += length( $_ ) ;
	chop ;
	@fld = split(' ',$_);
	$xres = $fld[0] ;
	$yres = $fld[1] ;
        if ( $xres <= 0 || $yres <= 0 ) {
	    printf "bad resolution read: $xres X $yres\n" ;
	    exit ;
	}
    }

    if ( $cont && ($_ = <SRCFILE>) ) {
	$headersize += length( $_ ) ;
	chop ;
	if ( $_ ne '255' ) {
	    printf "$srcfile is not a nicely grayscaled PGM file\n" ;
	    exit ;
	}
    }

    close SRCFILE ;

    # read body
    if ( $cont ) {
	if ( !open(SRCFILE,$srcfile) ) {
	    printf "cannot find file $srcfile\n" ;
	    exit ;
	}
	binmode( SRCFILE ) ;
	$charno = read(SRCFILE, $rbuf, $headersize);

	$avg = 0 ;
	$end = 0 ;
	$totchar = 0 ;
	$readlen = $xres * $yres ;
    }
    if ( $cont ) {
	# read bytes
	$charno = read(SRCFILE, $rbuf, $readlen);
#printf "read $charno chars\n" ;
	if ( $charno < $readlen ) {
	    printf "bad data read, only $charno characters\n" ;
	    exit ;
	}
	if ( $charno ) {
	    for ( $i = 0; $i < $readlen ; $i++ ) {
		$val = unpack( "C", substr( $rbuf, $i, 1 ) ) ;
		$array[$i+$read_from] = $val ;
#printf "pixel $i is $val\n" ;
	    }
	}
    }

    if ( $cont ) {
	$charno = read(SRCFILE, $rbuf, $readlen);

	if ( $charno > 0 ) {
	    printf "extra data at end of file, $charno characters\n" ;
	}

	#$palette{$srcfile} = sprintf "%3d	$srcfile\n", (($avg / $readlen) + 0.5) ;
	# printf "%3d	$srcfile\n", (($avg / $readlen) + 0.5) ;
    }
    close SRCFILE ;
}