Perl/Tk --- Weather Map Grabber

Greetings Perl Monks and all others interested in Perl who visit this site. In tinkering around with Perl at home I like to create science related scripts using Tk and other cool related modules that I have discovered. My latest experiment in Perl/Tk is a Weather Forecast Map Grabber. In this script I make use of the modules: Tk, Tk::DialogBox, and LWP::Simple to grab the image from the internet, place it in a sized Tk Window, and provide a little bit of information when you click on the image (that's where the Dialog Box comes in). The Map is a simple forecast map generated by the National Weather Service centered on North America. However, the link can be changed in the code to grab any map or image that you want and display it. Anyway enough said. The code is posted below. Enjoy!

As always, any feedback or suggestions for improvement of the code are greatly appreciated. I am continuously looking for new and cool ways to do things in Perl.

#!/usr/bin/perl -w

use strict;

use LWP::Simple;
use Tk;
use Tk::DialogBox;

my $url="http://www.hpc.ncep.noaa.gov/noaa/noaa.gif";
my $file="noaa.gif";


my $MW=MainWindow->new(-title=>"NOAA/NWS/NCEP Current U.S. Forecast Ma
+p");


### --- Prevents Main Window Resizing
$MW->bind('<Configure>' => sub{
        my $xe = $MW->XEvent;
        $MW->maxsize($xe->w, $xe->h);
        $MW->minsize($xe->w, $xe->h);
});


print "Please Wait...\nAcquiring Image from www.hpc.ncep.noaa.gov ....
+\n";
my $status=getstore($url,$file);

if ($status==500){
    my $exit = $MW->Button(-text => "500-NETWORK ERROR Unable to Commu
+nicate with Host\nCheck your Network Connection!\n Click to EXIT",
               -foreground => 'red',    
               -background => "yellow",
                -activebackground => "red",
                       -font => 'Arial',
                       -command => sub
            {
             exit;
            });
$exit->pack;
MainLoop();
}

if ($status==404){
    my $exit = $MW->Button(-text => "404-ERROR FILE MISSING\nImage is 
+Temporarily Unavailable on Server\n Click to EXIT",
               -foreground => 'red',    
               -background => "yellow",
                -activebackground => "red",
                       -font => 'Arial',
                       -command => sub
            {
             exit;
            });
$exit->pack;
MainLoop();
}

print "generating Tk Window ....\n";
 my $image = $MW->Photo(-file=>"noaa.gif", -width=>896, -height=>716);
$MW->Button(-image=>$image,
                      -width=>896,
                      -height=>716,
        -command => sub
         { 
        my $dialogA = $MW->DialogBox( -title   => "About This Image",
                                              -buttons => [ "OK" ],
                                );

            $dialogA->add("Label",
                
                -borderwidth => '2',
                -background => "#FAEBD7", #ANTIQUE WHITE
                                -font => 'bold',
                    -justify => 'left',
                -relief => 'sunken',
                                -text => "This Image is Produced by:\n
+ National Weather Service Hydrometeorological Prediction Center\n htt
+p://www.hpc.ncep.noaa.gov/ \nThis forecast is updated daily \@ 09:00 
+UTC. ")->pack;

### --- Prevents Dialog Box Resizing
$dialogA->bind('<Configure>' => sub{
        my $xeD = $dialogA->XEvent;
        $dialogA->maxsize($xeD->w, $xeD->h);
        $dialogA->minsize($xeD->w, $xeD->h);
});
            $dialogA->Show;
}
 )->pack;



MainLoop();

#############################################
## TkForecastMap.pl
## version 1.0 -- 07/23/2003 by Jay Madigan
## This program is freeware and may be modified and/or redistributed
## under the same terms as the GNU public license of Perl.
## No warranty on this code is assumed or implied.
#############################################
[download]

edited by ybiC: balanced <readmore> tags

Back to Cool Uses for Perl