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

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

Re-create tiles if their source files are newer. When deciding which of multiple copies of a tile to use, go with the newest one

  • Property svn:executable set to *
File size: 4.2 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($adata && !$bdate) { return 1; }
35        if($bdata && !$adate) { return -1; }
36        return $adate <=> $bdate;
37} @files;
38
39# Process the files into a hash, based on easting and northing
40foreach my $f (@files) {
41  $f =~ m/-(\d+)-(\d+)\./;
42  my ($x, $y) = ($1 +0, $2 +0);
43  $tiles{$x} ||= {};
44  $tiles{$x}{$y} = $f;
45}
46
47# Figure out our largest easting and northing values
48$maxx = max(keys %tiles);
49$maxy = max(map { max(keys %{$tiles{$_}})} keys %tiles);
50
51# The meta info's to re-create
52# (Only done for scale 1, and only record the eastings to update)
53my %update_meta;
54
55# start at 0, if there are any tiles in a WxW square, render a scale model
56# of it
57
58foreach my $x (0..($maxx/$scale)) {
59    foreach my $y (0..($maxy/$scale)) {
60        my $filename = sprintf("%s/%03d/%03d.jpg", $outdir, $x, $y);
61                my $meta_filename = sprintf("meta1/%03d.txt", $x);
62        my $outdir = sprintf("%s/%03d/", $outdir, $x);
63               
64                # Do we need to create the meta info?
65                if( ($scale == 1) && (! -f $meta_filename) ) {
66                        $update_meta{$x}++;
67                }
68
69                # Do we need to create / re-create the tile?
70                # (Check if tile exists, then if any of the parent tiles are newer)
71                my $create_tile = 0;
72        if( (! -f $filename) && any_tiles($x, $y, \%tiles) ) {
73                        $create_tile = 1;
74                }
75                foreach my $i (0..($scale -1)) {
76                        foreach my $j (0..($scale -1)) {
77                                if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
78                                        my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
79                                        # Is this newer than the tile?
80                                        if(-M $input < -M $filename) {
81                                                $create_tile = 1;
82                                        }
83                                }
84                        }
85                }
86
87                if($create_tile) {
88            print "Making $filename\n";
89            my $out = Image::Magick->new( size => "".($out_tile_size*$scale)."x".($out_tile_size*$scale) );
90            $out ->ReadImage('xc:white');
91
92            unless(-d $outdir) {
93                mkdir($outdir);
94            }
95
96 foreach my $i (0..($scale -1)) {
97     foreach my $j (0..($scale -1)) {
98         if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
99            my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
100            my $image = Image::Magick->new;
101            print $image->Read($input);
102                        #print "  Including $input\n";
103
104                        if($rescale_by > 1) {
105                                $image->Resize("${out_tile_size}x${out_tile_size}");
106                                #print "Resized $input to ${out_tile_size}x${out_tile_size}\n";
107                        }
108
109            print $out->Composite(image=>$image, x=> ($i*$out_tile_size), y=> ((($scale -1)-$j)*$out_tile_size) );
110            undef $image;
111        }
112     }
113 }
114
115                        # Do we need to update the meta info?
116                        if($scale == 1) {
117                                $update_meta{$x}++;
118                        }
119                       
120                        # Resize the image to 125x125, and write it out
121            $out->Resize("${tilesize}x$tilesize");
122            $out->Set(quality=>85);
123            $out->Write("jpg:$filename");
124            undef $out;
125            print "($x,$y)\n";
126        }
127   }
128}
129
130# Re-create the meta files
131foreach my $easting (sort keys %update_meta) {
132        my $meta_filename = sprintf("meta1/%03d.txt", $easting);
133        open(META, ">$meta_filename");
134        print META "# easting,northing,sheet,year\n";
135       
136        foreach my $northing (sort keys %{$tiles{$easting}}) {
137                my $file = $tiles{$easting}{$northing};
138                my ($sheet) = ($file =~ /^(\d+\w?)\-/);
139                my ($year) = ($file =~ /^\d+\w?\-tiles\-(\d+)/);
140                print META "${easting},${northing},$sheet,$year\n";
141        }
142
143        print "Recreated $meta_filename\n";
144        close META;
145}
146
147
148use Data::Dumper;
149
150print "($maxx, $maxy)\n";
151
152sub any_tiles {
153 my ($x, $y, $tiles) = (shift, shift, shift);
154 foreach my $i (0..($scale -1)) {
155     foreach my $j (0..($scale -1)) {
156         if (defined $$tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
157             return 1;
158         }
159     }
160 }
161 return 0;
162}
Note: See TracBrowser for help on using the repository browser.