1 | #!/usr/bin/perl |
---|
2 | # |
---|
3 | use List::Util qw[min max]; |
---|
4 | use Image::Magick; |
---|
5 | |
---|
6 | my $tilesize = 125; |
---|
7 | my $scale = 3; |
---|
8 | |
---|
9 | my $outdir = "scaled$scale"; |
---|
10 | |
---|
11 | if (! -d $outdir) { |
---|
12 | mkdir $outdir or die "Unable to create dir '$outdir'" |
---|
13 | } |
---|
14 | |
---|
15 | my @files = glob("*/tile-*.jpg"); |
---|
16 | my %tiles ; |
---|
17 | |
---|
18 | my $minx, $miny, $maxx, $maxy; |
---|
19 | |
---|
20 | foreach my $f (@files) { |
---|
21 | $f =~ m/-(\d+)-(\d+)\./; |
---|
22 | my ($x, $y) = ($1 +0, $2 +0); |
---|
23 | $tiles{$x} ||= {}; |
---|
24 | $tiles{$x}{$y} = $f; |
---|
25 | |
---|
26 | } |
---|
27 | |
---|
28 | |
---|
29 | $maxx = max(keys %tiles); |
---|
30 | $maxy = max(map { max(keys %{$tiles{$_}})} keys %tiles); |
---|
31 | |
---|
32 | # start at 0, if there are any tiles in a WxW square, render a scale model |
---|
33 | # of it |
---|
34 | |
---|
35 | foreach my $x (0..($maxx/$scale)) { |
---|
36 | foreach my $y (0..($maxy/$scale)) { |
---|
37 | my $filename = sprintf("%s/%03d/%03d.jpg", $outdir,$x,$y); |
---|
38 | if ((! -f $filename) && any_tiles($x, $y, \%tiles) ) { |
---|
39 | my $out = Image::Magick->new(size => ($tilesize * $scale). "x".($tilesize *$scale)); |
---|
40 | $out ->ReadImage('xc:white'); |
---|
41 | foreach my $i (0..($scale -1)) { |
---|
42 | foreach my $j (0..($scale -1)) { |
---|
43 | if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) { |
---|
44 | my $image = Image::Magick->new; |
---|
45 | print $image->Read($tiles{($x*$scale)+$i}{($y*$scale)+$j}); |
---|
46 | print $out->Composite(image=>$image, x=>($i*$tilesize), y=>((($scale -1)-$j)*$tilesize)); |
---|
47 | undef $image; |
---|
48 | } |
---|
49 | } |
---|
50 | } |
---|
51 | $out->Resize("${tilesize}x$tilesize"); |
---|
52 | $out->Write("jpg:$filename"); |
---|
53 | undef $out; |
---|
54 | print "($x,$y)\n"; |
---|
55 | |
---|
56 | } |
---|
57 | } |
---|
58 | } |
---|
59 | |
---|
60 | use Data::Dumper; |
---|
61 | |
---|
62 | print "($maxx, $maxy)\n"; |
---|
63 | |
---|
64 | sub any_tiles { |
---|
65 | my ($x, $y, $tiles) = (shift, shift, shift); |
---|
66 | foreach my $i (0..($scale -1)) { |
---|
67 | foreach my $j (0..($scale -1)) { |
---|
68 | if (defined $$tiles{($x*$scale)+$i}{($y*$scale)+$j}) { |
---|
69 | return 1; |
---|
70 | } |
---|
71 | } |
---|
72 | } |
---|
73 | return 0; |
---|
74 | } |
---|