[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
[http://weather.noaa.gov/weather/metar.shtml].

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]