# # 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 returnHere 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 $foutCategory Application | Category Internet