#!/usr/bin/perl
#use daveperl;
use strict;

sub dprintf1 {}
sub dprintf2 {}
sub dprint1 {}
sub dprint2 {}

dprintf1 "running partials.pl %s\n", join(" ", @ARGV);

my $vervar = shift(@ARGV);
my $work_dir = shift(@ARGV);
my $out_dir = shift(@ARGV);
my $world_file = "$work_dir/world.php";
my @americas = cat_file_into_array($world_file);
my @areas = cat_file_into_array("$work_dir/all-areas");
my $size_mb = int(shift(@ARGV));

my $MB = (1<<20);
# leave a wee bit more space on the card.  Got a report
# that the 2GB version didn't fit on a 2GB card
# Got another report Feb1-2012 about the 2GB ones not
# fitting, so trim it down from 0.95->0.90
my $max_bucket_size = ($size_mb) * $MB * 0.90;

sub system_pipe
{
	my @cmd = @_;
	open(FOO, '-|', @cmd);
	my @output = <FOO>;
	close FOO;
	return join("", @output);
}

sub str_to_coord
{
	my $str = shift;
    	dprintf1 "coord line: '$str'\n";
	my ($lon, $lat) = split(",", $str, 2);
	my $ret;
	$ret->{lon} = $lon;
	$ret->{lat} = $lat;
	die "bad lat: '$lat' '$str'" if !$lat;
	die "bad lon: '$lon' '$str'" if !$lon;
	return $ret;
}

sub coord_avg
{
	my @coords = @_;
	my $ret;
	foreach my $coord (@coords) {
		$ret->{lat} += $coord->{lat};
		$ret->{lon} += $coord->{lon};
	}
	my $size = scalar(@coords);
	$ret->{lon} /= $size;
	$ret->{lat} /= $size;
	return $ret;
}
sub min
{
	my $a = shift;
	my $b = shift;
	return $a if ($a < $b);
	return $b;
}
sub max
{
	my $a = shift;
	my $b = shift;
	return $a if ($a > $b);
	return $b;
}
sub coord_botleft
{
	my @coords = @_;
	my $ret;
	$ret->{lat} = 999999;
	$ret->{lon} = 999999;
	foreach my $coord (@coords) {
		$ret->{lat} = min($coord->{lat}, $ret->{lat});
		$ret->{lon} = min($coord->{lon}, $ret->{lon});
	}
	return $ret;
}
sub coord_topright
{
	my @coords = @_;
	my $ret;
	$ret->{lat} = -999999;
	$ret->{lon} = -999999;
	foreach my $coord (@coords) {
		$ret->{lat} = max($coord->{lat}, $ret->{lat});
		$ret->{lon} = max($coord->{lon}, $ret->{lon});
	}
	return $ret;
}



sub cat_into_file
{
        my $stuff = shift;
        my $file = shift;
        if ( -e "$file" ) {
                die "exists: $file";
        }
        open FILE, "> $file";
        print FILE $stuff;
        close FILE;
}

sub cat_file_into_array
{
	my $filename = shift;;
	my $nr_lines = shift;
	my @contents;
	my $line;
	open FILE, "< $filename";
	while ($line = <FILE>) {
		chomp $line;
		push @contents, $line;
		last if defined $nr_lines && --$nr_lines <= 0;
	}
	close FILE;
	return @contents;
}


my $name = undef;

my $middles;
my $lefts;
my $rights;
while (scalar @americas) {
	my $line = shift @americas;
	chomp $line;
	if ($line =~ /<name>/) {
		$name = $line;
		$name =~ s/<[\/]?[a-z]+>//ig;
		$name =~ s/\s*//;
	}
	if ($line =~ /<coordinates>/
	    && defined $name) {
		my @coords = ();
		push @coords, str_to_coord(shift(@americas));
		push @coords, str_to_coord(shift(@americas));
		push @coords, str_to_coord(shift(@americas));
		push @coords, str_to_coord(shift(@americas));
		# there is a 5th coordinate in the XML, but it
		# is just a dup of the first one
		$middles->{$name} = coord_avg(@coords);
		$lefts->{$name} = coord_botleft(@coords);
		$rights->{$name} = coord_topright(@coords);
		$name = undef;
    	}

}

map {s/\s//g} @areas;
#putting it in a hash and back gets rid of dups
my %h;
#also detect files that might be missing

sub afile
{
	my $area = shift;
	return $work_dir."/".$area.".img";
}
foreach my $area (@areas) {
	if (! -e afile($area)) {
		printf STDERR "unable to find image file '%s'\n", afile($area);
		next;
	}
	$h{$area} = 1;
}
@areas = keys %h;
dprintf1 "areas len: %d total size: %s\n", scalar(@areas), asizestr(@areas);
sub cstr
{
	my $coor = shift;
	return sprintf("(%f, %f)", $coor->{lon}, $coor->{lat});
}

sub asize
{
	my $total;
	foreach my $area (@_) {
		$total += -s afile($area);
	}
	return $total;
}

sub asizestr
{
	my $s = asize(@_);
	return sprintf "%5.2f MB", ($s * 1.0 / (1<<20));
}

sub cmpit
{
	my $a = shift;
	my $b = shift;
	my $ll = shift;
	return $a->{$ll} <=> $b->{$ll};
}

sub cmplat { return cmpit(@_, "lat");}
sub cmplon { return cmpit(@_, "lon");}

my $sortby;
sub sortlat
{
	my $h = $sortby;
	return cmplat($h->{$a}, $h->{$b});
}
sub sortlon
{
	my $h = $sortby;
	return cmplon($h->{$a}, $h->{$b});
}

my $target_bucket_size = $max_bucket_size;
my $target_pieces = 1;

my $total = asize(@areas);
if ($total > $target_bucket_size) {
	use POSIX;
	my $pieces = 1.0 * $total / $max_bucket_size;
	$target_pieces = POSIX::ceil($pieces);
	$target_bucket_size = $total / $target_pieces;
	dprintf1("need %f pieces each: %f\n",
		$pieces, $max_bucket_size>>20);
}

# Split up the areas in to a set of $target_bucket_size
# sized buckets.  They should be roughly evenly sized.
my @even_buckets = [ () ];
$sortby = $middles;
@areas = (sort sortlon (@areas));
# this will split up evenly more or less
foreach my $name (@areas) {
	dprintf1 ("new area: '%s' (%s)\n", $name, cstr($middles->{$name}));
}
foreach my $area (@areas) {
	if (asize(@{$even_buckets[-1]}) + asize($area) > $target_bucket_size 
	    && scalar(@even_buckets) < $target_pieces) {
		push @even_buckets, [ () ];
	}
	push @{$even_buckets[-1]}, $area;
	dprintf2 "%s avg: %s (total: %s)\n", $area,
		cstr($middles->{$area}),
		asizestr(@{$even_buckets[-1]});

}

for (my $i = 0; $i < scalar(@even_buckets); $i++) {
	my @bucket = @{$even_buckets[$i]};
	dprintf1 "bucket[%d] len: %d size: %s\n", $i,
		scalar(@bucket), asizestr(@bucket);
}

sub ahash
{
	my @in = @_;
	my %hash;
	foreach my $entry (@in) {
		$hash{$entry} = 1;
	}
	return \%hash;
}

sub stealright { return steal(0, @_); }
sub stealleft  { return steal(1, @_); }

# "Steal" an area out of an adjacent bucket.  It is
# not really a steal because it copies the area,
# and does not remove it from the old bucket.
sub steal
{
	my $low = shift;

	my $all_buckets_ref = shift;
	my $target_buckets_ref = shift;
	my $index = shift;

	my @all_buckets = @{$all_buckets_ref};
	my @this_bucket = @{$target_buckets_ref};

	$index += 1 if ! $low;
	$index -= 1 if $low;
	return if $index >= scalar(@all_buckets);
	return if $index < 0;

	my @steal_bucket = @{$all_buckets[$index]};
	my $stolen = undef;
	my $hash = ahash(@this_bucket);
	while (scalar(@steal_bucket)) {
		if ($low) {
			$stolen = pop(@steal_bucket);
		} else {
			$stolen = shift(@steal_bucket);
		}
		#rintf("stole: $stolen\n");
		last if (!defined($hash->{$stolen}));
	}
	return $stolen;
}

my @result_buckets;
for (my $i = 0; $i < scalar(@even_buckets); $i++) {
	my @newbucket = @{$even_buckets[$i]};
	my @highneighbor;
	my @lowneighbor;
	while (1) {
		my $stolenhigh = stealright(\@even_buckets, \@newbucket, $i);
		if (defined $stolenhigh) {
			last if asize(@newbucket) + asize($stolenhigh) > $max_bucket_size;
			push @newbucket, $stolenhigh;
			dprint1 "stole high: $stolenhigh\n";
		}
		my $stolenlow = stealleft(\@even_buckets, \@newbucket, $i);
		if (defined $stolenlow) {
			last if asize(@newbucket) + asize($stolenlow) > $max_bucket_size;
			unshift @newbucket, $stolenlow;
			dprint1 "stole low: $stolenlow\n";
		}
		# We do not need to steal if we only have a single bucket
		last if scalar(@even_buckets) <= 1;
		if (! defined $stolenlow  && ! defined $stolenhigh) {
			warn "unable to fill bucket $i";
			last;
		}
	}
	my $left = $middles->{$newbucket[0]}->{lon};
	my $right = $middles->{$newbucket[-1]}->{lon};
	dprintf1 "newbucket[%d] (%f:%f) len: %d size: %s\n", $i, $left, $right,
		scalar(@newbucket), asizestr(@newbucket);
	push @result_buckets, \@newbucket;
}

dprintf1("total size: %s\n", asizestr(@areas));

sub make_kml
{
	my $kml_file = shift @_;
	my @areas = @_;
	my @xgrep_cmd = ($ENV{HOME}.'/bin/xgrep', '-s');
	my $xgrep_re = sprintf 'Placemark:name/(%s)/', join('|', @areas);
	push @xgrep_cmd, $xgrep_re, $world_file;

	dprintf2 "xgrep cmd: '%s'\n", join(" ", @xgrep_cmd);
	if ( ! -e $kml_file) {
		my $kml_fragment = system_pipe(@xgrep_cmd);
		my $footer = '</Document></kml>';
		my $header = '
<kml xmlns="http://www.opengis.net/kml/2.2">
<Document>
  <Style id="Red">
    <LineStyle>
      <color>ffff0000</color>
      <width>1.5</width>
    </LineStyle>
    <PolyStyle>
      <color>7d0000ff</color>
    </PolyStyle>
  </Style>
';
		if (length($kml_fragment) < 100) {
			die "kml too short"
			.":\n'".$kml_fragment."'"
			;
		}
        	cat_into_file($header.$kml_fragment.$footer, $kml_file);
	}
	return @xgrep_cmd;
}

sub mkmap
{
	my $name = shift;
	my $size = shift;
	my @areas = @_;
	my @imgs = ();
	my $out_base = "$size-$name.$vervar.gmapsupp";
	my $out_file = "$out_dir/$out_base.img";
	my $kml_file = "$out_dir/kml/$out_base.kml";
	for my $a (@areas) {
		push @imgs, afile($a);
	}
	my @xgrep_cmd = make_kml($kml_file, @areas);
	if (-e $out_file) {
		dprintf1 "%s already exists, skipping...\n", $out_file;
		return "OK";
	}

	my @cmd = qw(java -Xmx6000m -jar /home/daveh/mkgmap-stuff/mkgmap/dist/mkgmap.jar   --gmapsupp --routable --net);
	push @cmd, "--area-name=\"USA $name\"";
	printf("making $name from %d tiles, expected size: %s...", scalar(@imgs), asizestr(@areas));
	#system("echo", @cmd, @imgs);
	my $summary_file = "$work_dir/cmd.$size-$name.txt";
	unlink $summary_file;
	my $summary = join(" ", @cmd, @imgs);
	$summary .= "\n#xgrep command:\n";
	$summary .= join(" ", @xgrep_cmd)."\n";;
	cat_into_file($summary, $summary_file);
	my $ret = system(@cmd, @imgs);
	if ($ret & 127) {
		printf "\nmkgmap died with signal %d\n";
		exit(-1);
	}
	$ret >>= 8;
	if ($ret) {
		printf "\nmkgmap exited with bad status: %d\n", $ret;
		exit($ret);
	}
	my $fsize = (1.0*(-s "gmapsupp.img") / (1.0*1<<20));
	printf("done (actual size: %4.2fMB)\n", $fsize);
	rename("gmapsupp.img", $out_file);
}

foreach my $bucket_ref (@result_buckets) {
	my @bucket = @{$bucket_ref};
	my $left = sprintf "%05.2f", $middles->{$bucket[0]}->{lon};
	my $right = sprintf "%05.2f", $middles->{$bucket[-1]}->{lon};
	my $name = "lon_".$left."_to_".$right;
	my $sstr = $size_mb."MB";
	dprintf1 "'%s' $sstr, (%s)\n", $name, join(",", @bucket);
	mkmap($name, $sstr, @bucket);
}

#mkmap("west", $size_mb."MB", @left_bucket);
#mkmap("east", $size_mb."MB", @right_bucket);
#mkmap("central", $size_mb."MB", @middle_bucket);