File indexing completed on 2023-05-30 09:06:25
0001 #!/usr/bin/perl 0002 0003 use LWP::Simple; 0004 use Image::Magick; 0005 0006 print 'downloading image from server...' . "\n"; 0007 $response = getstore('https://realearth.ssec.wisc.edu/cgi-bin/mapserv?map=globalir.map&layer=latest_globalir&mode=map&srs=EPSG:4326&width=40&height=20&bbox=-180,-90,180,90&format=image/jpg', 'clouds.jpg'); 0008 die 'error downloading image' unless is_success($response); 0009 0010 $clouds = Image::Magick->new(); 0011 $clouds->ReadImage('clouds.jpg'); 0012 0013 print 'resizing source image...' . "\n"; 0014 $clouds->Resize(width=>'2700', height=>'1350'); 0015 0016 sub tile { 0017 my ($x, $y, $level) = @_; 0018 0019 $tile = $clouds->Clone(); 0020 $tile->Crop(geometry=>'675x675+' . ($x * 675) . '+' . ($y * 675)); 0021 0022 $xstr = '00000' . $x; 0023 $ystr = '00000' . $y; 0024 0025 mkdir($level . '/' . $ystr); 0026 $fname = $level . '/' . $ystr . '/' . $ystr . '_' . $xstr . '.jpg'; 0027 print 'saving ' . $fname . '...' . "\n"; 0028 $tile->Write($fname); 0029 } 0030 0031 # level 1 0032 mkdir('1'); 0033 for($x = 0; $x < 4; $x++) { 0034 for($y = 0; $y < 2; $y++) { 0035 tile($x, $y, '1'); 0036 } 0037 } 0038 0039 print 'resizing source image...' . "\n"; 0040 $clouds->Resize(width=>'1350', height=>'675'); 0041 0042 # level 0 0043 mkdir('0'); 0044 for($x = 0; $x < 2; $x++) { 0045 for($y = 0; $y < 1; $y++) { 0046 tile($x, $y, '0'); 0047 } 0048 } 0049 0050 # create expiration.txt 0051 open(EXP, '>', 'expiration.txt'); 0052 print EXP 'Timestamp: ' . time . "\n"; 0053 print EXP 'Expiration: 10800' . "\n"; 0054 close(EXP); 0055