#!/usr/bin/wish

# $Id: tclweather.tcl,v 1.39 2002/10/31 15:58:11 tang Exp $
# This is TclWeather by Jason Tang (tang@jtang.org).  See README for
# more details.  Also visit http://mini.net/tcl/tclweather

if {![info exists env(TCLWEATHER_LIB)]} {
    set env(TCLWEATHER_LIB) [file join [pwd] lib]
}
lappend auto_path $env(TCLWEATHER_LIB)

#source "clrdial.tcl"
#source "tkNotebook.tcl"
#source "ticker.tcl"
#source "tree.tcl"

#source "base64.tcl"
#source "configuration.tcl"
#source "conversions.tcl"
#source "tclweather_scanner.tcl"

package require http 2.0

set TCLWEATHER_VERSION "1.11"

;#######################################################################
;# routines for downloading and formatting observation data

proc download_observation {} {
    global tw
    
    if {$tw(use_proxy)} {
        http::config -proxyhost $tw(proxy_host) -proxyport $tw(proxy_port)
        if {![string equal $tw(proxy_name) ""]} {
            set passphrase "$tw(proxy_name):$tw(proxy_password)"
            set authorization [list "Proxy-authorization" \
                    "basic [base64_encode $passphrase]"]
        }
    } else {
        set authorization [list "" ""]
    }
    if {[catch {set token [http::geturl \
            http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=$tw(location_code) \
            -headers $authorization]}] != 0 ||\
            [http::ncode $token] != 200} {
        ;# error downloading
        catch {http::cleanup $token}
        return [list "" ""]
    }
    ;# scan through for both the date and observation data
    set date ""
    set observation ""
    set in_date 0
    set in_observation 0
    puts [http::data $token]
    foreach line [split [http::data $token] "\n"] {
        if {$in_date == 1} {
            if {[string equal $line ""] || [regexp {\/FONT} $line]} {
                set in_date 2
            } else {
                append date $line
            }
        } elseif {$in_observation} {
            if {[string equal $line ""] || [regexp {\/font} $line]} {
                set in_observation 2
            } else {
                append observation $line
            }
        } elseif {[regexp {FONT COLOR} $line]} {
            set in_date 1
        } elseif {[regexp {font face} $line] && $in_date == 2 && 
            $in_observation == 0} {
                set in_observation 1
            }
    }
    http::cleanup $token
    return [list $date $observation]
}

proc format_weather_data {{new_data_varname ""} {old_data_varname ""}} {
    global tw
    if {![string equal $new_data_varname ""]} {
        upvar $new_data_varname data
    } else {
        upvar #0 latest_data data
    }
    if {![string equal $old_data_varname ""]} {
        upvar $old_data_varname prev
    } else {
        upvar #0 prev_data prev
    }
    Ticker:clear_repeat_data $tw(p).t
    foreach report $tw(report_order) {
        switch -- $report {
            "cloud" {
                if {[info exists data(cloud,type)]} {
                    Ticker:add_repeat_datum $tw(p).t \
                            [calc_change $data(cloud,type) \
                              $data(cloud,amt) prev(cloud,amt) ] \
                            "cloud"
                }
            }
            "cond" {
                if {[info exists data(cond)]} {
                    foreach cond $data(cond) {
                        if {[string length $cond] > 0} {
                            Ticker:add_repeat_datum $tw(p).t $cond "cond"
                        }
                    }
                }
            }
            "dew" {
                if {[info exists data(temp,dew)]} {
                    Ticker:add_repeat_datum $tw(p).t \
                            [calc_change [format_unit "Dew point at" \
                                  $data(temp,dew) " c" tempc_to_tempf " f" 0] \
                              $data(temp,dew) prev(temp,dew)] \
                            "dew"
                }
            }
            "pres" {
                if {[info exists data(pres)]} {
                    Ticker:add_repeat_datum $tw(p).t \
                            [calc_change [format_unit "Air pressure at" \
                                  $data(pres) " mm" mm_to_inch " in" 2] \
                              $data(pres) prev(pres)] \
                            "pres"
                }
            }
            "relhum" {
                if {[info exists data(temp,relhum)]} {
                    Ticker:add_repeat_datum $tw(p).t \
                            [calc_change [format_unit "Relative humidity at" \
                                  $data(temp,relhum) "%" "" "" 0] \
                              $data(temp,relhum) prev(temp,relhum)] \
                            "relhum"
                }
            }
            "temp" {
                if {[info exists data(temp,air)]} {
                    Ticker:add_repeat_datum $tw(p).t \
                            [calc_change [format_unit "Temperature is" \
                                  $data(temp,air) " c" tempc_to_tempf " f" 0] \
                              $data(temp,air) prev(temp,air)] \
                            "temp"
                }
            }
            "time" {
                if {[info exists data(time,hour)]} {
                    set orig [clock scan $data(time,hour):$data(time,min) \
                            -gmt 1]
                    if {$tw(show_24hr)} {
                        set time [clock format $orig -format "%H:%M" \
                                -gmt [expr ! $tw(localtz)]]
                    } else {
                        set time [clock format $orig -format "%I:%M %p" \
                                -gmt [expr ! $tw(localtz)]]
                        if {[string equal [string index $time 0] "0"]} {
                            set time [string range $time 1 end]
                        }
                    }
                    if {!$tw(localtz)} {
                        append time " UTC"
                    }
                    Ticker:add_repeat_datum $tw(p).t \
                            "$tw(location_code) observation at $time" \
                            "time"
                }
            }
            "vis" {
                if {[info exists data(vis)]} {
                    Ticker:add_repeat_datum $tw(p).t \
                            [calc_change [format_unit "Visibility at" \
                                  $data(vis) " km" km_to_mi " mi" 0] \
                              $data(vis) prev(vis)] \
                            "vis"
                }
            }
            "wind" {
                if {[info exists data(wind,dir)]} {
                    if {$data(wind,speed) == 0} {
                        set text "Calm winds"
                    } else {
                        set text \
                          [calc_change \
                                [format_unit "[wind_dir $data(wind,dir)] at" \
                                $data(wind,speed) " kph" kph_to_mph " mph" 0] \
                            $data(wind,speed) prev(wind,speed)]
                    }
                    if {$data(wind,gust) > 0} {
                        append text \
                          [calc_change \
                                [format_unit ", gusting to" \
                                $data(wind,gust) " kph" kph_to_mph " mph" 0] \
                            $data(wind,gust) prev(wind,gust)]
                    }
                    Ticker:add_repeat_datum $tw(p).t $text "wind"
                }
            }
        }
    }
}

proc format_unit {prefix val unit conv_func alt_unit sig_digits} {
    global tw
    ;# if units is set to imperial, then convert from metric via the
    ;# 'conv_func' (0 == imperial)
    if {$tw(units) == 0 && \
            [llength [info procs $conv_func]] > 0} {
        set val [$conv_func $val]
        set unit $alt_unit
    }
    return [format "%s %0.${sig_digits}f%s" $prefix $val $unit]
}

proc calc_change {text new_val old_val_name} {
    global tw
    upvar $old_val_name old_val
    if {$tw(calc_change) && [info exists old_val]} {
        if {$new_val > $old_val} {
            return "$text (+)"
        } elseif {$new_val < $old_val} {
            return "$text (-)"
        }
    }
    return $text
}

proc update_weather_data {} {
    global tw latest_data prev_data
    if {$tw(notify_download)} {
        Ticker:add_single_datum $tw(p).t "(downloading data)" "server_message"
    }
    foreach {date observation} [download_observation] {}
    if {[string equal $date ""] || [string equal $observation ""]} {
        if {$tw(notify_error)} {
            Ticker:add_single_datum $tw(p).t "(no data from server)" \
                    "server_message"
        }
    } else {
        if {$tw(notify_complete)} {
            Ticker:add_single_datum $tw(p).t "(download complete)" "server_message"
        }
        parse_weather $observation new_data
        if {![string equal [lsort [array get new_data]] \
                           [lsort [array get latest_data]]]} {
            # looks like new data arrived, so erase away the old stuff
            array unset prev_data
            array set prev_data [array get latest_data]
        }
        array unset latest_data
        array set latest_data [array get new_data]
        format_weather_data latest_data prev_data
    }
}

;#######################################################################
;# gui stuff

proc update_weather_ticker_format {} {
    global tw
    foreach {key color} [array get tw *_tag_color] {
        regexp {^[^_]+} $key tag_name
        Ticker:add_font_tag $tw(p).t \
                $tag_name $tw(ticker_font) $tw(ticker_size) $color
    }
    Ticker:add_font_tag $tw(p).t \
            "server_message" $tw(ticker_font) $tw(ticker_size) \
            $tw(server_color) -slant italic
    $tw(p) configure -background $tw(bg_color)
    $tw(p).l configure -background $tw(button_bg_color) \
            -foreground $tw(button_fg_color)
    $tw(p).r configure -background $tw(button_bg_color) \
            -foreground $tw(button_fg_color)
    Ticker:configure $tw(p).t -background $tw(bg_color) \
            -defaultfont $tw(ticker_font) -defaultsize $tw(ticker_size) \
            -foreground $tw(misc_color) -quality $tw(scroll_quality) \
            -direction $tw(scroll_left) -speed $tw(ticker_speed)
    if {$tw(enter_raise) && $tw(toplevel)} {
        bind $tw(p) <Enter> "raise ."
    } else {
        bind $tw(p) <Enter> {}
    }
    if {$tw(leave_lower) && $tw(toplevel)} {
        bind $tw(p) <Leave> "lower ."
    } else {
        bind $tw(p) <Leave> {}
    }
    if {![string equal $tw(browser_type) ""]} {
        bind $tw(p).t <Button-1> {show_weather_info}
    } else {
        bind $tw(p).t <Button-1> {}
    }    
}

proc change_speed {w type x y} {
    global tw ticker_drag_x ticker_original_speed
    if {[string equal $type "start"]} {
        set ticker_drag_x $x
        set ticker_original_speed $tw(ticker_speed)
    } else {
        if {$tw(scroll_left) != 0} {
            set x_delta [expr [expr $x - $ticker_drag_x] / 100.0]
        } else {
            set x_delta [expr [expr $ticker_drag_x - $x] / 100.0]
        }
        if {$x_delta < 0} {
            set x_delta [expr 1.0 / [expr -1.0 * $x_delta + 1.0]]
        } else {
            set x_delta [expr $x_delta + 1.0]
        }
        set tw(ticker_speed) [expr round($ticker_original_speed * $x_delta)]
        if {$tw(ticker_speed) < 10} {
            set tw(ticker_speed) 10
        } elseif {$tw(ticker_speed) > 400} {
            set tw(ticker_speed) 400
        }
        Ticker:configure $w -speed $tw(ticker_speed)
    }
}

proc titlebar_trace {name1 name2 ops} {
    global tw
    wm overrideredirect . [expr 1 - $tw(titlebar)]
}

proc scroll_buttons_trace {name1 name2 ops} {
    global tw
    if {$tw(scroll_buttons)} {
        pack forget $tw(p).t
        pack $tw(p).l -side left -pady 4 -padx 2
        pack $tw(p).r -side right -pady 4 -padx 2
        pack $tw(p).t -expand 1 -expand 1 -fill x -side left -pady 6 -padx 2
    } else {
        pack forget $tw(p).l
        pack forget $tw(p).r
        pack $tw(p).t -expand 1 -expand 1 -fill x -side left -pady 6 -padx 2
    }
}

proc location_code_trace {name1 name2 ops} {
    global tw
    wm title . "TclWeather \($tw(location_code)\)"
}

proc weather_button_down {w amount} {
    global tw
    Ticker:advance $tw(p).t $amount
    after 100 "weather_button_down $w $amount"
}

proc show_weather_info {} {
    global tw
    set url "http://www.wunderground.com/cgi-bin/findweather/getForecast?query=$tw(location_code)"
    switch -- $tw(browser_type) {
        win32 {set cmd \
                [list rundll32 url.dll,FileProtocolHandler $url &]}
        named {set cmd [list $tw(browser) $url &]}
        default {return}
    }
    if {[catch {eval exec -- $cmd}]} {
        tk_messageBox -title "TclWeather" -icon error \
                -parent . -type ok \
                -message "Unable to launch external browser.\nCheck TclWeather browser configuration."
    }
}

;#######################################################################
;# other stuff

proc main_weather_loop {{arg ""}} {
    global tw latest_data
    if {[string equal $arg "restart"]} {
        # on a restart, flush out the latest_data values
        array unset latest_data
        catch {after cancel $tw(next_refresh)}
    }
    after 0 update_weather_data
    set tw(next_refresh) [after [expr $tw(refresh) * 60 * 1000] "main_weather_loop"]
}

proc exit_tclweather {} {
    global tw
    ;# save settings, if needed
    if {$tw(save_on_exit)} {
        if {![tclweather::save_settings $tw(filename) tw]} {
            if {[string equal [tk_messageBox -title "TclWeather" -icon error \
                    -message "Error while saving settings.  Quit anyways?" \
                    -parent $tw(p) -type okcancel] "cancel"]} {
                return
            }
        }
    }
    catch {after cancel $tw(next_refresh)}
    exit 0
}

proc load_location_cache {filename} {
    global locations
    if {[catch {eval open $filename r} src]} {
        return 0
    }
    while {[gets $src line] >= 0} {
        regexp {^(.{4}) (.*)} $line foo code loc
        if {[string equal $code "    "]} {
            set code ""
        }
        set locations($loc) $code
    }
    close $src
    return 1
}

;#######################################################################
;# start of main script

;# To use:
;# call this function to get everything going
;#   param0 -- parent container for everything.  If null, then manages
;#   its own frame.  If not null, YOU will need to specify a frame for
;#   it live in; in addition, YOU are responsible for setting its
;#   geometry (-width and -height) and calling exit_tclstock() upon
;#   exit.  Set env(TCLWEATHER_LIB) to point to the lib directory for
;#   tclstock.  Make sure to call main_weather_loop() to start the
;#   ticker.
;#
;#   param1 -- overrides the default settings filename
proc init_tclweather {{parent ""} {settings_filename ""}} {
    global tw tcl_platform
    tclweather::set_defaults
    if {![string equal $settings_filename ""]} {
        set tw(filename) $settings_filename
    }
    if {[set settings_found [tclweather::load_settings $tw(filename) tw]] == -1} {
        tk_messageBox -title "TclWeather Startup" -icon error \
                -parent . \ -message "Invalid settings file $tw(filename).\nReverting to default values." \
                -type ok
        tclweather::set_defaults
    }

    ;# initialize the graphical stuff
    if {[string equal $parent ""]} {
        frame .f -height 50
        set tw(p) ".f"
        set tw(toplevel) 1
    } else {
        set tw(p) $parent
        set tw(toplevel) 0
    }
    init_tclweather_gui
    init_tclweather_etc $settings_found

    if {$tw(toplevel)} {
        bind . <space> {set tw(titlebar) [expr 1 - $tw(titlebar)]}
        if {[string equal $tcl_platform(platform) "windows"]} {
            bind . <F2> {console show}
        }
        ;# position window, if needed
        if {![string equal $tw(geometry) ""]} {
            wm geometry . $tw(geometry)
        }
        wm deiconify .
        raise .
        ;# handle 'destroy' event on the main window
        wm protocol . WM_DELETE_WINDOW { exit_tclweather }
        update
    }
    
    Ticker:set_height $tw(p).t
    Ticker:run $tw(p).t
    if {$tw(toplevel)} {
        update idletasks
    }
}
    
proc init_tclweather_gui {} {
    global tw
    Ticker:create $tw(p).t -relief flat -borderwidth 0 -highlightthickness 0 \
            -height [winfo reqheight $tw(p)]
    pack $tw(p) -fill both -expand 1
    button $tw(p).l -text "<<"
    button $tw(p).r -text ">>"
    ;# the buttons and ticker are packed in the scroll_buttons_trace
    ;# procedure
    bind $tw(p).l <ButtonPress-1> \
            "Ticker:advance $tw(p).t -15; weather_button_down $tw(p).l -15"
    bind $tw(p).l <ButtonRelease-1> \
            "after cancel {weather_button_down $tw(p).l -15}"
    bind $tw(p).t <Button-3> {tclweather::configure}
    bind $tw(p).r <ButtonPress-1> \
            "Ticker:advance $tw(p).t 15; weather_button_down $tw(p).r 15"
    bind $tw(p).r <ButtonRelease-1> \
            "after cancel {weather_button_down $tw(p).r 15}"
    bind $tw(p) <Configure> "Ticker:set_height $tw(p).t"
}

proc init_tclweather_etc {settings_found} {
    global tw TCLWEATHER_VERSION
    ;# force the initial states
    if {$tw(toplevel)} {
        trace variable tw(titlebar) w {titlebar_trace}
        trace variable tw(location_code) w {location_code_trace}
        titlebar_trace "" "" ""
        location_code_trace "" "" ""
    }
    trace variable tw(scroll_buttons) w {scroll_buttons_trace}
    scroll_buttons_trace "" "" ""
    update_weather_ticker_format
    Ticker:add_single_datum $tw(p).t "this is TclWeather $TCLWEATHER_VERSION" \
            "server_message"
    if {$settings_found != 1} {
        Ticker:add_single_datum $tw(p).t "left-click to open external browser" \
                "server_message"
        Ticker:add_single_datum $tw(p).t "right-click to configure" \
                "server_message"
    }
    while {![load_location_cache $tw(location_filename)]} {
        if {[string equal [tk_messageBox -title "TclWeather Startup" -icon error \
                -parent $tw(p) -message "Unable to load location database $tw(location_filename)." \
                -type retrycancel] "cancel"]} {
            break
        }
    }
}

;#######################################################################
;# IMPORTANT:
;#   If you are not running this program standalone, YOU have to
;#   invoke init_tclweather() and main_weather_loop () yourself.
;#######################################################################
if {[string equal -nocase [file tail $argv0] "tclweather.tcl"]} {
    init_tclweather "" [lindex $argv 0]
    main_weather_loop
}