
# JStrack:  copyright 1997/2010 by Jim Graham, N5IAL, all rights reserved.

source $libdir/imagery_links.tcl
source $libdir/jpg_xy.tcl
set imgloop_delay 500 ;# good default
set s1 "Imagery provided by the National Oceanic and" ;# just to cut
set s2 "Atmospheric Administration (NOAA)."           ;# line lengths
set noaacredits "$s1 $s2"

if {[catch { set img_version [package require Img] }]} {
   set img_version -1
}


proc check_img {} {
   global img_version

   if {$img_version < 0} {
      tk_messageBox -type ok -message \
      "The Img extension is
REQUIRED for displaying
satellite imagery.

See the JStrack web page
for more information
about adding the Img extension."
      return 0
   }
   return 1
}

proc noaa_links {} {
   global goeslinks tagidx

   catch { destroy .imglinks }
   toplevel .imglinks
   wm attributes .imglinks -topmost true
   wm title .imglinks "Satellite Imagery Links"
   wm geometry .imglinks +[winfo rootx .c]+[winfo rooty .c]
   set w .imglinks
   text $w.text -background white -foreground black
   button $w.dismiss -text "Dismiss" -command { destroy .imglinks }
   pack $w.text $w.dismiss -side top -expand y -fill x
   set t $w.text ; set txtfont {"Courier New" 14 bold}

   $t tag configure wintitle -font {"Courier New" 18 bold} \
      -foreground #dd0000 -justify center
   $t tag configure wintitleb -font $txtfont \
      -foreground #dd0000 -justify center
   $t tag configure linktitle -font $txtfont
   $t tag configure link -font $txtfont -foreground #0000dd

   $t insert end "NOAA Satellite Services Division Links\n" wintitle
   $t insert end "(cut/paste to your web browser)\n\n" wintitleb
   $t insert end "NOAA SSD Home:  " linktitle
   $t insert end "$goeslinks(SSD_Home)\n\n" link

   $t insert end \
      "NOAA SSD - Tropical Atlantic Satellite Imagery:\n" linktitle
   $t insert end "   $goeslinks(SSD_TropAtl)\n\n" link

   foreach tlist $tagidx {
      foreach {tag idx} $tlist { break }
      $t insert end "GOES East $tag\n" linktitle
      $t insert end "   Current:  " linktitle
      $t insert end "$goeslinks($idx,html)\n" link
      $t insert end "   Loop:  " linktitle
      $t insert end "$goeslinks($idx,loop,html)\n\n" link
   }
}

package require http

proc download_img {link} {
   global trackdir

   if {[catch { set token [::http::geturl $link -validate 1] }]} {
      tk_messageBox -type ok -message "Unable to download image"
      return ""
   }
   upvar #0 $token state
   regexp {([234][0-9][0-9]) (.*)} $state(http) a code msg
   if {$code != 200} {
      tk_messageBox -type ok -message "Bad image link:
Response from server:  $code $msg"
      return ""
   }

   catch { file mkdir $trackdir/imagery }
   set linkfn [string tolower [file tail $link]]
   set filename $trackdir/imagery/$linkfn
   set f [open $filename w]
   set token [::http::geturl $link -channel $f]
   upvar #0 $token state
   regexp {([234][0-9][0-9]) (.*)} $state(http) a code msg
   if {$code != 200} {
      tk_messageBox -type ok -message "Unable to download image:
Response from server:  $code $msg"
      close $f
      return ""
   }
   close $f
   return $filename
}


# Make top part of the window for the two imagery display procs.
# They have a few differences in the middle, so each proc does that
# bit.  But for the bits that are the identical, why duplicate code?
proc goes_east_mktop {w title html_link} {
   catch { destroy $w }
   toplevel $w
   wm withdraw $w
   wm title $w "Satellite Imagery"
   wm geometry $w +[winfo rootx .c]+[winfo rooty .c]
   wm attributes $w -topmost true

   label $w.l1 -text "GOES East Hurricane Sector" \
      -font {Helvetica 14 bold}
   label $w.l2 -text "$title" -font {Helvetica 12 bold}
   label $w.l3 -text "($html_link)" -font {Helvetica 12}
   pack $w.l1 $w.l2 $w.l3 -side top -expand y -fill x
}


proc goes_east_hurrsec {title link html_link} {
   global goeslinks noaacredits

   if {![check_img]} { return }
   set w .imagery

   # Create the toplevel and top portion of the window
   goes_east_mktop $w $title $html_link
   wm attributes $w -topmost true
   
   set fn [download_img $link]
   if {$fn == ""} {
      label $w.l4 -text "Imagery download failed!"
      label $w.l5 -text \
         "Use a web browser and the link above to find the image...."
      $w.l4 configure -font {Helvetica 12 bold} -foreground red
      $w.l5 configure -font {Helvetica 12 bold} -foreground red

      pack $w.l4 $w.l5 -side top -expand y -fill x
   } else {
      foreach {width height} [jpg_xy $fn] { break }
      pack [canvas $w.c -width $width -height $height] -side top \
            -anchor center
      image create photo statimage -file $fn
      $w.c create image 0 0 -image statimage -anchor nw
   }

   label $w.endl1 -text $noaacredits
   label $w.endl2 -text "($goeslinks(SSD_Home))" -font {Helvetica 12}
   button $w.dismiss -text "Dismiss" -command "
      image delete statimage
      catch { file delete $fn }
      destroy .imagery
   "
   pack $w.endl1 $w.endl2 $w.dismiss -side top -expand y -fill x
   wm deiconify $w

}


proc playstop {} {
   global imgloop_delay imgloop_stop

   set rb .imagery.control.rb
   set bt .imagery.control.playstop

   switch [$bt cget -text] {
      Start {
               $bt configure -text "Stop"
               set imgloop_stop 0
               while {!$imgloop_stop} {
                  for {set i 0} {$i < 8 && !$imgloop_stop} {incr i} {
                     $rb.rb$i invoke ; update
                     after $imgloop_delay
                  }
               }
            }
      Stop  {
            $bt configure -text "Start"
            set imgloop_stop 1
            }
   }
}


proc goes_east_hurrsec_loop {title idx html_link} {
   global goeslinks cimg imgloop_delay loopimg noaacredits

   if {![check_img]} { return }
   set title "$title Loop"

   set w .imagery
   # Create the toplevel and top portion of the window
   goes_east_mktop $w $title $html_link
   wm attributes $w -topmost true

   set spacertxt "                                  "
   ########  Control frame  ########
   #################################
   pack [frame $w.control] -side top -expand n -anchor center
   set wc $w.control
   ###
   ### Radiobuttons (to indicate/select image from loop)
   ###
   pack [frame $wc.rb] -side left -expand n
   for {set i 0} {$i < 8} {incr i} {
      radiobutton $wc.rb.rb$i -variable cimg -value loopimg($i) \
         -text " "
      pack $wc.rb.rb$i -side left
   }
   pack [label $wc.spacer1 -text $spacertxt] -side left -expand n
   ###
   ### Start/Stop button
   ###
   button $wc.playstop -text Start -command { playstop }
   pack $wc.playstop -side left
   pack [label $wc.spacer2 -text $spacertxt] -side left -expand n
   ###
   ### Scale slider for delay
   ###
   pack [frame $wc.sf] -side left
   pack [frame $wc.sf.sftop] -side top -expand y -fill x
   set wt $wc.sf.sftop
   pack [label $wt.l1 -text "Slow" -font {Helvetica 10 bold}] -side left
   pack [label $wt.l2 -text "SPEED" -font {Helvetica 12 bold}] -side left \
        -expand y -fill x
   pack [label $wt.l3 -text "Fast" -font {Helvetica 10 bold}] -side left
   scale $wc.sf.delay -from 1000 -to 100 -variable imgloop_delay -showvalue 0 \
         -orient horizontal -length 300
   pack $wc.sf.delay -side top -expand n -anchor center


   # Create FRAME ONLY for canvas
   pack [frame $w.canvas] -side top -expand y -fill x
   set cwin $w.canvas.c

   label $w.endl1 -text "Downloading images...." -font {Helvetica 16 bold} \
      -foreground #dd0000
   label $w.endl2 -text "" -font {Helvetica 16 bold} -foreground #dd0000

   button $w.dismiss -text "Dismiss" -command {
      for {set i 0} {$i < 8} {incr i} {
         if {[.imagery.control.playstop cget -text] == "Stop"} {
            set imgloop_stop 1
         }
         catch { image delete loop$i }
      }
      destroy .imagery
   }
   pack $w.endl1 $w.endl2 $w.dismiss -side top -expand y -fill x
   wm deiconify $w

   set imgcnt 0

   for {set i 0} {$i < 8} {incr i} {
      $w.endl2 configure -text "Image [expr {$i + 1}] of 8"
      $wc.rb.rb$i invoke
      update
      set fn [download_img [lindex $goeslinks($idx,loop) $i]]
      if {$fn == ""} {
         $wc.rb.rb$i configure -state disabled
      } else {
         if {$imgcnt == 0} {
            foreach {width height} [jpg_xy $fn] { break }
            pack [canvas $cwin -width $width -height $height] \
                 -side top -expand y -fill x
         }
         incr imgcnt
         image create photo loop$i -file $fn
         catch { file delete $fn }
         set loopimg($i) [$cwin create image 0 0 -image loop$i -anchor nw]
         set cimg $loopimg($i)
         $wc.rb.rb$i configure -command " $cwin raise $loopimg($i) "
      }
   }

   $w.endl1 configure -text $noaacredits -font {Helvetica 12} \
                      -foreground black
   $w.endl2 configure -text "($goeslinks(SSD_Home))" \
                      -font {Helvetica 12} -foreground black
   update
   if {$imgcnt} {
      playstop
   } else {
      tk_messageBox -type ok -message {ALL images failed to download!
The links may have changed.....}
      destroy .imagery
      return
   }
}

