diff options
| -rwxr-xr-x | maketiles/10khalf | 180 |
1 files changed, 180 insertions, 0 deletions
diff --git a/maketiles/10khalf b/maketiles/10khalf new file mode 100755 index 000000000..48d59bc24 --- /dev/null +++ b/maketiles/10khalf @@ -0,0 +1,180 @@ +#!/usr/bin/perl -w +# +# 10khalf: +# Generate half-scale 1:10,000 Ordnance Survey map tiles from the +# full-resolution ones generated by 10kfull. +# +# Copyright (c) 2005 UK Citizens Online Democracy. All rights reserved. +# Email: chris@mysociety.org; WWW: http://www.mysociety.org/ +# + +my $rcsid = ''; $rcsid .= '$Id: 10khalf,v 1.1 2006-09-14 21:43:15 chris Exp $'; + +use strict; + +use Digest::SHA1; +use File::stat; +use IO::File; + +sub debug (@) { + print STDERR @_; +} + +sub System (@) { + #debug("executing command: ", @_, "\n"); + # need bash for <( ) command substitution + system("/bin/bash", '-c', join(' ', @_)); + die "command failed with status $?" if ($?); +} + +die "arguments are directory containing output files from 10kfull and directory to which the half-resolution tiles are to be written" + if (2 != @ARGV); + +my ($inputdir, $outputdir) = @ARGV; +$inputdir =~ s#/$##; +$outputdir =~ s#/$##; +die "$inputdir: not a directory" if (!-d $inputdir); +die "$outputdir: not a directory" if (!-d $outputdir); + +# +# Within the output directory we create a subdirectory tiles/ containing tile +# images named for their SHA1 checksums, and a text file mapping tile +# coordinates to the SHA1 sums. +# + +die "$outputdir/tiles: $!" + if (!mkdir("$outputdir/tiles", 0755) && !$!{EEXIST}); + +my $index = new IO::File("$outputdir/index", O_WRONLY | O_CREAT | O_TRUNC, 0644) + or die "$outputdir/index: $!"; + +$index->print(<<EOF); +# This index file connects individual tiles of the 1:10,000 Ordnance Survey +# maps at half their original resolution (1.27m/px). Each such tile is 254 by +# 254 pixels. The tiles are indexed according to their coordinates within the +# full Ordnance Survey grid, with (0, 0) being the tile at the SW corner of the +# grid (immediately NE of the origin), (1, 0) being the tile to its east, and +# (0, 1) the tile immediately to its north. Note that not all tiles are +# present. For each such tile position this file lists the SHA1 message-digest +# of the image file which represents the tile. +EOF + +my $in_index = new IO::File("$inputdir/index", O_RDONLY) + or die "$inputdir/index: $!"; + +my %fullrestiles = ( ); +my %halfrestiles = ( ); + +my $line; +while (defined($line = $in_index->getline()) && $line =~ /^#/) { } +if (!defined($line)) { + if ($in_index->error()) { + die "$inputdir/index: $! (while reading header)"; + } else { + die "$inputdir/index: premature EOF (while reading header)"; + } +} + +debug("reading $inputdir/index... "); +my $ntiles = 0; +my $nhalfrestiles = 0; +do { + chomp($line); + my ($i, $j, $sha1) = split(/\s+/, $line); + die "$inputdir/index: bad index line '$line'" + unless (defined($i) && defined($j) && defined($sha1) + && $i =~ /^(0|[1-9]\d*)$/ && $j =~ /^(0|[1-9]\d*)$/ + && $sha1 =~ /^[0-9a-f]{40}$/); + + my $i2 = int($i / 2); + my $j2 = int($j / 2); + my $k = pack('II', $i2, $j2); + if (!exists($halfrestiles{$k})) { + ++$nhalfrestiles; + $halfrestiles{$k} = undef; + } + + $fullrestiles{pack('II', $i, $j)} = $sha1; + ++$ntiles; +} while (defined($line = $in_index->getline())); + +die "$inputdir/index: $!" if ($in_index->error()); +$in_index->close(); +debug("done\n"); + +debug("read $ntiles from index\n"); +debug("have $nhalfrestiles to generate\n"); + +System("ppmmake '#ffffff' 254 254 > $outputdir/blank.ppm"); + +sub imgname ($) { + my $sha1 = shift; + if (!defined($sha1)) { + return "$outputdir/blank.ppm"; + } else { + $sha1 =~ s#^(.)(.)(.)(.+)$#$1/$2/$3/$1$2$3$4#; + return "<( pngtopnm $inputdir/tiles/$sha1.png )"; + } +} + +my %compose = ( ); +my $nnew = 0; +my $nduplicates = 0; +my $size = 0; +foreach my $k (keys(%halfrestiles)) { + my ($i2, $j2) = unpack('II', $k); + my @t = ( ); + my $n = 0; + for (my $j = 0; $j <= 1; ++$j) { + for (my $i = 0; $i <= 1; ++$i) { + $t[$n] = $fullrestiles{pack('II', 2 * $i2 + $i, 2 * $j2 + $j)}; +# debug("img #$n is ", defined($t[$n]) ? $t[$n] : '(blank)', "\n"); + ++$n; + } + } + + my $c = join(',', map { defined($_) ? $_ : '*' } @t); + my $fn = "$outputdir/out.png"; + my $sha; + + if (exists($compose{$c})) { + # we've already made this image + $sha = $compose{$c}; + } else { + # make it + @t = map { imgname($_) } @t; + System("pnmcat -tb <( pnmcat -lr $t[0] $t[1] ) <( pnmcat -lr $t[2] $t[3] )" + . " | pnmscale -reduce 2 2>/dev/null" + . " | pnmtopng -compression 9 2>/dev/null > $fn"); + + my $f = new IO::File($fn, O_RDONLY) + or die "$fn: $!"; + $sha = new Digest::SHA1(); + $sha->addfile($f); + $sha = $sha->hexdigest(); + $f->close(); + + $compose{$c} = $sha; + } + + $index->printf("%d %d %s\n", $i2, $j2, $sha); + my ($n1, $n2, $n3) = ($sha =~ /^(.)(.)(.)/); + mkdir("$outputdir/tiles/$n1"); + mkdir("$outputdir/tiles/$n1/$n2"); + mkdir("$outputdir/tiles/$n1/$n2/$n3"); + my $fn2 = "$outputdir/tiles/$n1/$n2/$n3/$sha.png"; + if (-e $fn2) { + unlink($fn); + ++$nduplicates; + } else { + rename($fn, $fn2) or die "rename: $!"; + ++$nnew; + my $st = stat($fn2); + $size += $st->size(); + } + + debug("have $nnew new, $nduplicates duplicates, total size $size bytes\n"); +} + +# get rid of the blank PPM. +unlink("$outputdir/blank.ppm"); |