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

Last change on this file since 675 was 675, checked in by Nick Burch, 11 years ago

Map legend support for meta files

  • Property svn:executable set to *
File size: 6.3 KB
Line 
1#!/usr/bin/perl
2#
3# Copyright (c) 2006-2007 David Sheldon and Nick Burch
4# Permission is hereby granted, free of charge, to any person obtaining a
5# copy of this software and associated documentation files (the "Software"),
6# to deal in the Software without restriction, including without limitation
7# the rights to use, copy, modify, merge, publish, distribute, sublicense,
8# and/or sell copies of the Software, and to permit persons to whom the
9# Software is furnished to do so, subject to the following conditions:
10#
11# The above copyright notice and this permission notice shall be included in
12# all copies or substantial portions of the Software.
13#
14# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
17# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20# IN THE SOFTWARE.
21#
22use List::Util qw[min max];
23use Image::Magick;
24
25my $tilesize = 125;
26
27my $scale = shift;
28unless($scale) { $scale = 6; }
29
30# Should we rescale as we go?
31my $rescale_by = 1;
32if($scale > 20) {
33        $rescale_by = 4;
34}
35my $out_tile_size = int($tilesize / $rescale_by);
36
37my $outdir = "scaled$scale";
38
39if (! -d $outdir) {
40    mkdir $outdir or die "Unable to create dir '$outdir'"
41}
42
43my @files = glob("*/tile-*.jpg");
44my %tiles ;
45
46my $minx, $miny, $maxx, $maxy;
47
48# Sort the tiles by directory name
49# (If we have two copies of the same tile, we want the newest one)
50@files = sort {
51        my ($adate) = ($a =~ /^.*?\-(\d\d\d\d)\//);
52        my ($bdate) = ($b =~ /^.*?\-(\d\d\d\d)\//);
53        if(!$adate && !$bdate) { return $a cmp $b; }
54        if($adate && !$bdate) { return 1; }
55        if($bdate && !$adate) { return -1; }
56        return $adate <=> $bdate;
57} @files;
58
59# Process the files into a hash, based on easting and northing
60foreach my $f (@files) {
61  $f =~ m/-(\d+)-(\-?\d+)\./;
62  my ($x, $y) = ($1 +0, $2 +0);
63  $tiles{$x} ||= {};
64  $tiles{$x}{$y} = $f;
65}
66
67# Figure out our largest easting and northing values
68$maxx = max(keys %tiles);
69$maxy = max(map { max(keys %{$tiles{$_}})} keys %tiles);
70$miny = min(map { min(keys %{$tiles{$_}})} keys %tiles);
71
72# The meta info's to re-create
73# (Only done for scale 1, and only record the eastings to update)
74my %update_meta;
75
76# start at 0, if there are any tiles in a WxW square, render a scale model
77# of it
78
79foreach my $x (0..($maxx/$scale)) {
80    foreach my $y (($miny/$scale)..($maxy/$scale)) {
81        # Note - channel island maps with negative y values will end up
82        #   as scaledX/ddd/-dd.jpg, as the - counts as a digit
83        my $filename = sprintf("%s/%03d/%03d.jpg", $outdir, $x, $y);
84
85                my $meta_filename = sprintf("meta1/%03d.txt", $x);
86        my $outdir = sprintf("%s/%03d/", $outdir, $x);
87               
88                # Do we need to create the meta info?
89                if( ($scale == 1) && (! -f $meta_filename) ) {
90                        $update_meta{$x}++;
91                }
92
93                # Do we need to create / re-create the tile?
94                # (Check if tile exists, then if any of the parent tiles are newer)
95                my $create_tile = 0;
96        if( (! -f $filename) && any_tiles($x, $y, \%tiles) ) {
97                        $create_tile = 1;
98                }
99                foreach my $i (0..($scale -1)) {
100                        foreach my $j (0..($scale -1)) {
101                                if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
102                                        my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
103                                        # Is this newer than the tile?
104                                        if(-M $input < -M $filename) {
105                                                $create_tile = 1;
106                                        }
107                                }
108                        }
109                }
110
111                if($create_tile) {
112            print "Making $filename\n";
113            my $out = Image::Magick->new( size => "".($out_tile_size*$scale)."x".($out_tile_size*$scale) );
114            $out ->ReadImage('xc:white');
115
116            unless(-d $outdir) {
117                mkdir($outdir);
118            }
119
120 foreach my $i (0..($scale -1)) {
121     foreach my $j (0..($scale -1)) {
122         if (defined $tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
123            my $input = $tiles{($x*$scale)+$i}{($y*$scale)+$j};
124            my $image = Image::Magick->new;
125            print $image->Read($input);
126                        #print "  Including $input\n";
127
128                        if($rescale_by > 1) {
129                                $image->Resize("${out_tile_size}x${out_tile_size}");
130                                #print "Resized $input to ${out_tile_size}x${out_tile_size}\n";
131                        }
132
133            print $out->Composite(image=>$image, x=> ($i*$out_tile_size), y=> ((($scale -1)-$j)*$out_tile_size) );
134            undef $image;
135        }
136     }
137 }
138
139                        # Do we need to update the meta info?
140                        if($scale == 1) {
141                                $update_meta{$x}++;
142                        }
143                       
144                        # Resize the image to 125x125, and write it out
145            $out->Resize("${tilesize}x$tilesize");
146            $out->Set(quality=>85);
147            $out->Write("jpg:$filename");
148            undef $out;
149            print "($x,$y)\n";
150        }
151   }
152}
153
154# Load in our list of what legends apply
155my %legends;
156open(LEGENDS, "<../legends/which.txt");
157while(my $line = <LEGENDS>) {
158    chomp $line;
159    unless($line) { next; }
160    if($line =~ /^(\d+.*?-19\d\d)\s+([\w\d\-\_]+)\s*$/) {
161        my ($dir,$legend) = ($1,$2);
162        $legends{$dir} = $legend;
163    } elsif($line =~ /^(\d+.*?-tiles-WO)\s+([\w\d\-\_]+)\s*$/) {
164        my ($dir,$legend) = ($1,$2);
165        $legends{$dir} = $legend;
166    } else {
167        warn("Invalid legends line: '$line'\n");
168    }
169}
170
171# Re-create the meta files
172foreach my $easting (sort keys %update_meta) {
173        my $meta_filename = sprintf("meta1/%03d.txt", $easting);
174        open(META, ">$meta_filename");
175        print META "# easting,northing,sheet,year,legend\n";
176       
177        foreach my $northing (sort keys %{$tiles{$easting}}) {
178                my $file = $tiles{$easting}{$northing};
179                my ($sheet) = ($file =~ /^(\d+\w?)\-/);
180                my ($year) = ($file =~ /^\d+\w?\-tiles\-(\d+)/);
181                my ($dir) = ($file =~ /^(\d+.*?)\//);
182
183        my $legend = $legends{$dir} or "";
184
185        # Handle Channel Island maps
186        if(!$sheet && $file =~ /^([GJ]\w+)\-tiles\-(\d+)/) {
187            $sheet = $1;
188            $year = $2;
189        }
190
191                print META "${easting},${northing},$sheet,$year,$legend\n";
192        }
193
194        print "Recreated $meta_filename\n";
195        close META;
196}
197
198
199use Data::Dumper;
200
201print "($maxx, $maxy)\n";
202
203sub any_tiles {
204 my ($x, $y, $tiles) = (shift, shift, shift);
205 foreach my $i (0..($scale -1)) {
206     foreach my $j (0..($scale -1)) {
207         if (defined $$tiles{($x*$scale)+$i}{($y*$scale)+$j}) {
208             return 1;
209         }
210     }
211 }
212 return 0;
213}
Note: See TracBrowser for help on using the repository browser.