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

Replies are listed 'Best First'.
Re: Perl/Tk --- Weather Map Grabber
by teabag (Pilgrim) on Jul 25, 2003 at 10:19 UTC
    Excellent work,

    But maybe you can add some weather textinfo though. If you decide to do so, you can use the code below to get the ICAO info from an airport close to your house.

    I fetched this info with Net::FTP, (which is a little bit faster I believe?) but LWP::Simple works just as good.

    #!/usr/bin/perl -w

use strict;
use LWP::Simple;
use HTTP::Request;

#Name your city, village, carton box
my $city = "My City";

#Text to appear in above weatherreport
my $wthrtext = "Current Weather in $city:";

# Your very own ICAO location.  See http://weather.noaa.gov for more i
+nfo...
my $weathericao = "EHAM.TXT";

# Create yer user agent object
use LWP::UserAgent;
my $ua = new LWP::UserAgent;
$ua->agent( "WeatherBot " . $ua->agent );

# Add your request ;)
my $req =
  HTTP::Request->new( GET =>
      "ftp://weather.noaa.gov/data/observations/metar/decoded/$weather
+icao" );
$req->header( Accept => "text/html, */*;q=0.1" );

# Now pass that request to the user agent and get a response back
my $res = $ua->request($req);

# Check the outcome of the response
if ( $res->is_success ) {
    print "Fetched weather...\n\n";
}
else {
    print "Nope, couldn't fetch weather...\n";
    exit;
}
my $weather = $res->content;

#Bring on the sunshine!
print "$wthrtext\n\n$weather";

    [download]

    Aaaah, Sunshine ;)

    Teabag
    Sure there's more than one way, but one just needs one anyway - Teabag

[reply]
[d/l]
[select]
      Greetings! Thank you for your reply and feedback. Have you seen this particular module: Geo::WeatherNWS ? I have been developing some code to work with it (not quite ready to post yet). In a nutshell, you input the the station ID code, it goes to a National Weather Service Database, gets the current conditions report, parses it, and outputs values such as temperature, relative humidity, windspeed+direction, etc..... I believe it is well worth your time to take a look at!

      Anyway that is my 2 cents worth! Thanks again for your input.

[reply]

Back to Cool Uses for Perl