#!/usr/bin/perl
# No warnings - otherwise it gripes about 'gimp_file_load' etc being
# redefined.


#	(C) Simon Drabble	2004-06-21
#	gimp@thebigmachine.org
#	$Id: pmosaic,v 1.9 2004/07/12 15:05:11 simon Exp $
#

# TODO:
# [ ] 1. Allow different source-pixel sizes (cell-sizes)
#       1a. Different sampling methods
# [X] 2. Allow stop/ start (save state between invocations)
#       2a. Clustering?
# [?] 3. Speed up main loop (pick_best_image)
# [ ] 4. Output file selection (-o won't work: new_img != img)
# [ ] 5. Collect statistics on each PM (optional)
#    number of library photos used vs. total in library
#    number of exact matches
#    average search time
#    etc
# [ ] 6. Complete function documentation!




use Gimp ":auto";
use Gimp::Fu;
use File::Spec qw(splitpath);

use strict;

our $VERSION = '0.1';

my $rc_dir = "$ENV{HOME}/.photomosaic";
mkdir $rc_dir unless -d $rc_dir;

my $state_file = "$rc_dir/pm_state.conf";

my $sig_recvd = 0;

# A lower tolerance will take longer to process but result in a better match.
# This is a global so we don't have to pass it around to each function
# (including 'register')
my $tolerance = 15; 

# If collecting statistics, and the file to dump them to.
my $statistics = 0;
my $stat_file;


# Would have like to have done this with INT, but that affects GIMP/Perl-fu
# server, so is no good when running this script in batch.
$SIG{USR1} = sub { ++$sig_recvd };


sub pmosaic_run
{
	my ($imgfile, $index, $sfile, $tol, $cont, $paranoid, $disp, $stats) = @_;

	$tolerance  = $tol;
	$statistics = $stats;
	$state_file = $sfile;

	if ($statistics) {
		open $stat_file, ">$imgfile.statistics";
	}

	if (!$index) {
		die "No library index provided. I go no further";
	}

	my %map = read_index($index);
	
	my $img = gimp_file_load($Gimp::Fu::run_mode, $imgfile, $imgfile); 
	my $drw = $img->get_active_layer;

	my ($startx, $starty) = (0, 0);

	my $xscale = 20;
	my $yscale = 20;
	my $wd = $drw->width;
	my $ht = $drw->height;

	my ($new_img, $layer, $display);

	if ($imgfile) {
		warn "Attempting to load $imgfile.\n";
	}

# If imgfile is interrupted, automatically continue it.
	my ($src, $tgt, $vars);
	if ((($src, $tgt, $vars) = read_state($state_file)) &&
			$cont &&
			$src eq make_abs_path($imgfile)) {
		warn "Trying to continue interrupted mosaic '$src'\n";
		# We read an interrupted entry from the state file. Initialise values.
		($new_img, $layer) = read_file($tgt);

# Hmm.. TODO: might the user want to continue with a different tolerance?
		($startx, $starty, $xscale, $yscale, $tolerance) = split ',', $vars;

# TODO: Proper init procedure - make initialisation sane.
		$img->delete;
		$img = gimp_file_load($Gimp::Fu::run_mode, $src, $src); 
		$drw = $img->get_active_layer;
		$wd = $drw->width;
		$ht = $drw->height;

	} else {
		if (!$cont && $src) {
			warn "Chosen to re-start interrupted mosaic '$src' (-continue = 0)\n";
		}

		# Start a new image.
		$new_img = gimp_image_new($wd * $xscale, $ht * $yscale, RGB);
		$layer = $new_img->layer_new(
				$wd * $xscale, $ht * $yscale,
				RGBA_IMAGE,
				"New Layer",
				100,
				NORMAL_MODE);
		$layer->edit_clear;
		$new_img->add_layer($layer, -1);
	}

# Display-while-process takes approx twice as long as with no display,
# according to Benchmark.
	if ($disp) {
		$display = $new_img->display_new;
	}


ALICE:
	for my $j ($starty..$ht-1) {
		# Complete the row (if continuing an interrupted image)
		for my $i ($startx..$wd-1) {
			# Now reset startx to the beginning of the row
			$startx = 0;
			my ($r, $g, $b) = get_tile_value($drw, $i, $j, 1, 1);
			my ($pic, $rgb) = pick_best_match(\%map, $r, $g, $b);
			if ($pic) {
#				warn sprintf "$i, $j: $pic (%02x%02x%02x) -> ($rgb)\n", $r,$g,$b;
				add_to_image($new_img, $layer, $i, $j, $pic, $xscale, $yscale);
			}

			if ($sig_recvd) {
				my  $outfile = save_temp_image($new_img, $layer, $img->get_filename());
				save_state($img->get_filename(), 0, $j, $xscale, $yscale, $outfile);
				last ALICE;
			}

		}  # loop over columns

		print STDERR "Processed row $j/ $ht\n";

		if ($paranoid || !(($j+1) % 25)) {
			my $outfile = save_temp_image($new_img, $layer, $img->get_filename());
			save_state($img->get_filename(), 0, $j+1, $xscale, $yscale, $outfile);
		}  # Paranoia!

		if ($ENV{PMOSAIC_TEST_SWITCH}) {
			kill 'USR1' => $ENV{PMOSAIC_TEST_SWITCH};
		}

	}  # loop over rows

	save_image($new_img, $layer, $img->get_filename());

# If mosaic completed (no signal was received), remove temporary file (if any)
# and entry from state file (also if any).
	if (!$sig_recvd && $src eq make_abs_path($img->get_filename())) {
		unlink $tgt if $tgt && -e $tgt;
		remove_state($src, $state_file);
	}

# Remove the display, if one was created.
	if ($disp && $display) {
		$display->delete; # Also deletes image, since we created it.
	} else {
		$new_img->delete;
	}

# Tidy up.
	if ($statistics && $stat_file) {
		close $stat_file;
	}

	return $img;
}




sub get_tile_value
{
	my ($drw, $x, $y, $w, $h) = @_;
	my ($r, $g, $b) = (0) x 3;
	for my $j ($y..$y+$h-1) {
		for my $i ($x..$x+$w-1) {
			my ($pr, $pg, $pb) = $drw->get_pixel($i, $j);
			$r += $pr;
			$g += $pg;
			$b += $pb;
		}
	}
	my $mul = $w x $h;
	$r /= $mul;
	$g /= $mul;
	$b /= $mul;
	if ($statistics && $stat_file) {
		print $stat_file "This is for tile at $x, $y of ($w x $h)\n";
	}
	return wantarray ? ($r, $g, $b) : ($r << 16) + ($g << 8) + $b;
}




sub save_state
{
	my ($filename, $row, $col, $xscale, $yscale, $tmpfile) = @_;
# BUG: XXX:
# If the filename is relative, prepend the current directory. This will be
# where the gimp is launched from, not from where the plugin script is
# run.
	$filename = make_abs_path($filename);

	my ($state, $src, $tgt, $vars);
# XXX Race condition if two photomosaics are occurring at the same time!
	if (!open O, ">>$state_file.__tmp__") {
		warn "Unable to save state to $state_file: $!";
		return;
	}

# Store info including location of temporary .xcf in state file
	my $outstr = "I:$filename:$tmpfile:$row,$col,$xscale,$yscale,$tolerance";

	my $was_written = 0;
# Check for existing state for file - we only store one state per file.

	if (open I, "<$state_file") {
		while (<I>) {
			chomp;
			($state, $src, $tgt, $vars) = split /:/;
			if ($src eq $filename) {
				print O "$outstr\n";
				$was_written = 1;
			} else {
				print O "$_\n";
			}
		}
		close I;
	}
	if (!$was_written) {
		print O "$outstr\n";
	}
	close O;
	rename "$state_file.__tmp__", $state_file;
}




sub make_abs_path
{
	my $filename = shift;
	if ($filename !~ /^\//) {
		$filename = File::Spec->join("", $ENV{PWD}, $filename);
	}
	return $filename;
}


sub remove_state
{
	my ($filename, $sfile) = @_;
	open I, "<$sfile" or return;
	if (!open O, ">$sfile.__tmp__") {
		close I;
		return;
	}
	while (<I>) {
		chomp;
		my ($state, $src, $tgt, $vars) = split /:/;
		unless ($src eq $filename) {
			print O join ':', $state, $src, $tgt, $vars;
			print O "\n";
		}
	}
	close O;
	close I;
	rename "$sfile.__tmp__", $sfile;
}




sub save_temp_image
{
	my ($img, $drw, $filename) = @_;
	my (undef, undef, $out_file) = File::Spec->splitpath($filename);
	$out_file =~ s/\.\w+$/.xcf/;
	$out_file = "$rc_dir/$out_file";
	warn "Saving image to $out_file\n";
	gimp_xcf_save($$, $img, $drw, $out_file, $out_file);
	return $out_file;
}



sub save_image
{
	my ($img, $drw, $filename) = @_;
	my ($vol, $dirs, $out_file) = File::Spec->splitpath($filename);
	$out_file = "PM__$out_file";
	$out_file =~ s/\.\w+$/.xcf/;
	my $outpath = File::Spec->catpath($vol, $dirs, $out_file);
	warn "Saving image to $outpath\n";
	gimp_xcf_save($$, $img, $drw, $outpath, $outpath);
}



sub read_state
{
	my ($statefile, $file) = @_;
	my ($state, $src, $tgt, $vars);
	open F, "<$statefile" or return;
	while(<F>) {
		chomp;
		($state, $src, $tgt, $vars) = split /:/;
		if (defined $file) {
			last if $state eq 'I' && $file eq $src;
		} else {
			last if $state eq 'I';
		}
	}
	close F;

	if ($state eq 'I') {
		warn "Incomplete mosaic '$src' found.\n";
		return ($src, $tgt, $vars);
	}
	return;
}



sub read_file
{
	my ($file) = @_;
	warn "Loading ($file)\n";
	my $img = gimp_xcf_load($$, $file, $file) or return;
	my $drw = $img->get_active_layer;
	return ($img, $drw);
}



sub add_to_image
{
	my ($img, $drw, $i, $j, $pic, $w, $h) = @_;
# Load the specified library image, and get its active layer.
	my $libimg = gimp_file_load($Gimp::Fu::run_mode, $pic, $pic);
	my $lyr = $libimg->get_active_layer;
# Scale the layer to be a new 'pixel', copy, and paste to our target layer.
	$lyr->scale($w, $h, 0);
	$lyr->edit_copy;
	my $nl = $drw->edit_paste(0);
# Move to top,left (pasted layer is in centre)
	$nl->translate(-$img->width/2 + ($w/2), -$img->height/2 + ($h/2));
# And move to correct position.
	$nl->translate($i * $w, $j * $h);
	$nl->floating_sel_anchor();
# Delete the image we don't need no mo
	$libimg->delete;
	return 1;
}





sub pick_best_match
{
	my ($map, $r, $g, $b) = @_;
	my $pv = sprintf "%02x%02x%02x", $r, $g, $b;
	my $pic;
	my ($rr, $rg, $rb) = ($r,$g,$b);  # 'return' values
	if ($map->{$pv}) {
		# Exact match
		$pic = $map->{$pv}->[rand @{$map->{$pv}}];

	} else {


# Current bottleneck. Ways to speed this up?
# 1. exit with closest match after certain number of tries/ time (could be bad)
# 2. exit with closest match within certain tolerance
# 3. pre-add keys to map that are approximate colours. for example if a search
# is made for a pixel of #ff0000, approx colours might be #f00000 thru #fe0000.
# Perform these lookups before performing exhaustive search.
# 4. set pic only once match has been found.
# 5. some heuristic to determine map keys within a certain range. Only perform
# exhaustive search if these keys turn up nuffink. This is similar to 2 but
# partitions the search domain at a higher tolerance first.
# 6. as we go along, add to a hash values that are similar to the desired
# colour; this can be used to speed up future searches within this session.
# This is a combination of 2, 3 and 5, but is adaptive! and dynamic!
# 7. store this map for re-use in later sessions!

		my $closest   = 0;
		my $run_total = 999;
BOBBI:
		for (keys %$map) {
# According to Benchmark, this is faster than either a regexp- or substr-based
# approach. Even a pre-compiled regexp.
#			my ($mr, $mg, $mb) = unpack "xCCC", pack "N", hex;
# Aha! but the numeric approach is faster still!
			my $num = hex;
			my $mr = ($num >> 16) & 0xff;
			my $mg = ($num >>  8) & 0xff;
			my $mb =  $num        & 0xff;

###+++			if ($statistics && $stat_file) {
###+++				my $ms = sprintf "%02x%02x%02x", $mr,$mg,$mb;
###+++				my $cs = sprintf "%02x%02x%02x",
###+++						($run_total >> 16) & 0xff,
###+++						($run_total >>  8) & 0xff,
###+++						 $run_total        & 0xff;
###+++				my $as = sprintf "%02x%02x%02x", abs($mr-$r),abs($mg-$g),abs($mb-$b);
###+++				print $stat_file "$pv: Looking at ($as) < ($cs)   from ($ms) ($t < $run_total ?)\n";
###+++			}


			# Store the closest match to the chosen colour.
			# The closest match is given by summing the differences between each
			# of the r,g,b components for the target pixel and the current
			# colour under examination. A lower total indicates a closer match.
			my $t = abs($mr - $r) + abs($mg - $g) + abs($mb - $b);
			if ($t < $run_total) {
				$run_total = $t;
				($rr, $rg, $rb) = ($mr, $mg, $mb);
				$closest = $_;

# Optimisation 2: exit once a close-enough match has been found. Helps a lot
# or a little, depending on tolerance, but a higher tolerance (faster) really
# does bash the final quality.
# A tolerance of 1 means that this loop will always pick the closest match,
# but at the expense of processing time.
				if ($run_total < $tolerance) {
					last BOBBI;
				}
			}  # end if close enough match
		}  # end loop through map keys

# Optimisation 4: set pic only once search complete. Helped a little.
		$pic = $map->{$closest}->[rand @{$map->{$closest}}];
	}  # match?

	if ($statistics && $stat_file) {
		printf $stat_file "I chose $pic for %02x%02x%02x\n", $rr,$rg,$rb;
		print $stat_file "============= Done that pixel ================\n";
	}
	return wantarray ? ($pic, sprintf"%02x%02x%02x",$rr,$rg,$rb) : $pic;
}



sub read_index
{
	my $index = shift;
	my %map;
	open IDX, $index or die;
	while (<IDX>) {
		chomp;
		next if /^\s*$/;
# Some entries got banjaxed during indexing :(
		next if /:[^#]/;
		my ($file, $val) = split /:#/;
		push @{$map{$val}}, $file;
	}
	close IDX;
	if (! keys %map) {
		die "Unable to get library image information. I stop here.";
	}
# Map entries are stored as
#   colour => [ list of images with the same value ]
# This makes for far faster look-ups than the obverse.
	return %map;
}


register
	"perl_fu_pmosaic",                               # fill in name
	"Creates a photomosaic.",                        # a small description
	qq{
Nomenclature:
Source:  The base image used to generate a photomosaic.
Target:  The resulting photomosaic.
Library: The photos used to replace pixels in the source to become the target.
	
Creates a photomosaic for a source image given the index of a photo library.
Each entry in the index should consist of a filename and the average pixel
value for the file, separated by a colon, for example

/path/to/image.jpg:#ff003d

The 'photomean' perl-fu can be used to generate entries in this form.  Entries in the photo library can be in any format loadable by GIMP. For images that have layers, only the active layer is used when copying to the target. This may be different from the layer used to generate the pixel average, which is bad.  Images loaded from the library are scaled before being copied to the target, but are not written back out to disk.

Options:

The 'Index' parameter specifies the library index file to use. This is something that can be easily generated by the photomean perl-fu.

The 'State File' parameter identifies the file to be used to read/ store interrupted photomosaic state.

The 'Tolerance' parameter is used to specify how close a library photo must
match the source pixel. Lower values mean the colours must be closer, but
prcessing will take longer - the search ends once a library photo is
found that has a colour within the tolerance value of the source pixel.

The 'Continue' option tells the script whether to continue an interrupted pmosaic. If the specified source is found in the state file with an 'interrupted' status, and 'continue' is true, the mosaic will start from where it left off last time. If 'continue' is false, the mosaic will be restarted from the beginning.

Use 'Paranoid' to specify that the generated target be written out to disk after every row is processed. If 'paranoid' is set to false, the target will only be written to disk every 25 rows, or if the process is interrupted by a USR1 signal.
The 'Display' option is used to cause the target to be displayed as it is being created. This is extremely slow so is disabled by default.

The 'Statistics' parameter can be used to collect statistics for the pmosaic run. This option is largely non-functional currently.


Visit the pmosaic home page at <http://thebigmachine.org/gimp/pmosaic/> for samples and benchmarks.

}, # a help text
	"Simon Drabble <gimp\@thebigmachine.org>",         # Your name
	"(c) Simon Drabble <gimp\@thebigmachine.org>",     # Your copyright
	"2004/06/21",                            # Date
	"<Toolbox>/Xtns/Perl-Fu/pmosaic",               # menu path
	"*",                                               # Image types
	[
		[PF_FILE,   "imgfile",    "Image File",                                 ""],
		[PF_FILE,   "index",      "Index",         "$ENV{HOME}/.photomosaic/index"],
		[PF_FILE,   "state",      "State File",                        $state_file],
		[PF_SLIDER, "tolerance",  "Tolerance (higher = faster but less accurate)",
			$tolerance, [1, 255, 1, 5, 10 ]
		],
		[PF_BOOL,   "continue",   "Continue interrupted PhotoMosaic (if found)", 1],
		[PF_BOOL,   "paranoid",   "Paranoid (slower!)",                          0],
		[PF_BOOL,   "display",    "Display (slower!)",                           0],
		[PF_BOOL,   "statistics", "Collect statistics",                          0],
	],
	\&pmosaic_run;

exit main();


__END__


=head1 NAME

pmosaic - GIMP plug-in to produce photomosaic pictures.

=head1 SYNOPSIS

Copy to your GIMP plug-ins directory. Run as either

	/path/to/pmosaic -imgfile /path/to/source_imagefile [options]

or from the Toolbox/Xtns/Perl-Fu menu within GIMP.

The plug-in is intended to be run from the command-line primarily since
photomosaic creation can take a long time, and it is expected that it will
generally be performed in batch - that's how I do it, anyway.

=head1 ABSTRACT

Creates a photomosaic for a source image given the index of a photo library.

=head1 DESCRIPTION

Nomenclature:

Source:  The base image used to generate a photomosaic.

Target:  The resulting photomosaic.

Library: The photos used to replace pixels in the source to become the target.

Each entry in the library index should consist of a filename and the
average pixel value for the file, separated by a colon, for example
	
/path/to/image.jpg:#ff003d

The 'photomean' perl-fu which should accompany this software can be used to generate entries in this form.  Entries in the photo library can be in any format loadable by GIMP. For images that have layers, only the active layer is used when copying to the target. This may be different from the layer used to calculate the pixel average (input to photomean), which is bad. Images loaded from the library are scaled before being used, but are not written back out to disk.

Options:

The 'index' parameter specifies the library index file to use. This is something that can be easily generated with the photomean perl-fu.

The 'state' parameter identifies the file to be used to read/ store interrupted photomosaic state.

The 'tolerance' parameter is used to specify how close a library photo must
match the source pixel. Lower values mean the colours must be closer, but
prcessing will take longer - the search ends once a library photo is
found that has a colour within the tolerance value of the source pixel.

The 'continue' option tells the script whether to continue an interrupted pmosaic. If the specified source is found in the state file with an 'interrupted' status, and 'continue' is true, the mosaic will start from where it left off last time. If 'continue' is false, the mosaic will be restarted from the beginning.

Use 'paranoid' to specify that the generated target be written out to disk after every row is processed. If 'paranoid' is set to false, the target will only be written to disk every 25 rows, or if the process is interrupted by a USR1 signal.
The 'display' option is used to cause the target to be displayed as it is being created. This is extremely slow so is disabled by default.

The 'statistics' parameter can be used to collect statistics for the pmosaic run. This option is largely non-functional currently.


Visit the pmosaic home page at <http://thebigmachine.org/gimp/pmosaic> for samples and benchmarks.


=head1 FUNCTIONS

=over 4

=item ($r, $g, $b) = get_tile_value($x, $y, $w, $h);

Returns the aggregate value for the pixels in tile of size $w, $h at $x, $y.
$w x $h should be < 256.


=item ($src, $tgt, $vars) = read_state($statefile, $imgfile);

Checks if an incomplete state entry exists in $statefile, returning the first
one found.
If $imgfile is defined, checks explicitly for an entry matching, and returns it
only if found - returns undef if not.

=item %map = read_index($file);

Reads the specified index file. This file is the index to your image library.

Each line should be in the format

/path/to/an/image.file:#rrggbb

I.e. the output from `photomean'.


=cut

=back

=head1 SEE ALSO

photomean, GIMP::Fu

=head1 AUTHOR

Simon Drabble, E<lt>gimp@thebigmachine.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004  Simon Drabble

This script is free software; you may redistribute it and/or modify 
it under the same terms as Perl itself.

=cut
