A Very Simple Weather App

Keith Vetter 2003-12-03 : All for the want of a thermometer. Because I lack a thermometer and now that it's getting cold around me, I finally decided to write a tiny app that will display the current temperature scraped off a web page. TclWeather seemed more than I wanted but it did steer me to the NOAA web page for the weather data [1].

What I wanted was: 1) a small unadorned window showing the current temperature and the time is was recorded, and/or 2) the temp/time displayed in the task bar.

I've included a windows icon file to make the taskbar look nicer. Also, clicking on either display will toggle the visibility of the other (this may only work well on Windows). One last detail, you'll have to give it the NOAA weather station id for you location.

Stu 2008-10-25 Small q&d change to the time regexp: "EST" -> "E.T". I guess once the weather got nice you didn't bother checking the temperature anymore! :D

 #
 # fahrenheit.tcl -- scraps current temperature from the NOAA weather page
 # by Keith Vetter, December 2003
 
 package require Tk
 package require http 2.0
 
 # METAR weather info
 #  cooked: http://weather.noaa.gov/weather/current/KVTA.html
 #  raw:    http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=KVTA
 #  format: http://weather.unisys.com/wxp/Appendices/Formats/METAR.html
 
 array set G {temp " ??\xB0" time "??:?? " maxDelay 1800000}
 set G(where) [lindex [concat $argv "KVTA"] 0]
 
 proc GetMETAR {where} {
    .t config -bg red
    set url http://weather.noaa.gov/weather/current/$where.html
    set n [catch {set token [::http::geturl $url]}]
    .t config -bg [lindex [.t config -bg] 3]
 
    if {$n || [http::ncode $token] != 200} {    ;# Error downloading
        catch {http::cleanup $token}
        return [list "??:?? " " ??\xB0"]
    }
    set data [::http::data $token]
    ::http::cleanup $token
 
    # Scrape the temperature
    set n [regexp -nocase {Temperature (.*?)F \(} $data => temp]
    regsub -all {<.*?>} $temp {} temp
    set temp [expr {round($temp)}]
    append temp \xB0
 
    # Scrape the time of the last update
    set n [regexp {(\d\d:\d\d) .M E.T} $data => tupdate]
    regsub {^0} $tupdate { } tupdate
    return [list "$tupdate " " $temp"]
 }
 proc UpdateTemperature {} {
    global G
 
    foreach id [after info] {after cancel $id}  ;# Be safe
    foreach {G(time) G(temp)} [GetMETAR $G(where)] break
    wm title . "$G(temp) $G(time)"
 
    set next [clock scan "$G(time) + 1 hour + 5 minutes"] ;# Next Metar update
    set delay [expr {1000 * ($next - [clock seconds])}]
    if {$delay < 0} {                           ;# Past report time
        set delay [expr {1000 * 5 * 60}]        ;# ...then every 5 minutes
    } elseif {$delay > $G(maxDelay)} {
        set delay $G(maxDelay)
    }
    after $delay UpdateTemperature
 }
 proc ToggleVisibility {how} {
    if {$how == "map"} {
        wm iconify .
        wm [expr {[wm state .t] eq "normal" ? "withdraw" : "deiconify"}] .t
    } else {
        wm [expr {[wm state .] eq "iconic" ? "withdraw" : "iconify"}] .
    }
 }
 wm iconify .
 catch {wm iconbitmap . fahrenheit.ico}          ;# Use this icon if possible
 toplevel .t -bd 2 -relief raised
 wm overrideredirect .t 1
 wm geometry .t -176-64
 pack [label .t.temp -textvariable G(temp)] -side left
 .t.temp configure -font "[font actual [.t.temp cget -font]] -weight bold"
 pack [label .t.time -textvariable G(time) -font [.t.temp cget -font]] -side left
 
 bind all <Button-1> [list ToggleVisibility x]
 bind all <Key-F2> {console show}
 bind all <Key-q> exit
 update
 bind . <Map> [list ToggleVisibility map]
 after 1 UpdateTemperature
 
 return

Here is a Windows icon and code to copy it to a file called fahrenheit.ico.

 # A Windows icon you can use--it will create a file called fahrenheit.ico
 if {[catch {package require base64}]} return
 set icodata {
 AAABAAEAEBAAAAEAGABoAwAAFgAAACgAAAAQAAAAIAAAAAEAGAAAAAAAAAAAAEgAAABIAAAAAAAA
 AAAAAADz8/Pz8/Pz8/P08vLa4eK9u7idoqCkpKOnpaKenpzU1dby9e3z8fLz8/Pz8/Pz8/Pz8/Py
 8vLz8/O/v72Mjo7Mz8unqu2GkvClr+va4N2SlY+trbPt9fHz8/Pz8/Pz8/Py8vL19fXk5ORwbnHy
 9fOWmekECfABA/oCA/hAQOjn7O5pZWbt8e7z8/Pz8/Pz8/Pz8/Pz8/Px8fGDg4PR0c20ufQjIfIC
 A/URFvCMje3c3t9ubWzz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pr7umknaeYn5PI0dsmJPBbYeGysLKN
 jY3Y2Njy8vLz8/Pz8/Pz8/Pz8/Pz8/Pz8/Py8PXy9Om6triYjppMTPWVnMpzcGzr6+vz8/Px8fHz
 8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Hl5ea7u71ydnBhY+qFhMaDhoX19fXx8fHy8vLz8/Pz8/Pz8/Pz
 8/Pz8/Pz8/Pw8PDa2tq4uLh1dHBbW+6AjcSAfIDy8vL29vby8vLz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
 8/PX19ednZ1ucWdfXOiGhtZ0dG7z8/Py8vLx8fHz8/Pz8/Pz8/Pz8/Pz8/Pz8/Py8vLZ2dmenp5o
 aW7Ey+vV1O5tbm7m5ub09PTz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Px8fHs7OzFxcVtbW309PT6+vpy
 cnLi4uLy8vLy8vLz8/Pz8/Pz8/Pz8/Pz8/Pz8/Px8fHn5+fGxsZ5eXnu7u77+/t2dnbi4uLy8vLx
 8fHz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pi4uKhoaFxcXHk5OT8/Px6enrh4eHz8/Pz8/Pz8/Pz8/Pz
 8/Pz8/Pz8/Pz8/Pz8/PZ2dmdnZ17e3vX19f8/PyFhYXR0dHx8fH09PTz8/Pz8/Pz8/Pz8/Pz8/Pz
 8/Px8fHz8/Pz8/O5ubmVlZXg4OCAgIDb29vz8/Py8vLz8/Pz8/Pz8/Pz8/Pz8/Pz8/Px8fHz8/Pz
 8/Pt7e21tbWhoaHIyMjy8vLw8PDz8/Pz8/Pz8/Pz8/MAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA}
 regsub -all {\s} $icodata {} icodata            ;# Bug in base64 package
 if {[catch {set fout [open fahrenheit.ico w]}]} return
 puts $fout [::base64::decode $icodata]
 close $fout

Category Application

Category Internet