NOAA Weather Forecast
GWL 2017-12-20 : The code is not working because NOAA has moved the service and changed the WSDL. This would be a nice app to show case using TclWS and I or someone else may update it to use it.
KPV 2017-12-21 : Fixed: I updated this almost a year ago but forgot to upload the new version.
Keith Vetter 2007-01-23 : The National Oceanic and Atmospheric Administration (NOAA) has a some nice web services providing current weather conditions and forecasts. For details on some of those services, check out [L1 ] and [L2 ].
Here's a little program that gets the weather forecast for a given latitude and longitude. It parses the SOAP reply and displays the result.
KPV 2007-02-03 : Added some more features including graphing predicted temperatures (using tklib's PlotChart), a few built-in cities and more robust XML handling.
KPV 2011-09-29 : Updated NOAA's url
PDH 2007-02-15 Corrected tempeture to temperature on line 44, and (pedantically) Januayr to January on line 4. This is an impressive app that really needs a screenshot to show it off. That said, I don't understand why the forecast days scroll horizontally instead of vertically, but that's easily corrected. Replace lines 359-362 with these:
if {[incr row] > 1} {
incr col
set row 0
}
This is the app I would have written had I the proper mojo.
KPV 2009-08-27 -- vertical is better but you then have to figure out the correct row to start in because day 1 may have only one entry.
S_M 2007-07-04 I also like and use this application, at first I did not understand the temperature ranges for the day and night. Replacing the line 350 (set txt "$WEATHER($key3,$id2,temp,minimum)\xB0 -...) with:
if {[regexp -nocase "night" $WEATHER($key,$id,name)]} {
set txt "Low $WEATHER($key3,$id2,temp,minimum)\xB0"
} else {
set txt "High $WEATHER($key2,$id2,temp,maximum)\xB0"
}will make it more similar to the forecast on the NOAA page.
spacecowboy - 2009-08-21 00:20:47
I have messed with this ndfdXML.htm file for HOURS... I finally had to drop a copy of nusoap.php in the same folder as the aforementioned file and the ndfdXMLclient.php file... the error "Parse error: syntax error, unexpected T_REQUIRE_ONCE in C:\Inetpub\vhosts\worldnewsvine.com\httpdocs\nws\ndfdSOAPclientByDay.php on line 55" finally disappeared by simply changing the runonce statement to 'nusoap.php'
Now I am back to another error I was getting which is:
Warning: Cannot modify header information - headers already sent by (output started at C:\Inetpub\vhosts\worldnewsvine.com\httpdocs\nws\ndfdXMLclient.php:1) in C:\Inetpub\vhosts\worldnewsvine.com\httpdocs\nws\ndfdXMLclient.php on line 111
(which is this line of code: header("Content-Type: text/xml");... what is it supposed to be? // Send the appropriate mime type for XML isn't text/xml correct?And to finish that all off, the error continues with:
ERROR HTTP Error: Unsupported HTTP response status 404 Not Found (soapclient->response has contents of the response)
Okay.. I am not professing to be a programmer but one would think that this would be easier to figure-out than this...
Right now I am just using simplepie to fetch the rss feed however, I would love to get this mapping function/application running...
Please any help, in plain ole english.... thanks
KPV 2009-08-27 - huh? what are ndfdXML.htm, nusoap.php and ndfdXMLclient.php? Are you really running this app or some other php one?
KPV 2009-08-27 - while trying to figure out the above error, I decided to replace everything with the more current code on my machine. Some of the changes include caching icon images (turned off for demoing); noon markers on temperature graph; the two suggestions from above; etc.
##+##########################################################################
#
# noaa.tcl -- Displays weather forecast from NOAA
# by Keith Vetter, January 2007
# 2017-02-22: https protocol
#
package require Tk
package require http
package require tdom
package require Img
package require Plotchart
package require tile
namespace import -force ::ttk::button
package require tooltip
package require tls
http::register https 443 [list ::tls::socket -tls1 1] ;# "-tls1 1" is required since [POODLE]
set S(noCache) 0
set S(mustFetch) 1
set S(iconDir) ~/bin/noaaIcons
set S(x,axisStep) 24
set S(box,size) 3
# see http://www.nws.noaa.gov/xml/
# http://www.weather.gov/forecasts/xml/SOAP_server/ndfdSOAPByDay.htm
set S(url,forecast) https://graphical.weather.gov/xml/SOAP_server/ndfdSOAPclientByDay.php
set S(url,temp) https://graphical.weather.gov/xml/SOAP_server/ndfdXMLclient.php
set S(url,temp,parameters) {?lat=${LAT}&lon=${LON}&product=time-series&begin=${BEGINDATE}T00%3A00%3A00&end=${ENDDATE}T00%3A00%3A00&temp=temp&Submit=Submit}
# Both forecast and current conditions
# http://forecast.weather.gov/MapClick.php?lat=37.4411&lon=-122.1203&unit=0&lg=english&FcstType=dwml
set S(format) 12+hourly
set S(days) 8
set COLORS {lightblue violet} ;# Temperature day's columns
set COLORS {\#82eeee \#ee82ee \#eeee82 \#8282ee \#82ee82 \#ee8282}
set COLORS {lightblue}
array set CITIES {
"Boston, MA" "42.35 -71.066666"
"Boulder, CO" "40.27 -105.252"
"Chicago, IL" "41.8675 -87.6243"
"Denver, CO" "39.75 -104.98"
"Granville, OH" "40.068088 -82.517967"
"Honolulu, HI" "21.31 -157.83"
"Leland, MI" "45.024361 -85.762431"
"Los Angeles, CA" "34.054 -118.245"
"Mt View, CA" "37.392778 -122.041944"
"New York, NY" "40.7563 -73.9865"
"Palmer, AK" "61.6019 -149.1172"
"Providence, RI" "41.82355 -71.422132"
"San Francisco, CA" "37.77 -122.43"
"Washington, DC" "38.9136 -77.0132"
"Woods Hole, MA" "41.52645 -70.6545"
}
proc Submit {who} {
set ll [PrettyLat $::S(lat) $::S(lon)]
if {$who eq "temperature"} {
set ::S(msg) "Fetching NOAA temperature forecast"
set n [GetNOAATemp $::S(lat) $::S(lon)]
if {$n} {
set ::S(msg) "NOAA temperature forecast for $ll"
GetPlotData
PlotTemp
} else { set ::S(msg) "error fetching NOAA temperature forecast" }
} else {
set ::S(msg) "Fetching NOAA weather forecast"
set n [GetNOAA $::S(lat) $::S(lon)]
if {$n} {
set ::S(msg) "NOAA weather forecast for $ll"
DisplayWeather
} else { set ::S(msg) "error fetching NOAA weather forecast" }
}
}
proc GetNOAA {lat lon {XML ""}} {
global doc root xml
if {$XML ne ""} {
set xml $XML
} else {
set xml [GetForecastXML $lat $lon]
}
set n [catch {dom parse $xml doc}]
if {$n} {
tk_messageBox -icon error -message "Bad reply from NOAA"
return 0
}
set root [$doc documentElement]
ReadTimeLayouts $root
GetIcons $root
GetTemperatures $root
GetPrecipitation $root
GetWeather $root
unset doc
return 1
}
proc GetForecastXML {lat lon} {
set startdate [clock format [clock scan now] -format "%Y-%m-%d"]
set url $::S(url,forecast)
append url "?lat=$lat&lon=$lon&format=$::S(format)&startDate=$startdate"
append url "&numDays=$::S(days)&Submit=Submit"
set ::URL $url
set token [::http::geturl $url]
set ncode [::http::ncode $token]
set xml [::http::data $token] ; list
::http::cleanup $token
return $xml
}
proc GetNOAATemp {lat lon {XML ""}} {
global doc root xml
if {$XML ne ""} {
set xml $XML
} else {
set xml [GetTempForecastXML $lat $lon]
}
set n [catch {dom parse $xml doc}]
if {$n} {
tk_messageBox -icon error -message "Bad reply from NOAA"
return 0
}
set root [$doc documentElement]
ReadTimeLayouts $root
GetTemperatures $root
unset doc
return 1
}
proc GetTempForecastXML {lat lon} {
global S url
if {! [string is double $lat] || ! [string is double $lon]} {
error "Bad latitude or longitude ($lat,$lon)"
return
}
set LAT $lat
set LON $lon
set BEGINDATE [clock format [clock scan now] -format "%Y-%m-%d"]
set ENDDATE [clock format [clock scan "now + $S(days) days"] \
-format "%Y-%m-%d"]
set params [subst -nobackslashes -nocommands $S(url,temp,parameters)]
set url "$S(url,temp)$params"
set token [::http::geturl $url]
::http::wait $token
set xml [::http::data $token] ; list
::http::cleanup $token
return $xml
}
proc ReadTimeLayouts {root} {
global WEATHER
unset -nocomplain WEATHER
# <time-layout summarization='12hourly'>
# <layout-key>KEY</layout-key>
# <start-valid-time period-name='NAME'>...</start-valid-time>
# <end-valid-time>...</end-valid-time>
# <start-valid-time>...</start-valid-time>
# <end-valid-time>...</end-valid-time>
set nodes [$root selectNodes /dwml/data/time-layout]
foreach node $nodes {
set key [[$node selectNodes layout-key/text()] data]
set WEATHER($key,summary) [$node getAttribute summarization "???"]
set starts [$node selectNodes start-valid-time]
set ends [$node selectNodes end-valid-time]
set cnt -1
foreach start $starts end $ends {
incr cnt
set name ""
set etime ""
if {[$start hasAttribute period-name]} {
set name [$start getAttribute period-name "???"]
}
set stime [[$start firstChild] data]
if {$end ne ""} {
set etime [[$end firstChild] data]
}
set WEATHER($key,$cnt,name) $name
set WEATHER($key,$cnt,start) $stime
set WEATHER($key,$cnt,end) $etime
}
}
}
proc GetIcons {root} {
set node [$root selectNodes /dwml/data/parameters/conditions-icon]
set key [$node getAttribute time-layout]
set ::WEATHER(icon,key) $key
set nodes [$node selectNodes icon-link]
for {set cnt 0} {$cnt < [llength $nodes]} {incr cnt} {
set url ""
set inode [lindex $nodes $cnt]
if {[$inode hasChildNodes]} {
set url [[$inode firstChild] data]
}
set ::WEATHER($key,$cnt,icon) $url
}
}
proc GetTemperatures {root} {
global WEATHER
array unset WEATHER *temp*
set nodes [$root selectNodes /dwml/data/parameters/temperature]
foreach node $nodes {
set type [$node getAttribute type]
set units [$node getAttribute units]
set key [$node getAttribute time-layout]
set WEATHER(temp,$type,key) $key
set WEATHER(temp,$type,units) $units
set vnodes [$node selectNodes value]
for {set cnt 0} {$cnt < [llength $vnodes]} {incr cnt} {
set vnode [lindex $vnodes $cnt]
set temp "?"
if {[$vnode hasChildNodes]} {
set temp [[$vnode firstChild] data]
}
set WEATHER($key,$cnt,temp,$type) $temp
}
}
}
proc GetPrecipitation {root} {
global WEATHER
array unset WEATHER *rain*
set node [$root selectNodes \
/dwml/data/parameters/probability-of-precipitation]
set units [$node getAttribute units]
set key [$node getAttribute time-layout]
set WEATHER(rain,key) $key
set WEATHER(rain,units) $units
set vnodes [$node selectNodes value]
for {set cnt 0} {$cnt < [llength $vnodes]} {incr cnt} {
set vnode [lindex $vnodes $cnt]
set rain "?"
if {[$vnode hasChildNodes]} {
set rain [[$vnode firstChild] data]
}
set WEATHER($key,$cnt,rain) $rain
}
}
proc GetWeather {root} {
global WEATHER
array unset WEATHER *weather*
set node [$root selectNodes /dwml/data/parameters/weather]
set key [$node getAttribute time-layout]
set WEATHER(weather,key) $key
set cnt -1
foreach value [$node selectNodes weather-conditions] {
incr cnt
set WEATHER($key,$cnt,weather,summary) \
[$value getAttribute weather-summary "?"]
}
}
proc DoDisplay {} {
wm title . "NOAA Weather Forecast"
bind all <F2> {console show}
frame .w -bd 2 -relief ridge
frame .ctrl -bd 2 -relief ridge -pady 5 -padx 30
label .msg -bd 2 -relief ridge -padx 30 -textvariable S(msg)
pack .msg -side bottom -fill x
pack .ctrl -side bottom -fill x
pack .w -side top -fill both -expand 1
set cities [lsort [array names ::CITIES]]
::ttk::combobox .ctrl.cb -values $cities -state readonly \
-textvariable ::S(city) -validatecommand {SetCity %P} -validate all
label .ctrl.llat -text "Latitude" -anchor w
entry .ctrl.elat -textvariable ::S(lat) -width 12 \
-validate key -vcmd {string is double %P}
label .ctrl.llon -text "Longitude" -anchor w
entry .ctrl.elon -textvariable ::S(lon) -width 12 \
-validate key -vcmd {string is double %P}
label .ctrl.ldays -text "Days" -anchor w
spinbox .ctrl.sbox -from 1 -to 10 -textvariable ::S(days) -width 7 \
-justify c -state readonly
.ctrl.sbox config -readonlybackground [.ctrl.sbox cget -bg]
frame .buttons
button .forecast -text "Forecast" -command {Submit forecast}
button .temp -text "Temperatures" -command {Submit temperature}
grid x .ctrl.cb - x .buttons -pady {0 5} -sticky news
grid x .ctrl.llat .ctrl.elat x ^ -sticky ew
grid x .ctrl.llon .ctrl.elon x ^ -sticky ew
grid x .ctrl.ldays .ctrl.sbox x ^ -sticky ew -pady {5 0}
grid columnconfigure .ctrl 3 -minsize 30
grid columnconfigure .ctrl 0 -weight 1
grid columnconfigure .ctrl 100 -weight 1
grid .forecast -in .buttons -sticky ew
grid .temp -in .buttons -sticky ew
grid rowconfigure .buttons {0 1} -weight 1
eval destroy [winfo child .w]
label .w.icon -image ::img::noaa
label .w.title1 -text "NOAA" -font {Times 32 bold}
label .w.title2 -text "Weather Forecast" -font {Times 28 bold}
#grid .w.icon .w.title1
#grid .w.title2 - -sticky ew -padx 10
#grid config .w.icon -padx {30 0}
#grid columnconfigure .w 1 -weight 1
pack .w.title2 -side bottom -padx 10
pack .w.icon -side left -padx {30 0}
pack .w.title1 -side left -expand 1
}
proc SetCity {where} {
global CITIES S
foreach {S(lat) S(lon)} $CITIES($where) break
return 1
}
image create photo ::img::noaa -data {
R0lGODlhNwA6ALMAACQybBSKtIzW9Eyy1DRGfHSCrJzy/ASe1FRilPwCBIyexPT+/Jy63CSaxMTa
9CxKlCH5BAEAAAkALAAAAAA3ADoAAwT/MMlJq7046827/2AojmRpnmiqrmzrvqXDMEpdKIwDazJC
/IBg8IfI7SgOxSP4IDyeUCAAodDtlAAndMtdAh6MlwPR7Jq3vwfCqmL4tOd4k1BsI75mePQ8DZ/G
eFAIZFmDRG9qZVBZbCRugXQODgtFC5QKlgUFCzKBAAVGJZYLBV9OCJQMBWMzqjg0VU5OOaOilkk/
kQQ0rFWTM5wOc5ijCyTFmUQLDw6rRTiv0A4EU8gyI8iZU6ygkqCaMwVrPwzIAw2NHdm3dz5kdO2n
dHSf1g0BAiHA2dPU/llPZD3JsquYgHMBBoAw0KBSNgWm5ATcVGxAgAMHGhj4wDBAQgPZ/+5IXEJg
kiUD5xqo1MixAcYGDEAWeyQnCDFLKV+y9GDg4gGPMZEx8Ndl3pqTCDFm3Nmhp8ufDQZkGwqQCzVi
KAM81bmRp1alGQXIHDWG6Jx6Cw76BKuya9OtSj9aU/BGCEUGHsEqbQtCpd6lAvipohJTwD2/f/l+
OPzXI8yx6wxIFvD3pcIQXysffuUAsoGDAypjDOCnL1y9HgNQMWmAQcrTbBuMsCga4wCxJw8ehg02
4QjDtQ+InZw0+N7SIWgHv5fZ+OjLJBCL5r0cpgngzrO/RB6duvbYKpR/r+x7hfjxe6GvWOlds1b1
LNSuNe7x9pHWFpvrZW79yITPr/G3kh19/l0g2WcCJChZgQw26OCDEEYo4YQUVmjhhSxEAAA7}
image create photo ::img::noaaLogo -data {
/9j/4AAQSkZJRgABAQAAAQABAAD/2wCEAAkGBwgHBgkIBwgKCgkLDRYPDQwMDRsUFRAWIB0iIiAd
Hx8kKDQsJCYxJx8fLT0tMTU3Ojo6LCs/RD84Qyk5OjgBCgoKDg0OGxAQGjQmICY0Ly84MDc3NzY0
Ly8vLDcsLDcxLzA0LzUsLDQsNCw0NDc0LDQ0LCwsLC80NCw3NCwvNP/AABEIADIAMgMBEQACEQED
EQH/xAAbAAACAwEBAQAAAAAAAAAAAAAGBwAEBQMIAf/EADIQAAIBAwIEBAUCBwEAAAAAAAECAwAE
BQYREiExQQcTYXEiUYGhwWKRMkNTgpKx4RT/xAAaAQACAwEBAAAAAAAAAAAAAAAABQIDBAEG/8QA
KhEAAgICAQIFAwUBAAAAAAAAAQIAAwQRIRIxBRNBUfBxgdEyQmGRoSL/2gAMAwEAAhEDEQA/AHjR
CAmtPEmxwEr2OPjW9v15OOLaOI/Jj3PoP3FaqcYvyeBMt2UqcDkxZ5DxD1TfOWOTa3XsluioB9ev
3rYuNWPSYWyrD6zha681TauHTM3D7dpQrg/uK6ces+k4MmwesPdKeLEdxKlrqOFLdm5C7i34N/1L
29+ntWW3EI5Sa6swHh40EZXQOjBlYbgg7gisU3T7RCVMrbXF5jri2tLtrOaVCq3CrxGPfuBUlIB2
RIsCRoGeeM3pe+wGet7DKJxJPKoSZCeGVSwBIPz58x1FNktDrtYoelkfTQqfSmH/APWpgxs8imYw
GATudgLvyTJuOf8ADz+QNUea+uT81uaRShbt83qc4tJ4R47ZOElwYmlPnPuyvHM3xctgN4xtw89t
675r8/PaQFKaHz3mDdaZN9qq3xODUFbi3hmBLMUQNGrM25G/CN+436DrVot6ULNKjT1WdK/OI8tM
YdNOYa2xhvZbngJCvMQOfXhUdhyOw50ssfrYtqNK1FahdzYquWQB1BrK7wurntyBLYIiCSLYbjcb
llPz59KY04i2U79YmyfEGpyen9vE3tQ4mw1npwxRyowkXzLW4X+W/Y/gj3rIjNS/MZMEvr2DPPeR
tr/E5CazvfNhuYWKuvEfse4PXfvTVSrDYilgyHRlQSSDpI49mNS1I7MbXhDYJisTfakyr+VFKoih
eT+mvUj3OwA9Kw5JLsK1m/G1Whsc6Eq3+rLjK6qsLtOKO1t7hRDFv2J2JPqRWtMUJUV9SIqszmty
FYdgY36Sz0sT/iZbtDqh5CPhnhR1PsOE/wCqdYLbq17TzHiqav37gfiZ2nNS3+n5ibZhJbsd5Ldz
8Leo+R9atux0tHPf3lGLmWY547e0JczdaV11FFHeC5ssmBwxSJCXcfp+EHiX32+lYRRdRyORHAzM
fIAB2D9PxM1PDPEYVxdaiziPADukATyvM9DzLfQc6BkPZwiybUV1f9WNM3U+WfITxwRXccljAoWC
GCFoo4wOQAU+netuPUEG9cxNmZBtbXVsfxwJTwNs13m7C3Qbl7hP233P23qy1umsn+JTjIXtUD3E
flednsoKeIWAfM4tZ7VOK7td2VR1dT1X35bj/tbMO/y30exi7xHFN1e17iJ+nU8vNKwzuTx0DQWN
0YEbqUReL/Lbf71W9KOdsNzRXlW1jSHUo3E81zKZbmWSWRuryMWJ+pqYUKNCUs7MdsdznXZGMTww
0+4kOaukKrsUtgR136t+B9aW59415Y+8e+FYpB85vtGPSuPJKIQP1ToW1y8j3dg62t23Nht8Eh+Z
HY+orbRmNWOluRFmX4alx6k4P+GAd5o3P2jlWx7yjs0JDg/n7UxXLqb1iZ/D8hD+nf0nK30nn53C
pi7hd+8gCD7105NQ/dIrg5DdkML9O+HSxSLcZyRZNuYtoz8P9x7+wrFdn74r/uNMbwkKeq0/aMFF
VFCIoVVGwAGwApb3jkDXAn2idkohJRCSiElEJKISUQkohP/Z}
proc DisplayWeather {} {
global WEATHER
wm geom . {} ;# Reset main window geometry
wm iconphoto . -default ::img::noaaLogo
set W .w
label $W.tmp
set font "[font actual [$W.tmp cget -font]] -weight bold"
eval destroy [winfo child $W]
pack [frame $W.f] -side left -fill both -expand 1
set W $W.f
set keyWeather $WEATHER(weather,key)
set keyMaxTemp $WEATHER(temp,maximum,key)
set keyMinTemp $WEATHER(temp,minimum,key)
set keyRain $WEATHER(rain,key)
set keyIcon $WEATHER(icon,key)
set row 0
set col 0
foreach arr [lsort -dictionary \
[array names WEATHER $keyWeather,*,weather,summary]] {
set id [lindex [split $arr ","] 1]
set id2 [expr {$id/2}]
set WF $W.col$id
frame $WF -bd 2 -relief ridge
label $WF.name -text $WEATHER($keyWeather,$id,name) -font $font
label $WF.icon -image [DownloadIcon $WEATHER($keyIcon,$id,icon)] \
-relief ridge
if {[regexp -nocase "night" $WEATHER($keyWeather,$id,name)]} {
set txt "Low $WEATHER($keyMinTemp,$id2,temp,minimum)\xB0"
if {$row == 0 && $col == 0} { incr row}
} else {
set txt "High $WEATHER($keyMaxTemp,$id2,temp,maximum)\xB0"
}
append txt "\n$WEATHER($keyRain,$id,rain)%"
append txt "\n$WEATHER($keyWeather,$id,weather,summary)"
label $WF.txt -text $txt -wraplength 100
grid $WF -row $row -column $col -sticky news
grid columnconfigure $W $col -uniform a
eval pack [winfo child $WF] -side top
#update
if {[incr row] > 1} {
incr col
set row 0
}
}
}
proc DownloadIcon {url} {
if {$url eq ""} {return ::img::noaa}
set cacheName [file join $::S(iconDir) [file tail $url]]
set sname [file rootname [file tail $url]]
set iname ::img::$sname
if {[lsearch [image names] $iname] == -1} {
image create photo $iname -width 55 -height 58
if {! $::S(mustFetch) && [file exists $cacheName]} {
$iname config -file $cacheName
} else {
$iname copy ::img::noaa
set start [clock milliseconds]
lappend ::ALL [list $url $iname $cacheName]
after idle [list ::http::geturl $url \
-command [list DownloadIcon_Callback $iname $cacheName]]
lappend ::TIMES [expr {[clock milliseconds] - $start}]
}
}
return $iname
}
proc DownloadIcon_Callback {iname cacheName token} {
set ncode [::http::ncode $token]
if {[::http::ncode $token] != 200} {
error "bad http ncode for $iname"
} else {
set data [::http::data $token] ; list
$iname config -data [::http::data $token]
if {! $::S(noCache)} {
catch {
set fout [open $cacheName wb]
puts -nonewline $fout $data
close $fout
}
}
}
::http::cleanup $token
}
proc ScanTime {when} {
#2007-01-25T19:00:00-05:00
set ticks [clock scan "[string range $when 0 9] [string range $when 11 18]"]
return $ticks
}
proc PrettyLat {lat lon} {
set lat [int2lat $lat]
set lon [int2lat $lon]
foreach {lat1 lat2 lat3} $lat break
foreach {lon1 lon2 lon3} $lon break
set lat "$lat1\xB0 $lat2' $lat3\x22N"
set lon "$lon1\xB0 $lon2' $lon3\x22W"
return "$lat $lon"
}
proc GetTempTime {hourOffset} {
set seconds [expr {$::PLOT(basetime) + $hourOffset*60*60}]
return [clock format $seconds -format "%a %l:%M %P"]
}
proc int2lat {int} {
set int [expr {abs($int) * 3600}]
if {[string is integer -strict $int]} {
set sec [expr {$int % 60}]
} else {
#set fra [expr {$int - int($int)}]
#set fra [expr {round($fra * 10) / 10.0}]
#set int [expr {int($int)}]
#set sec [expr {$int % 60 + $fra}]
set v [expr {$int + .05}] ;# Round to 1 decimal place
foreach {int fra} [split $v "."] break ;# Use string representation
set fra [string range $fra 0 0] ;# 1 decimal place only
set sec [expr {$int % 60}]
if {$fra ne {0}} { append sec ".$fra"}
}
set int [expr {$int / 60}]
set min [expr {$int % 60}]
set deg [expr {$int / 60}]
return [list $deg $min $sec]
}
proc PlotTemp {} {
global PLOT s
wm geom . {} ;# Reset main window geometry
set W .w.c
set PLOT(W) $W
if {[winfo exists $W]} {
$W config -width [winfo width $W] -height [winfo height $W]
$W delete all
bind $W <Configure> {}
} else {
eval destroy [winfo child .w]
canvas $W -width 700
pack $W -fill both -expand 1
}
# Bug in plotchart
::Plotchart::clearcanvas $W
array unset ::Plotchart::scaling *$W*
array unset ::Plotchart::data_series *$W*
array unset ::Plotchart::config *$W*
set s [::Plotchart::createXYPlot $W $PLOT(XS) $PLOT(YS)]
foreach x $PLOT(X) y $PLOT(Y) {
$s plot series1 $x $y
set xy [::Plotchart::coordsToPixel $W $x $y]
set xy [Box $xy $::S(box,size)]
set id [$W create oval $xy -tag oval -fill red -outline red]
set when [GetTempTime $x]
::tooltip::tooltip $W -items $id "$y\xB0\n$when"
}
$s grid $PLOT(Xgrid) $PLOT(Ygrid)
$s title "Temperature Forecast"
$s ytext $PLOT(YText)
XAxis
Freezing
Noons
Colorize
$W raise oval
update
if {[bind $W <Configure>] eq ""} { bind $W <Configure> PlotTemp }
}
proc XAxis {} {
global PLOT
set W $PLOT(W)
$W delete xaxis
set Xticks [lindex $PLOT(Xgrid) 0]
set Ymin [lindex $PLOT(YS) 0]
for {set i 0} {$i < [llength $Xticks]} {incr i} {
set x [lindex $Xticks $i] ;# Hours from starting
set day [expr {$x / 24.}]
if {int($day) != $day} continue
set ticks [expr {$PLOT(basetime) + int($day)*60*60*24}]
set day [clock format $ticks -format "%a"]
set xy [::Plotchart::coordsToPixel $W $x $Ymin]
$W create text $xy -tag xaxis -anchor n -text $day
}
}
proc Freezing {} {
global PLOT
set W $PLOT(W)
foreach {xmin xmax} $PLOT(XS) break
foreach {ymin ymax} $PLOT(YS) break
foreach val {32 0} {
if {$ymin < $val && $ymax > $val} {
set xy0 [::Plotchart::coordsToPixel $W $xmin $val]
set xy1 [::Plotchart::coordsToPixel $W $xmax $val]
$W create line [concat $xy0 $xy1] -fill red -dash 1 -width 2
}
}
}
proc Noons {} {
global PLOT COLORS
set W $PLOT(W)
set xticks [lindex $PLOT(Xgrid) 0]
foreach {ymin ymax} $PLOT(YS) break
set x1 [lindex $xticks 0]
for {set i 1} {$i < [llength $xticks]} {incr i} {
set x0 $x1
set x1 [lindex $xticks $i]
set x [expr {($x0 + $x1)/2}]
set xy0 [::Plotchart::coordsToPixel $W $x $ymin]
set xy1 [::Plotchart::coordsToPixel $W $x $ymax]
$W create line [concat $xy0 $xy1] -fill black -dash 1 -width 1
}
}
proc Colorize {} {
global PLOT COLORS
set W $PLOT(W)
set xticks [lindex $PLOT(Xgrid) 0]
foreach {ymin ymax} $PLOT(YS) break
set x1 [lindex $xticks 0]
for {set i 1} {$i < [llength $xticks]} {incr i} {
set x0 $x1
set clr [lindex $COLORS [expr {$i % [llength $COLORS]}]]
set x1 [lindex $xticks $i]
set xy0 [::Plotchart::coordsToPixel $W $x0 $ymin]
set xy1 [::Plotchart::coordsToPixel $W $x1 $ymax]
$W create rect [concat $xy0 $xy1] -fill $clr -tag bg
}
$W lower bg
}
proc lat2int {lat1 lat2 lat3} {
scan "$lat1 $lat2 $lat3" "%g %g %g" lat1 lat2 lat3
set lat [expr {abs($lat1) + $lat2 / 60.0 + $lat3 / 3600.0}]
return $lat
}
proc GetPlotData {} {
global PLOT WEATHER
unset -nocomplain PLOT
set key $WEATHER(temp,hourly,key)
set basetime 0
set X {}
set Y {}
foreach arr [lsort -dictionary [array names WEATHER $key,*,temp,hourly]] {
set idx [lindex [split $arr ","] 1]
set ticks [ScanTime $WEATHER($key,$idx,start)]
if {$idx == 0} {
# Get start of the day for first time range
set basetime [ScanTime [string range $WEATHER($key,$idx,start) 0 9]]
}
lappend X [expr {($ticks - $basetime)/60/60}] ;# Hours from basetime
lappend Y $WEATHER($key,$idx,temp,hourly)
}
;# Compute Y axis
set y_sort [lsort -real $Y]
set ys [::Plotchart::determineScale [lindex $y_sort 0] [lindex $y_sort end]]
set ys [MakeInt $ys]
set min 0
set max [lindex $X end]
set delta [expr {$max - $min}]
if {$delta/24 != $delta/24.0} { set max [expr {$min + 24*(1+$delta/24)}]}
set xs [list $min $max 24]
set xs [list $min $max $::S(x,axisStep)]
set Xticks {}
foreach {a b c} $xs break
while {$a <= $b} {
lappend Xticks $a
incr a $c
}
set Yticks {}
foreach {a b c} $ys break
while {$a <= $b} {
lappend Yticks $a
incr a $c
}
set Xgrid {}
foreach . $Yticks { lappend Xgrid $Xticks }
set Ygrid {}
set cnt [llength $Xticks]
foreach tick $Yticks { lappend Ygrid [string repeat "$tick " $cnt] }
set PLOT(X) $X
set PLOT(Y) $Y
set PLOT(XS) $xs
set PLOT(YS) $ys
set PLOT(Xgrid) $Xgrid
set PLOT(Ygrid) $Ygrid
set PLOT(YText) $WEATHER(temp,hourly,units)
set PLOT(basetime) $basetime
}
proc Box {xy r} {
foreach {x y} $xy break
return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
}
proc MakeInt {nlist} {
set ilist {}
foreach num $nlist { lappend ilist [expr {int($num)}]}
return $ilist
}
if {! $S(noCache)} {catch {file mkdir $S(iconDir)}}
DoDisplay
set S(city) "Woods Hole, MA"
set S(city) "Granville, OH"
set S(city) "Mt View, CA"
SetCity $S(city)
if {! $tcl_interactive} {
Submit forecast
}
return