source: subversion/applications/utils/tileDownloader/tileDownloader.pl @ 30595

Last change on this file since 30595 was 12945, checked in by frederik, 11 years ago

tileDownloader, a perl script written by Jozef Vince <jozef.vince@…> for downloading tiles from OSM

File size: 6.5 KB
Line 
1#!/usr/bin/perl
2use LWP::UserAgent;
3use Math::Trig;
4use File::Copy;
5use FindBin qw($Bin);
6use English '-no_match_vars';
7use GD qw(:DEFAULT :cmp);
8use utility_config;
9use strict;
10#-----------------------------------------------------------------------------
11# OpenStreetMap tiles@home
12#
13# Contact OJW on the Openstreetmap wiki for help using this program
14#-----------------------------------------------------------------------------
15# Copyright 2006, Oliver White, Etienne Cherdlu, Dirk-Lueder Kreie,
16# and others
17#
18# This program is free software; you can redistribute it and/or
19# modify it under the terms of the GNU General Public License
20# as published by the Free Software Foundation; either version 2
21# of the License, or (at your option) any later version.
22#
23# This program is distributed in the hope that it will be useful,
24# but WITHOUT ANY WARRANTY; without even the implied warranty of
25# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
26# GNU General Public License for more details.
27#
28# You should have received a copy of the GNU General Public License
29# along with this program; if not, write to the Free Software
30# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
31#-----------------------------------------------------------------------------
32
33# Get version number from version-control system, as integer
34
35my $lastmsglen = 0;
36
37
38# hash for MagicMkdir
39my %madeDir;
40
41
42# check GD
43eval GD::Image->trueColor(1);
44if ($@ ne '') {
45  print STDERR "please update your libgd to version 2 for TrueColor support";
46  exit(3);
47}
48
49# Setup GD options
50# currently unused (GD 2 truecolor mode)
51#
52#   my $numcolors = 256; # 256 is maximum for paletted output and should be used
53#   my $dither = 0; # dithering on or off.
54#
55# dithering off should try to find a good palette, looks ugly on
56# neighboring tiles with different map features as the "optimal"
57# palette is chosen differently for different tiles.
58
59# Handle the command-line
60
61my %Config;
62
63  my  $arg = shift();
64  if ($arg=="conf")
65  {
66     my $cfgfile= shift();
67     
68     %Config = ReadConfig($cfgfile);
69     print "Using config file  $cfgfile\n";
70  }
71  else
72  {
73
74    $Config{DownLoadURL}= 'http://www.freemap.sk';
75    $Config{Layers} = 'tiles,names';
76    $Config{X} = $arg;
77    $Config{Y} = shift();
78    $Config{Zoom} = shift();
79    $Config{Zoom2} = shift();
80    $Config{W} = shift();
81    $Config{H} = shift();
82
83    $Config{R} = shift();
84
85    if( defined $Config{R})
86    {
87                $Config{G} = shift();
88                $Config{B} = shift();
89    }
90  }
91
92
93my $totalTiles=0;
94my $doneTiles=0;
95
96my $k;
97
98   for ($k=$Config{Zoom};$k<=$Config{Zoom2}; $k++)
99   {
100    $totalTiles += 4**($k-$Config{Zoom});
101   }
102   
103    $totalTiles = $Config{W}*$Config{H}*$totalTiles;
104    GenerateMap();
105
106
107#-----------------------------------------------------------------------------
108# Render a tile (and all subtiles, down to a certain depth)
109#-----------------------------------------------------------------------------
110sub GenerateMap
111{
112
113
114
115  my $i;
116  my $j;
117 
118  my $URL;
119  my $ImageFile;
120
121  for ($i=0; $i<$Config{W}; $i++)
122      {
123      for ($j=0; $j<$Config{H}; $j++)
124          {
125           DownloadTile( $Config{X}+$i, $Config{Y}+$j, $Config{Zoom}, $Config{Zoom2});
126          }
127      }
128  }
129
130sub DownloadTile()
131{
132  my ($X, $Y, $Zoom, $Zoom2) = @_;
133
134  $doneTiles++;
135  my $Map = new GD::Image(256, 256);
136
137  my $MapBg;
138  if( defined $Config{R}  )
139  {
140        $MapBg = $Map->colorAllocate($Config{R},$Config{G},$Config{B});
141  }
142  else
143  {
144        $MapBg = $Map->colorAllocate(248,248,248);
145        $Map->transparent($MapBg);
146  }
147
148  $Map->fill(127,127,$MapBg);
149
150  my $URL;
151  my $ImageFile;
152
153      foreach my $layer(split(/,/, $Config{Layers}))
154      {
155          # stiahnut tile
156          $URL = sprintf("%s/%s/%d/%d/%d.png",$Config{DownLoadURL}, $layer,$Zoom, $X, $Y);
157          $ImageFile= sprintf("%d_%d_%d.png", $Zoom, $X, $Y);
158
159          DownloadFile($URL,$ImageFile, 0 );
160
161          #pridat na spravne miesto
162
163          if (-e $ImageFile)
164          {
165             if (-s $ImageFile >128)
166             {
167                my $SubImage = newFromPng GD::Image($ImageFile);
168
169                #GD::Image::copy(destination, source, dstX, dstY, srcX, srcY, w, h)
170                GD::Image::copy($Map, $SubImage, 0, 0, 0,0,256,256);
171              }
172
173                          killafile($ImageFile);
174           }
175       }
176       StoreTile ($X, $Y,$Zoom,$Map);
177       if ($Zoom < $Zoom2)
178       {
179       DownloadTile( $X*2, $Y*2, $Zoom+1, $Zoom2);
180       DownloadTile( $X*2, $Y*2+1, $Zoom+1, $Zoom2);
181       DownloadTile( $X*2+1, $Y*2, $Zoom+1, $Zoom2);
182       DownloadTile( $X*2+1, $Y*2+1, $Zoom+1, $Zoom2);
183       }
184       
185       
186}
187
188
189sub StoreTile()
190{
191  my ($X, $Y, $Zoom, $Map) = @_;
192
193  my $FinalFile;
194  $FinalFile= sprintf("data/%d/%d/%d.png", $Zoom, $X, $Y);
195  MagicMkdir ($FinalFile);
196 
197  WriteImagePNG ($Map, $FinalFile);
198 
199}
200
201sub MagicMkdir
202{
203    my ($file) = @_;
204    my @paths = split("/", $file);
205    pop(@paths);
206    my $dir = ".";
207    foreach my $path(@paths)
208    {
209        $dir .= "/".$path;
210        if (!defined($madeDir{$dir}))
211        {
212            mkdir $dir;
213            $madeDir{$dir}=1;
214        }
215    }
216}
217
218
219
220#-----------------------------------------------------------------------------
221# Delete a file if it exists
222#-----------------------------------------------------------------------------
223sub killafile($){
224  my $file = shift();
225  unlink $file if(-f $file);
226}
227
228
229
230#-----------------------------------------------------------------------------
231#
232#-----------------------------------------------------------------------------
233sub DownloadFile 
234{
235  my ($URL, $File, $UseExisting) = @_;
236 
237  statusMessage ( "Downloading file $URL",0);
238    my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 120);
239    $ua->agent("FreemapDiSK");
240    $ua->env_proxy();
241
242    if(!$UseExisting) 
243  {
244    killafile($File);
245  }
246  $ua->mirror($URL, $File);
247 
248}
249
250sub statusMessage
251{
252    my ($msg, $newline) = @_;
253
254
255   
256    my $toprint = sprintf("[%3d%%]%s%s ", $doneTiles*100/$totalTiles , $msg, ($newline) ? "" : "...");
257    my $curmsglen = length($toprint);
258    print STDERR "\r$toprint";
259    print STDERR " " x ($lastmsglen-$curmsglen);
260    if ($newline)
261    {
262        $lastmsglen = 0;
263        print STDERR "\n";
264    }
265    else
266    {
267        $lastmsglen = $curmsglen;
268    }
269
270}
271
272
273
274#-----------------------------------------------------------------------------
275# Write a GD image to disk
276#-----------------------------------------------------------------------------
277sub WriteImagePNG {
278  my ($Image, $Filename) = @_;
279 
280  # Get the image as PNG data
281  my $png_data = $Image->png;
282 
283  # Store it
284  open (my $fp, ">$Filename") || die;
285  binmode $fp;
286  print $fp $png_data;
287  close $fp;
288}
Note: See TracBrowser for help on using the repository browser.