source: subversion/applications/utils/tileDownloader/tileDownloader2.pl @ 30254

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