#!/usr/bin/perl
#
# Copyright (c) 2006-2007 David Sheldon and Nick Burch
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
#
#
# This script reads in 1km grid square images from <map>-tiles-<year>
#  directories, and outputs (scaled) images as scaled#/<eee>/<nnn>.jpg
# By default it will go for the newest files it can, but if run from a
#  decade based directory, will be constrained to the newest tiles 
#  of that decade.
#
use List::Util qw[min max];
use Image::Magick;

my $tilesize = 125;

my $scale = shift;
unless($scale) { $scale = 6; }

# Should we rescale as we go?
my $rescale_by = 1;
if($scale > 20) {
	$rescale_by = 4;
}
my $out_tile_size = int($tilesize / $rescale_by);

my $outdir = "scaled$scale";

if (! -d $outdir) {
    mkdir $outdir or die "Unable to create dir '$outdir'"
}

# Are we running across all tiles in search of the most recent, or
#  are we constrained by a given decade?
my $dir_glob = "*";

my $current_dir = `pwd`;
chomp $current_dir;
if($current_dir =~ /\/(19[0-6]0)s$/) {
    my $decade = $1;
    my $decade_match = substr($decade,0,3)."?";
    $dir_glob = "../*-$decade_match";

    print "Restricting to just tiles from the decade '$decade'\n";
} else {
    print "Using the most recent tiles available\n";
}
print "\n";
sleep 2;

# Find out files
my @files = glob("$dir_glob/tile-*.jpg");
my %tiles ;

my $minx, $miny, $maxx, $maxy;

# Sort the tiles by directory name
# (If we have two copies of the same tile, we want the newest one)
@files = sort {
	my ($adate) = ($a =~ /^.*?\-(\d\d\d\d)\//);
	my ($bdate) = ($b =~ /^.*?\-(\d\d\d\d)\//);
	if(!$adate && !$bdate) { return $a cmp $b; }
	if($adate && !$bdate) { return 1; }
	if($bdate && !$adate) { return -1; }
	return $adate <=> $bdate;
} @files;

# Process the files into a hash, based on easting and northing
foreach my $f (@files) {
  $f =~ m/-(\d+)-(\-?\d+)\./;
  my ($x, $y) = ($1 +0, $2 +0);
  $tiles{$x} ||= {};
  $tiles{$x}{$y} = $f;
}

# Figure out our largest easting and northing values
$maxx = max(keys %tiles);
$maxy = max(map { max(keys %{$tiles{$_}})} keys %tiles);
$miny = min(map { min(keys %{$tiles{$_}})} keys %tiles);

# The meta info's to re-create
# (Only done for scale 1, and only record the eastings to update)
my %update_meta;

# start at 0, if there are any tiles in a WxW square, render a scale model 
# of it

foreach my $x (0..($maxx/$scale)) {
    foreach my $y (($miny/$scale)..($maxy/$scale)) {
        # Note - channel island maps with negative y values will end up
        #   as scaledX/ddd/-dd.jpg, as the - counts as a digit
        my $filename = sprintf("%s/%03d/%03d.jpg", $outdir, $x, $y);

		my $meta_filename = sprintf("meta1/%03d.txt", $x);
        my $outdir = sprintf("%s/%03d/", $outdir, $x);
		
		# Do we need to create the meta info?
		if( ($scale == 1) && (! -f $meta_filename) ) {
			$update_meta{$x}++;
		}

		# Do we need to create / re-create the tile?
		# (Check if tile exists, then if any of the parent tiles are newer)
		my $create_tile = 0;
        if( (! -f $filename) && any_tiles($x, $y, \%tiles) ) {
			$create_tile = 1;
		}
		foreach my $i (0..($scale -1)) {
			foreach my $j (0..($scale -1)) {
				if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
					my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
					# Is this newer than the tile?
					if(-M $input < -M $filename) {
						$create_tile = 1;
					}
				}
			}
		}

		if($create_tile) {
            print "Making $filename\n";
            my $out = Image::Magick->new( size => "".($out_tile_size*$scale)."x".($out_tile_size*$scale) );
            $out ->ReadImage('xc:white');

            unless(-d $outdir) {
                mkdir($outdir);
            }

 foreach my $i (0..($scale -1)) {
     foreach my $j (0..($scale -1)) {
         if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
            my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
            my $image = Image::Magick->new;
            print $image->Read($input);
            if($scale == 1) {
			    print "\tIncluding $input\n";
            }

			if($rescale_by > 1) {
				$image->Resize("${out_tile_size}x${out_tile_size}");
				#print "Resized $input to ${out_tile_size}x${out_tile_size}\n";
			}

            print $out->Composite(image=>$image, x=> ($i*$out_tile_size), y=> ((($scale -1)-$j)*$out_tile_size) );
            undef $image;
        }
     }
 }

			# Do we need to update the meta info?
			if($scale == 1) {
				$update_meta{$x}++;
			}
			
			# Resize the image to 125x125, and write it out
            $out->Resize("${tilesize}x$tilesize");
            $out->Set(quality=>85);
            $out->Write("jpg:$filename");
            undef $out;
            print "\t($x,$y)\n";
        }
   }
}

# Load in our list of what legends apply
my %legends;
open(LEGENDS, "<../legends/which.txt");
while(my $line = <LEGENDS>) {
    chomp $line;
    unless($line) { next; }
    if($line =~ /^(\d+.*?-19\d\d)\s+([\w\d\-\_]+)\s*$/) {
        my ($dir,$legend) = ($1,$2);
        $legends{$dir} = $legend;
    } elsif($line =~ /^(\d+.*?-tiles-WO)\s+([\w\d\-\_]+)\s*$/) {
        my ($dir,$legend) = ($1,$2);
        $legends{$dir} = $legend;
    } else {
        warn("Invalid legends line: '$line'\n");
    }
}

# Re-create the meta files
foreach my $easting (sort keys %update_meta) {
	my $meta_filename = sprintf("meta1/%03d.txt", $easting);
	open(META, ">$meta_filename");
	print META "# easting,northing,sheet,year,legend\n";
	
	foreach my $northing (sort keys %{$tiles{$easting}}) {
		my $file = $tiles{$easting}{$northing};
		my ($sheet) = ($file =~ /^(\d+\w?)\-/);
		my ($year) = ($file =~ /^\d+\w?\-tiles\-(\d+)/);
		my ($dir) = ($file =~ /^(\d+.*?)\//);

        my $legend = $legends{$dir} or "";

        # Handle Channel Island maps
        if(!$sheet && $file =~ /^([GJ]\w+)\-tiles\-(\d+)/) {
            $sheet = $1;
            $year = $2;
        }

		print META "${easting},${northing},$sheet,$year,$legend\n";
	}

	print "Recreated $meta_filename\n";
	close META;
}


use Data::Dumper;

print "($maxx, $maxy)\n";

sub any_tiles {
 my ($x, $y, $tiles) = (shift, shift, shift);
 foreach my $i (0..($scale -1)) {
     foreach my $j (0..($scale -1)) {
         if (defined $$tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
             return 1;
         }
     }
 }
 return 0;
}
