#!/usr/bin/perl -w

# $Id: TBcutter.pl,v 1.1 2008-09-15 20:20:06 semik Exp $
#
# This code is public domain.
#
# Autor: Jan Tomasek <jan@tomasek.cz>
# Web: http://www.tomasek.cz/software/TrekBuddy-turisticka-navigace/index.html

use strict;
use Image::Magick;
use Data::Dumper;
use File::Copy;
use Getopt::Std;
use List::Util qw(min max);

$| = 1;

my $file      = undef;
my $title_min = 512;
my $title_max = 1024;
my $colormap  = undef;
my $quality   = 100;

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

sub optimal_title {
  my $sug = shift;
  my $max = shift;
  my $dim = shift;

  my $x = $sug;

  while (($dim % $x != 0) and ($x<=$max)) { $x++; };

  return $x if ($x<=$max);
  return $sug;
};

sub die_usage {
  die "Usage: $0 [options] -f <filename>
Posible options:
  -f  filename to work on
  -n  sugested and minimum title size ($title_min)
  -m  maximum title size ($title_max)
  -c  colormap (undef)
  -q  quality ($quality)\n";
};

my %opt;
getopts("f:n:m:c:q:",\%opt);
$file = $opt{'f'} or die_usage;
$title_min = $opt{'n'} if (defined($opt{'n'}));
$title_max = $opt{'m'} if (defined($opt{'m'}));
$colormap  = $opt{'c'} if (defined($opt{'c'}));
$quality   = $opt{'q'} if (defined($opt{'q'}));

my $err;

# Sada pouzivanych barvicek
my $color_map;
if (defined($colormap)) {
  $color_map = new Image::Magick;
  $err = $color_map->Read('../google-colormap.png');
  die "$err\n" if ($err);
};


print "$file: reading\r";
my $prefix = $file;
$prefix =~ s,^.+(\\|/),,g; # Mno windows \ a Linux / ale portabilni to nejni...
$prefix =~ s/\.(png|jpeg|jpg)$//i;

# Nacist obrazek
my $im = new Image::Magick;
$err = $im->Read("$file");
die "$err\n" if ($err);

my ($width, $height) = $im->Get('width', 'height');
my $y_title = optimal_title($title_min, $title_max, $height);
my $x_title = optimal_title($title_min, $title_max, $width);

if (defined($color_map)) {
  print "$file: reducing number of colors\r";
  $im->Map(image => $color_map,
	   dither => 0);
};

my $cnt_max = ($width/$x_title+1)*($height/$y_title);
my $cnt = 0;
mkdir "$prefix";
mkdir "$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' => $quality,
	    'page' => ($xe-$x).'x'.($ye-$y).'+0+0');
    my $colors = $c->Get('colors');
    $c->Quantize(colors => $colors,
		 dither => 0);
    my $slice_file = $prefix."_".$x."_".$y.".png";
    $err = $c->Write("$prefix/set/".$slice_file);
    die "$err\n" if ($err);

    push @set, $slice_file;
  };
};

# Zapsat set
open(SET, ">$prefix/$prefix.set");
print SET join("\r\n", @set);
close(SET);