source: trunk/npemap.org.uk/scripts/tile-processing/makeSmaller.pl @ 449

Last change on this file since 449 was 449, checked in by Nick Burch, 13 years ago

Do dates stuff properly

  • Property svn:executable set to *
File size: 4.3 KB
Line 
1#!/usr/bin/perl
2#
3use List::Util qw[min max];
4use Image::Magick;
5
6my $tilesize = 125;
7
8my $scale = shift;
9unless($scale) { $scale = 6; }
10
11# Should we rescale as we go?
12my $rescale_by = 1;
13if($scale > 20) {
14        $rescale_by = 4;
15}
16my $out_tile_size = int($tilesize / $rescale_by);
17
18my $outdir = "scaled$scale";
19
20if (! -d $outdir) {
21    mkdir $outdir or die "Unable to create dir '$outdir'"
22}
23
24my @files = glob("*/tile-*.jpg");
25my %tiles ;
26
27my $minx, $miny, $maxx, $maxy;
28
29# Sort the tiles by directory name
30# (If we have two copies of the same tile, we want the newest one)
31@files = sort {
32        my ($adate) = ($a =~ /^.*?\-(\d\d\d\d)\//);
33        my ($bdate) = ($b =~ /^.*?\-(\d\d\d\d)\//);
34        if(!$adate && !$bdate) { return $a cmp $b; }
35        if($adate && !$bdate) { return 1; }
36        if($bdate && !$adate) { return -1; }
37        return $adate <=> $bdate;
38} @files;
39
40# Process the files into a hash, based on easting and northing
41foreach my $f (@files) {
42  $f =~ m/-(\d+)-(\d+)\./;
43  my ($x, $y) = ($1 +0, $2 +0);
44  $tiles{$x} ||= {};
45  $tiles{$x}{$y} = $f;
46}
47
48# Figure out our largest easting and northing values
49$maxx = max(keys %tiles);
50$maxy = max(map { max(keys %{$tiles{$_}})} keys %tiles);
51
52# The meta info's to re-create
53# (Only done for scale 1, and only record the eastings to update)
54my %update_meta;
55
56# start at 0, if there are any tiles in a WxW square, render a scale model
57# of it
58
59foreach my $x (0..($maxx/$scale)) {
60    foreach my $y (0..($maxy/$scale)) {
61        my $filename = sprintf("%s/%03d/%03d.jpg", $outdir, $x, $y);
62                my $meta_filename = sprintf("meta1/%03d.txt", $x);
63        my $outdir = sprintf("%s/%03d/", $outdir, $x);
64               
65                # Do we need to create the meta info?
66                if( ($scale == 1) && (! -f $meta_filename) ) {
67                        $update_meta{$x}++;
68                }
69
70                # Do we need to create / re-create the tile?
71                # (Check if tile exists, then if any of the parent tiles are newer)
72                my $create_tile = 0;
73        if( (! -f $filename) && any_tiles($x, $y, \%tiles) ) {
74                        $create_tile = 1;
75                }
76                foreach my $i (0..($scale -1)) {
77                        foreach my $j (0..($scale -1)) {
78                                if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
79                                        my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
80                                        # Is this newer than the tile?
81                                        if(-M $input < -M $filename) {
82                                                $create_tile = 1;
83                                        }
84                                }
85                        }
86                }
87
88                if($create_tile) {
89            print "Making $filename\n";
90            my $out = Image::Magick->new( size => "".($out_tile_size*$scale)."x".($out_tile_size*$scale) );
91            $out ->ReadImage('xc:white');
92
93            unless(-d $outdir) {
94                mkdir($outdir);
95            }
96
97 foreach my $i (0..($scale -1)) {
98     foreach my $j (0..($scale -1)) {
99         if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
100            my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
101            my $image = Image::Magick->new;
102            print $image->Read($input);
103                        #print "  Including $input\n";
104
105                        if($rescale_by > 1) {
106                                $image->Resize("${out_tile_size}x${out_tile_size}");
107                                #print "Resized $input to ${out_tile_size}x${out_tile_size}\n";
108                        }
109
110            print $out->Composite(image=>$image, x=> ($i*$out_tile_size), y=> ((($scale -1)-$j)*$out_tile_size) );
111            undef $image;
112        }
113     }
114 }
115
116                        # Do we need to update the meta info?
117                        if($scale == 1) {
118                                $update_meta{$x}++;
119                        }
120                       
121                        # Resize the image to 125x125, and write it out
122            $out->Resize("${tilesize}x$tilesize");
123            $out->Set(quality=>85);
124            $out->Write("jpg:$filename");
125            undef $out;
126            print "($x,$y)\n";
127        }
128   }
129}
130
131# Re-create the meta files
132foreach my $easting (sort keys %update_meta) {
133        my $meta_filename = sprintf("meta1/%03d.txt", $easting);
134        open(META, ">$meta_filename");
135        print META "# easting,northing,sheet,year\n";
136       
137        foreach my $northing (sort keys %{$tiles{$easting}}) {
138                my $file = $tiles{$easting}{$northing};
139                my ($sheet) = ($file =~ /^(\d+\w?)\-/);
140                my ($year) = ($file =~ /^\d+\w?\-tiles\-(\d+)/);
141                print META "${easting},${northing},$sheet,$year\n";
142        }
143
144        print "Recreated $meta_filename\n";
145        close META;
146}
147
148
149use Data::Dumper;
150
151print "($maxx, $maxy)\n";
152
153sub any_tiles {
154 my ($x, $y, $tiles) = (shift, shift, shift);
155 foreach my $i (0..($scale -1)) {
156     foreach my $j (0..($scale -1)) {
157         if (defined $$tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
158             return 1;
159         }
160     }
161 }
162 return 0;
163}
Note: See TracBrowser for help on using the repository browser.