#!/usr/bin/perl -w

use strict;
use Image::Magick;
use Data::Dumper;
use List::Util qw(min max);

$| = 1;

sub del_space {
  my $a = shift;
  $a =~ s/\s+//g;
  return $a;
};

my $y_title = 540;
my $x_title = 540;

# Sada pouzivanych barvicek
my $color_map = new Image::Magick;
$color_map->Read('map.png');

# Ziskat seznam failu v plnem rozliseni
opendir (PNG, 'PNG') or die "Can't open PNG: $!";
my @files = sort grep { /\.png$/ && -f "PNG/$_" } readdir(PNG);

my $fc;
foreach my $file (@files) {
  my $prefix = $file; $prefix =~ s/_.*//;
  $fc++;

  next if -f "TB/$prefix/$prefix.map";

  print "$file: reading\r";

  # Nacist plnej obrazek
  my $full_im = new Image::Magick;
  $full_im->Read("PNG/$file");
  my ($orig_width, $orig_height) = $full_im->Get('width', 'height');

  # Pokud neexistuje zmensena velikost -> udelat ji
  my $im = new Image::Magick;
  unless ( -f "PNG-50%/$file") {
    $im = $full_im->Clone;
    print "$file: resizing\r";
    $im->Resize('40x40%');
    $im->Map(image => $color_map,
	     dither => 0);
    $im->Set('quality' => 100);
    $im->Write("PNG-50%/$file");
  } else {
    print "$file: reading resized\r";
    $im->Read("PNG-50%/$file");
  };
  my ($width, $height) = $im->Get('width', 'height');

  # Nasekat na kousky
  unless (-f "TB/$prefix/set/".$prefix."_0_0.png") {
    my $cnt_max = ($width/$x_title+1)*($height/$y_title);
    my $cnt = 0;
    mkdir "TB/$prefix";
    mkdir "TB/$prefix/set";
    my @set;
    for (my $x=0; $x<$width; $x += $x_title) {
      my $xe = min($x+$x_title, $width);

      for (my $y=0; $y<$height; $y += $y_title) {
	my $ye = min($y+$y_title, $height);
	$cnt++;

	printf "%s: cutting %3.0f %%          \r", $file, min(100, 100*($cnt/$cnt_max));

	my $c = $im->Clone();
	$c->Crop(x => $x, y => $y,
		 width => $xe-$x,height => $ye-$y);
	$c->Set('quality' => 100,
		'page' => ($xe-$x).'x'.($ye-$y).'+0+0');
	my $slice_file = $prefix."_".$x."_".$y.".png";
	$c->Write("TB/$prefix/set/".$slice_file);
	push @set, $slice_file;
      };
    };
    # Zapsat set
    open(SET, ">TB/$prefix/$prefix.set");
    print SET join("\r\n", @set);
    close(SET);
  };

  # Prepocitat map soubor
  my $x_scale = $width/$orig_width;
  my $y_scale = $height/$orig_height;
  open(MAP, "<OZFX3/".$prefix."_ozf.map") or next;
  my @map;
  while (my $line = <MAP>) {
    if ($line =~ /^Point/) {
      my @line = split(/,/, $line);
      if ($line[2] eq '     ') {
	push @map, $line;
      } else {
	$line[2] = int(del_space($line[2])*$x_scale);
	$line[3] = int(del_space($line[3])*$y_scale);
	push @map, join(',', @line);
      };
    } elsif ($line =~ /^MMPXY/) {
      my @line = split(/,/, $line);
      $line[2] = int(del_space($line[2])*$x_scale);
      $line[3] = int(del_space($line[3])*$y_scale);
      push @map, join(',', @line)."\r\n";
    } elsif ($line =~ /IWH,Map Image/) {
      my @line = split(/,/, $line);
      $line[2] = int(del_space($line[2])*$x_scale);
      $line[3] = int(del_space($line[3])*$y_scale);
      push @map, join(',', @line)."\r\n";
    } else {
      push @map, $line;
    };
  };
  close(MAP);
  open(MAP, ">TB/$prefix/$prefix.map");
  print MAP join("", @map);
  close(MAP);

  printf "%s: done %d from %d files\n", $file, $fc, scalar(@files);
};

__END__