Updated 2017-12-21 23:24:47 by kpv ▲

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 [1] and [2].

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

Category ApplicationCategory Science