#!/bin/sh -f
# version 0.1 \
exec wish $0 $@:q
package require http
set CITY hopkinton
set STATE ma
set FIFTEEN [expr 15*60*1000]
set INCREMENT 1
set SPEED 80
set LOW 0
set HI 1
set COMMENT ""
set PROGRESS ""
set scrollindex 0
array set CURSOR {0 watch 1 cross}
set CURSORI 0

# set title and undisplay toplevel window
wm title . Weather
wm withdraw .
# Create dynamic icon
toplevel .icon
wm iconwindow . .icon
label .icon.image -borderwidth 0 
pack .icon.image
bind .icon <Double-Button-1> {wm deiconify .}
bind . <Button-1> {openInput}

proc httpProgress {token total current} {
  upvar #0 $token http
  global CURSOR CURSORI PROGRESS

  #catch {.input conf -cursor $CURSOR([set CURSORI [expr !$CURSORI]])}
  #update
  #puts $http(state)
  # add a dot to current progress value
  set PROGRESS "$PROGRESS."
}

# Procedure to display city/zip control pannel
proc openInput {} {
  if [winfo exists .input] {
    wm deiconify .input
  } else {
    createInput
  }
}

# Procedure to create the input control pannel window
proc createInput {} {
  global CITY STATE ZIP PROGRESS COMMENT GET CURSOR

  toplevel .input
  wm title .input "Weather Control"
  set t .input
  frame $t.buttons
  frame $t.notify
  pack $t.buttons $t.notify -side bottom -fill x

  # scale to vary scroll rate of current conditions
  scale $t.scale -orient vertical -from 5 -to 125 -variable SPEED
  pack $t.scale -side right -fill y -expand yes

  # activity state display
  label $t.notify.wait0 -textvariable COMMENT 
  label $t.notify.wait1 -justify left -width 24 -textvariable PROGRESS 
  pack $t.notify.wait0 -side left -expand no
  pack $t.notify.wait1 -side left -anchor w -fill x -expand no

  # entry fields for city state and zip
  frame $t.cityblock -relief ridge -bd 3
  frame $t.zipblock -relief ridge -bd 3
  pack $t.cityblock $t.zipblock -side top -fill x
  # city entry
    set f $t.city
    frame $f 
    label $f.label -width 5 -text City -justify right
    entry $f.entry -textvariable CITY
    pack $f -side top -in $t.cityblock -fill x
    pack $f.label $f.entry -side left
  # state entry
    set f $t.state
    frame $f 
    label $f.label -width 5 -text State -justify right
    entry $f.entry -textvariable STATE
    pack $f -side top -in $t.cityblock -fill x
    pack $f.label $f.entry -side left
    set f $t.zip
  # zip entry
    frame $f 
    label $f.label -width 5 -text Zip -justify right
    entry $f.entry -textvariable ZIP
    pack $f -side top -in $t.zipblock -fill x
    pack $f.label $f.entry -side left

  $t.state.entry configure -width 3
  $t.zip.entry configure -width 8

  #display seperator
  label $t.or -text OR -padx 15 -justify left
  pack $t.or -anchor w -after $t.cityblock

  # exit, close, get weather and clear button pannel
  set b $t.buttons
  button $b.quit  -text Exit  -command {exit}
  button $b.close -text Close -command {
		if {"[info commands .conditions]" == ""} {
		  exit
		} else {destroy .input}
	}
  button $b.get   -textvariable GET -width 8 -command {
  		set orgcursor [.input cget -cursor]
  		.input config -cursor $CURSOR(0)
  		runWeather
  		.input config -cursor $orgcursor
	}
  set GET "Get City"
  button $b.clear -text Clear -command {set CITY "";set STATE "";set ZIP ""}
  pack $b.quit $b.close $b.get $b.clear -side left

  # Bindings to set what type of weather disignator is fetch state/zip
  bind $t.city.entry  <FocusIn> {set GET "Get City"}
  bind $t.state.entry <FocusIn> {set GET "Get City"}
  bind $t.zip.entry   <FocusIn> {set GET "Get Zip"}
  bind $t <Return> {focus [tk_focusNext %W]}
}

# Create Current conditions scrolling window
proc createConditions {target lines} {
  global STOP INCREMENT

  set STOP($target) 0

  set charheight 12
  # number of lines + a pad line front and end
  set height [expr ($lines*$charheight)+(2*$charheight)]
  set width [expr ($charheight/2)*40]

  canvas $target -relief sunken -bg white -bd 2    \
        -width $width -height [expr $charheight+8] \
	-yscrollincrement $INCREMENT \
        -scrollregion {0 0 240 240}
  $target xview moveto 0.0
  pack $target -fill x -side bottom
}

# Procedure for clearing current conditions scroll window and
# updateing it with the latest conditions.
proc setConditions {target lines} {
  global STOP CURRENT END

  # Stop the scrolling screen and kill any pending afters
  set STOP($target) 1
  foreach id [after info] {after cancel $id}
  # clear scrolling canvas
  $target delete all
  $target yview moveto 0.0
  # get viewable window size
  set width [$target cget -width]
  set height [$target cget -height]
  # place current weather GIF at right of display region just
  # below the viewable portion of canvas
  $target create image $width $height -image [lindex $CURRENT(IMAGE) 0] -anchor n 
  # update icon image
  .icon.image configure -image [lindex $CURRENT(IMAGE) 0]
  # create text indented by the height of viewable area and just below it
  set i [$target create text $height $height \
  	-text [join $lines "\n"] -anchor nw -justify left]
  # set end of viewable text
  set END [lindex [$target bbox $i] 3]
  set STOP($target) 0
}

# Procedure to scroll a target canvas window 
# inputs the speed/delay between iterations
#	a stop flag array for all targets being scrolled
#	end of scroll region
proc roll {target speed stop end} {
  upvar $speed DELAY
  upvar $stop STOP 
  upvar $end END
  
  # terminate on stop flag for target canvas
  if {$STOP($target) == 1} {set STOP($target) 0;return}
  # if currently displayed postion of canvas is past end of 
  # data reset to top of canvas
  if {[expr [$target canvasy 0.0] > $END]} {
      $target yview moveto 0.0
  } 
  # scroll canvas every DELAY ms.
  $target yview scroll 1 unit
  after $DELAY roll $target $speed $stop $end
}

# procedure for fetching a gif image from an http server
proc getImage {target} {
  global PROGRESS
  set origional $PROGRESS
  set PROGRESS "Fetching Image"
  update
  set target [string trim $target {"}]
  set fname "[file tail [file dirname $target]]/[file rootname [file tail $target]]"
  set name "[file tail [file dirname $target]][file rootname [file tail $target]]"
  # if image is not already cashed get it
  if {[lsearch [image names] $name] == -1} {
      # if address of object is relative add server
#      if {[string range $target 0 3] != "http"} {
#	set target "http://www.weather.com$target"}
      if {[string range $target 0 3] != "http"} {
      	set target "http://image.weather.com$target"}
#      if [file isfile $fname] {
#	image create photo $name -format gif -file $fname}
      set id [http::geturl $target -progress httpProgress]
      set f [open /tmp/.a w+]
      puts $f [http::data $id]
      close $f
      image create photo $name -format gif -file /tmp/.a
#      set f $fname
#      image create photo $name -format gif -file $f
      exec rm /tmp/.a
  }
  set PROGRESS $origional
  return $name
}

# procedure to create enter/update current conditions and scroll window
proc displayConditions {} {
  global CURRENT SPEED STOP END

  if {"[info commands .conditions]" == ""} {createConditions .conditions [llength $CURRENT(REPORT)]}
  setConditions .conditions $CURRENT(REPORT)
  roll .conditions SPEED STOP END

}

# procedure to create a day display frame
proc createDay {day} {

  frame $day -bg white -bd 2 -relief sunken 
  canvas $day.image -bg white -highlightthickness 0
  label $day.label -pady 0 -bg white -width 9 -font heb6x13
  #pack $day -side left
  pack $day.image $day.label -in $day -side top -anchor n
}

# procedure to enter five day forcast info in appropriate frame
proc setDay {day theday image condition range} {
  global HI LOW
    set t .day$day
    set height [image height $image] 
    set width  [image width $image]

    # size image canvas the size of the image
    $t.image configure -height $height -width $width
    $t.image delete all
    # place weather forcast image
    $t.image create image 0c 0c -image $image -anchor nw 
    # over lay the day
    $t.image create text 0 0 \
	-text $theday -anchor nw -justify left
    # over lay low in lower left 
    $t.image create text 0 ${height} \
	-text "[lindex $range $LOW]" -fill blue -anchor sw -justify left
    # over lay hi in lower right 
    $t.image create text ${width} ${height} \
	-text "[lindex $range $HI]" -fill red -anchor se -justify right
    # config frame label with text of conditions
    $t.label config -text [join $condition "\n"]

    pack $t -side left -anchor n -fill y

}

# procedure to display new/updated five day forcast information
proc displayFiveday {} {
  global FIVEDAY

  for {set day 0} {$day<5} {incr day} {
    if {"[info commands .day$day]" == ""} {createDay .day$day}
    setDay $day $FIVEDAY($day) $FIVEDAY(IMAGES$day) $FIVEDAY(CON$day) $FIVEDAY(RANGE$day)
  }
}

# procedure to read weather info from http server
# input 
#    get - which page to get city or zip data
#    d - pointer to location to store resulting data
#
proc getWeather {get d} {
global CITY STATE ZIP 
upvar $d data

  set BlockSize 4096

  set state 0
  if {"$get" == "Get City"} {
      set id [http::geturl \
      [format "http://www.weather.com/weather/cities/us_%s_%s.html" \
      [string tolower ${STATE}] [string tolower ${CITY}]] \
      -progress httpProgress ]
  } else {
      set id [http::geturl http://www.weather.com/weather/us/zips/$ZIP.html \
      -progress httpProgress]
  }
  if {[http::status $id] == "timeout"} {
    set state 2
  } elseif {[lindex [http::code $id] 1] == 404} {
    # if return code contains 404 this is an error. 
    set state 1
  } else {
    # update image html tags
    regsub -all {<IMG SRC=} [http::data $id] {IMAGE } data
    # translate breaks into blanks
    regsub -all {<BR>} $data { } data
    # substiture character to display degrees correctly
    regsub -all {&deg;} $data \xb0 data
    # strip out all the rest of the html fields
    regsub -all {<[^>]*>} $data {} data
  #}
  return $state
}

proc parseData {data} {
  global CURRENT FIVEDAY LOW HI 
  catch {unset CURRENT FIVEDAY}

	set begin 0
	set state START
	foreach i [split $data "\n"] {
	 # discard blanks
	 if {"[set i [string trim $i]]" == {}} {continue}
	 set target [lindex $i 0]
	 # the desired data ends with a line that starts with
	 # "Conversions" discard the rest we're done
	 if {"$target" == "Conversions"} {break}
	 # "5-day" starts the five day forcast entry parse header
	 if {"$target" == "5-day"} {set state FIVEHEADER}
	 switch -exact $state \
	   START {  
		# scanning through to find start of current conditions
		# discard everything up until then
		if {[string compare "$target" "IMAGE"] == 0} {continue}
		if {[string compare "$target" "current"] == 0} {
		    # OK we got it set state CURRENT
		    # save previous line for window header 
		    # start saving current report 
		    set state CURRENT
		    set CURRENT(HEAD) $last
		    lappend CURRENT(REPORT) "$i"
		   }
		set last $i
	      } \
	   CURRENT {
		# get and save any imbeded images within the current conditions
		if {[string compare "$target" "IMAGE"] == 0} {
		  lappend CURRENT(IMAGE) [getImage [lindex $i 1]]
		} else {
		  lappend CURRENT(REPORT) "$i"
		}
	      } \
	   FIVEHEADER {
		# header info end with "last updated"
		if {"$target" == "last"} {
			  set state FIVEDAY
			  set DAY 0
		    }
		# build up header information
		lappend FIVEDAY(HEADER) $i
	      } \
	   FIVEDAY { 
		# the next five entrys are the names of the days
		set FIVEDAY($DAY) $i
		if {[incr DAY] == 5} {
		    set DAY 0
		    set state FIVEIMAGE
		}
	      } \
	   FIVEIMAGE { 
		# the next five entrys are the forcast images
		set FIVEDAY(IMAGES$DAY) [getImage [lindex $i 1]]
		if {[incr DAY] == 5} {
		    set DAY 0
		    set state FIVECONDITION
		}
	      } \
	   FIVECONDITION {
		# the next five entrys are the forcast text
		set FIVEDAY(CON$DAY) $i
		if {[incr DAY] == 5} {
		    set DAY 0
		    set RANGE $LOW 
		    set state FIVETEMP
		}
	      } \
	   FIVETEMP {
		# the next ten entries are the alternating
		# lows/hi pairs for the days of which only 
		# take the numerical value
		lappend FIVEDAY(RANGE$DAY) [lindex $i 1]
		if {[incr DAY $RANGE] == 5} {continue}
		set RANGE [expr ! $RANGE]
	      } \
	   default {
	      } \
	}
}


proc runWeather {} {
  global CURRENT FIFTEEN SPEED PROGRESS COMMENT GET

  set DATA ""
  set COMMENT "Please Wait..."
  set PROGRESS "Fetching Data"
  update
  if {[set rtn [getWeather $GET DATA]] == 1} {
    set COMMENT "Can Not find."
    set PROGRESS "Check spelling or zip."
    return
  } elseif {$rtn == 2} {
    set COMMENT "Request timedout"
    set PROGRESS ""
    return
  }
  set PROGRESS "Parsing Data..."
  update
  parseData $DATA
  set PROGRESS "Formating Data..."
  update
  displayConditions
  displayFiveday
  wm deiconify .
  wm title . $CURRENT(HEAD)
  set COMMENT ""
  set PROGRESS ""
  after $FIFTEEN runWeather
}

openInput
