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

# This file contains procedures called from the Tk menus and their
# supporting procedures.


# Procedures called directly from the Tk Menus

# File menu: "Update Storm Data (From File)"
proc update_data {} {
   set filename [tk_getOpenFile -title "Storm Data Update Filename"]
   if {$filename != ""} { filt_read_advisories $filename }
}


proc update_http {} {
   toplevel .http_update
   set w .http_update
   set cwd [pwd]
   cd ../httpfilt

   wm protocol $w WM_DELETE_WINDOW { exit }
   wm geometry $w +200+200
   wm attributes .http_update -topmost true

   pack [label $w.msg1 -text "HTTP Update In Progress...." -background black \
      -foreground yellow -font {Courier 20}] -side top -expand y -fill x
   pack [label $w.msg2 -text "" -background black \
      -foreground yellow -font {Courier 20}] -side top -expand y -fill x


   $w.msg2 configure -text "Checking for updates in TCMAT (Forecast/Advisory)"
   update
   set processed [process_newdata TCMAT]
   set s1 "Processed  $processed updates for FORECAST"

   $w.msg2 configure -text "Checking for updates in TCPAT (Public Advisory)"
   update
   set processed [process_newdata TCPAT]
   set s2 "Processed  $processed updates for ADVISORY"

   $w.msg2 configure -text "Checking for updates in TCDAT (Discussion)"
   update
   set processed [process_newdata TCDAT]
   set s3 "Processed  $processed updates for DISCUSSION"

   tk_messageBox -type ok -message "HTTP Updates:

$s1
$s2
$s3
"
   destroy .http_update
   cd $cwd
}



proc check_ww {} {
   global watchwarn st_names

   .warnings configure -foreground black
   foreach name $st_names {
      if {[info exists watchwarn($name)]} {
         set idx $watchwarn($name)
         if {[info exists watchwarn($name:$idx)]} {
            .warnings configure -foreground red
         } else {
         }
      }
   }
}



proc getww {} {
   global watchwarn st_names color text_font

   toplevel .ww
   set w .ww
   wm geometry $w +315+80
   wm title .ww "Watch/Warning Data"
   wm attributes $w -topmost true
   pack [frame $w.f] -side top
   set w .ww.f

   text $w.t -yscrollcommand "$w.scrolly set" -font {Courier 14} \
      -background white -foreground black -spacing3 1.2
   scrollbar $w.scrolly -orient v -command "$w.t yview"
   pack $w.scrolly -side right -fill y
   pack $w.t -side left -fill both -expand 1
   ::autoscroll::autoscroll $w.scrolly
   $w.t tag configure boldred -font {Courier 18 bold} -foreground #d90000

   pack [frame .ww.endf] -side top -expand y -fill x
   button .ww.endf.dismiss -text {Dismiss} -command { destroy .ww }
   pack .ww.endf.dismiss -side left -expand y -fill x

   foreach name $st_names {
      if {[info exists watchwarn($name)] == 0} { continue }
      set idx $watchwarn($name)

      set sttype [get_st_type $name $idx]
      if {[info exists watchwarn($name:$idx)]} {
         $w.t insert end "Watches/Warnings for $sttype $name ($idx)\n\n" boldred
         foreach line $watchwarn($name:$idx) { $w.t insert end $line\n }
         $w.t insert end "\n"
      }
   }
}

# File menu:  Merge Storm Data"
proc merge_data {} {
   global storms

   tk_messageBox -type ok -message "This procedure merges a tropical \
   depression's data with its associated named storm.  This way, when \
   you load a named storm's data, the earlier history of the storm is \
   loaded as well.  You will be asked for two filenames:  first, the \
   tropical depression name (TD Four would be four.trk), and then the \
   tropical storm name (TS Cartman would be cartman.trk)."

   set types {
      {{Storm Track Files}	{.trk}}
   }
   set tdfn [tk_getOpenFile \
      -title "Please Select the Tropical Depression File" \
      -initialdir $storms -filetypes $types]
   if {[string compare $tdfn ""] == 0} { return }

   set tsfn [tk_getOpenFile \
      -title "Please Select the Tropical Storm File" \
      -initialdir $storms -filetypes $types]
   if {[string compare $tsfn ""] == 0} { return }

   set tdf [open $tdfn a]
   set tsf [open $tsfn r]
   set flist [split [read $tsf] \n\r]
   close $tsf
   foreach line $flist { puts $tdf $line }
   close $tdf
   file rename -force $tdfn $tsfn
}

# File menu:  "PostScript output"
# proc create_ps moved to canvas.tk


# Options menu:  "Home Coordinates"
proc mnu_home_coords {} {
   global home_latt home_long libdir jstrackrc homestore store color

   set store 0
   set homestore 0
   catch { destroy .homeloc }
   toplevel .homeloc
   set x [winfo rootx .opts.m]
   set y [expr {[winfo rooty .opts.m] + 30}]
   wm geometry .homeloc +$x+$y
   wm attributes .homeloc -topmost true

   set w .homeloc.lattfr
   frame $w ; pack $w -side top
   label $w.lbl -text "N Latitude:"
   entry $w.ent -width 5
   pack $w.lbl $w.ent -side left
   if {[info exists home_latt]} { $w.ent insert end $home_latt }

   set w .homeloc.longfr
   frame $w ; pack $w -side top
   label $w.lbl -text "W Longitude:"
   entry $w.ent -width 5
   pack $w.lbl $w.ent -side left
   if {[info exists home_long]} { $w.ent insert end $home_long }

   set w .homeloc
   checkbutton $w.store -text "Save to sysconfig.tcl" -variable store
   if {[file writable sysconfig.tcl] == 0} {
      $w.store configure -state disabled
   }
   checkbutton $w.hstore -text "Save to $jstrackrc" -variable homestore
   pack $w.store $w.hstore -side top

   set w .homeloc.endfr
   frame $w ; pack $w -side top
   button $w.abrt -text "Abort" -command { destroy .homeloc }
   button $w.done -text "Finished" -command {
      global trackdir jstrackrc
      set hlatt [.homeloc.lattfr.ent get]
      set hlong [.homeloc.longfr.ent get]
      set home_latt $hlatt
      set home_long $hlong
      if {[string compare $hlatt ""] && [string compare $hlong ""]} {
         plot_home_x

         if {$store} {
            set f [open $trackdir/sysconfig.tcl w]
            puts $f "# Home location saved from within JStrack"
            puts $f "set home_latt \"$hlatt\""
            puts $f "set home_long \"$hlong\""
            puts $f ""
            close $f
         }
         if {$homestore} {
            set f [open $jstrackrc a]
            puts $f "# Home location saved from within JStrack"
            puts $f "set home_latt \"$hlatt\""
            puts $f "set home_long \"$hlong\""
            puts $f ""
            close $f
         }
      }
      destroy .homeloc
   }
   pack $w.abrt $w.done -side left
}


# Options menu: "Warnings (when storm gets too close)"
proc mnu_warnings {} {
   catch { destroy .mnuwarn }
   toplevel .mnuwarn
   set w .mnuwarn.f
   wm attributes .mnuwarn -topmost true

   set text_font {Helvetica 14}
   set bold_font {Helvetica 14 bold}
   set big_bold_font {Helvetica 20 bold}

   pack [frame $w] -side top -expand y -fill x
   text $w.text -relief sunken -bd 2 -width 80 -height 15 \
      -font $text_font -yscrollcommand "$w.scroll set" \
      -background white -foreground black -spacing3 1.2
   scrollbar $w.scroll -command "$w.text yview"
   pack $w.scroll -side right -fill y
   pack $w.text -side top -expand yes -fill both
   ::autoscroll::autoscroll $w.scroll

   $w.text tag configure normal -font $text_font -foreground black
   $w.text tag configure bold -font $bold_font -foreground black
   $w.text tag configure big_bold -font $big_bold_font -foreground black

   set wt $w.text

   $wt insert end { 
JStrack will warn you in various ways if a storm gets too close.
If nothing else, it will change the color of the bar displaying
the name of the storm.  What distance (in nautical miles) do you
want to consider too close?  (default is 60 nautical miles)
} normal

   $wt insert end { 
} big_bold

   entry $wt.e11 -textvariable warn_at_nm -width 4
   $wt window create end -window $wt.e11
   $wt insert end { 
} normal

   $wt insert end { 
} big_bold
   $wt insert end "EVENTS and ASSOCIATED PROGRAMS" big_bold
   $wt insert end { 
} big_bold

$wt insert end { 
These are (optional) command lines for programs associated with certain
events in JStrack.  You can, for example, play a sound file to wake you
up when new data arrives for a storm.  If you want to include the name
of the storm (e.g., for a voice synth), use $nm (lowercase) or $name
(uppercase) in the command line.

Example:  play a sound file when new data arrives
   wavplay /home/jim/snd/simpsons/doh.wav

Example:  send storm name and text to voice synth when new data arrives
   say new data arrived for $nm

Program to use when new data arrives for displayed storm

} normal

   entry $wt.e2 -textvariable update_prog -width 75
   button $wt.test2 -text "Test" -command { test_progs $update_prog }
   $wt window create end -window $wt.e2
   $wt insert end "   " normal
   $wt window create end -window $wt.test2

   $wt insert end {

Program to use when a POSITION ESTIMATE arrives for displayed storm

} normal

   entry $wt.e3 -textvariable pos_est_prog -width 75
   button $wt.test3 -text "Test" -command { test_progs $pos_est_prog }
   $wt window create end -window $wt.e3
   $wt insert end "   " normal
   $wt window create end -window $wt.test3

   $wt insert end {


The next two have additional variables (see above) available:

   timestamp  - current time for latest advisory (e.g., 02/0900Z)
   warn_at_nm - (see above---distance in nautical miles for warnings)

Program to use when storm is CURRENTLY within above number of nm

} normal

   entry $wt.e5 -textvariable current_prog -width 75
   button $wt.test5 -text "Test" \
      -command { test_prox_warning_progs $current_prog }
   $wt window create end -window $wt.e5
   $wt insert end "   " normal
   $wt window create end -window $wt.test5

   $wt insert end {

Program to use when storm is FORECAST to come within above number of nm

} normal

   entry $wt.e6 -textvariable forecast_prog -width 75
   button $wt.test6 -text "Test" \
      -command { test_prox_warning_progs $forecast_prog }
   $wt window create end -window $wt.e6
   $wt insert end "   " normal
   $wt window create end -window $wt.test6

   $wt insert end {
} normal


   button $w.done -text "Done" -command { destroy .mnuwarn }
   pack $w.done
}

# Options menu:  "Save Config"
# proc save_config moved to save_config.tcl

# Storm Data menu:  "Load/reload storm(s)"
proc mnu_reload {} {
   global storms
   catch {
      lappend flist "== CURRENT =="
      lappend flist ""
      foreach filename [lsort [glob $storms/*.trk]] {
         lappend flist [file rootname [file tail $filename]]
      }
#     for {set i 0} {$i < 4} {incr i} { lappend flist "" }
   }
   catch {
      foreach dir [lsort -decreasing [glob $storms/old/{1,2}*]] {
         set dir [file tail $dir]
         lappend flist ""
         lappend flist "== $dir =="
         lappend flist ""
         if {[file isdirectory $storms/old/$dir] && $dir != "locks"} {
            foreach filename [glob $storms/old/$dir/*.trk] {
               lappend flist old/$dir/[file rootname [file tail $filename]]
            }
         }
      }
   }

   eval mk_list list_load $flist
}


# Storm Data menu:  "Remove storm(s) from chart"
proc mnu_remove {} {
   global st_names
   eval mk_list list_remove $st_names
}

# NOTE:  Storm Data menu's tk_st_data is in userdata.tk

# Storm Data menu:  "History of storm"
proc mnu_hist {} {
   global st_names
   eval mk_list list_hist $st_names
}


# Storm Data menu:  "Plot all wind radii for storm"
proc mnu_radii {} {
   global st_names
   eval mk_list list_radii $st_names
}

# Storm Data menu:  "Remove all wind radii for storm"
proc mnu_rm_radii {} {
   global st_names
   eval mk_list list_rm_radii $st_names
}

# "Info" button
proc jstrack_info {} {
   global text_font color
   catch { destroy .infobox }
   toplevel .infobox
   wm title .infobox "Info"
   wm attributes .infobox -topmost true

   set w .infobox.text
   text $w -width 35 -height 18 -relief flat -font $text_font \
            -foreground $color(dwinfg) -background $color(dwinbg) \
            -spacing3 1.2
   pack $w -side top
   button .infobox.done -text "Ok" -command { destroy .infobox } \
      -font $text_font
   pack .infobox.done -side top

   set x [expr {[winfo rootx .infomenu] - [winfo reqwidth .infobox]}]
   set y [winfo rooty .infomenu]
   wm geometry .infobox +$x+$y
   
   $w insert end "\n"
   $w insert end "JStrack was written by\n"
   $w insert end "Jim Graham, N5IAL.\n"
   $w insert end "\n"
   $w insert end "JStrack is copyright 1997,2002\n"
   $w insert end "by Jim Graham, N5IAL.\n"
   $w insert end "All Rights Reserved.\n"
   $w insert end "\n"
   $w insert end "This program is freeware.\n"
   $w insert end "Enjoy!\n"
   $w insert end "\n"
   $w insert end "  --jim (j.graham@ieee.org)\n"
   $w insert end "\n"
   $w insert end "http://www.purl.org/net/jstrack\n"
}


# Procedures used by the above....

proc mk_list {fin_cmd args} {
   global pmw cmdlist

   catch { destroy .ltop }
   toplevel .ltop

   set x [expr {[winfo rootx $pmw] + [winfo width $pmw]}]
   set y [expr {[winfo rooty $pmw] + [winfo height $pmw] + 60}]
   wm geometry .ltop +$x+$y
   wm attributes .ltop -topmost true

   set w .ltop.listfr
   frame $w
   pack $w -side top

   listbox $w.list1 -width 30 -yscroll "$w.list1sb set"
   $w.list1 configure -background white -foreground black
   scrollbar $w.list1sb -command "$w.list1 yview" -relief raised
   pack $w.list1sb -side left -fill both -expand 1
   pack $w.list1 -side left -fill y

   foreach i $args { $w.list1 insert end $i }

   listbox $w.list2 -width 30 -yscroll "$w.list2sb set"
   $w.list2 configure -background white -foreground black
   scrollbar $w.list2sb -command "$w.list2 yview" -relief raised
   pack $w.list2 -side left -fill y
   pack $w.list2sb -side left -fill both -expand 1

   bind $w.list1 <1> {
      set w .ltop.listfr
      if [winfo exists %W] {
         tkListboxBeginSelect %W [%W index @%x,%y]
      }
      set cs [$w.list1 curselection]
      if {$cs != "" && ![regexp {^== } $cs]} {
         if {[lsearch -exact [$w.list2 get 0 end] \
            [$w.list1 get $cs]] == -1} {
            $w.list2 insert end "[$w.list1 get $cs]"
         }
      }
   }
   bind $w.list2 <1> {
      set w .ltop.listfr
      if [winfo exists %W] {
         tkListboxBeginSelect %W [%W index @%x,%y]
      }
      set cs2 [$w.list2 curselection]
      if {$cs2 != "" && ![regexp {^== } $cs2]} {
         $w.list2 delete "[$w.list2 curselection]"
      }
   }
   set w .ltop.bfr
   frame $w
   pack $w -side top

   button $w.done -text "Ok" -command [subst "
      $fin_cmd [.ltop.listfr.list2 get 0 end]
      destroy .ltop
      update
   "]
   button $w.dismiss -text "Dismiss" -command { destroy .ltop }
   pack $w.done $w.dismiss -side left
}


proc list_load {} {
   global noreconfig ; set noreconfig 1
   foreach i [.ltop.listfr.list2 get 0 end] { reload $i }
   handle_resize 1 ; set noreconfig 0
}


proc list_remove {} {
   foreach i [.ltop.listfr.list2 get 0 end] { wipeclean $i }
}


proc list_hist {} {
   global text_font pmw color
   catch { destroy .histtl }
   toplevel .histtl
   wm title .histtl "Storm History"

   set x [expr {[winfo rootx $pmw] + [winfo width $pmw]}]
   set y [expr {[winfo rooty $pmw] + [winfo height $pmw] + 60}]
   wm geometry .ltop +$x+$y
   wm attributes .ltop -topmost true

   set w .histtl.txtfr
   frame $w
   pack $w -side top
   text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
      -font  $text_font -foreground $color(dwinfg) -background $color(dwinbg) \
      -spacing3 1.2
   scrollbar $w.scroll -command "$w.text yview"
   pack $w.scroll -side right -fill y
   pack $w.text -side top -expand yes -fill both
   ::autoscroll::autoscroll $w.scroll

   set w .histtl.dismiss
   button $w -text "Dismiss" -command {destroy .histtl}
   pack $w -side top

   foreach name [.ltop.listfr.list2 get 0 end] {
      st_hist $name tk_hist_puts
      tk_hist_puts ""
   }
   .histtl.txtfr.text see 0.0
}

proc draw_hist {name} {
   global text_font pmw color
   catch { destroy .histtl }
   toplevel .histtl
   set name [string toupper $name]
   wm title .histtl "Storm History"
   wm attributes .histtl -topmost true

   set x [expr {[winfo rootx $pmw] + [winfo width $pmw]}]
   set y [expr {[winfo rooty $pmw] + [winfo height $pmw] + 60}]
   wm geometry .histtl +$x+$y

   set w .histtl.txtfr
   frame $w
   pack $w -side top
   text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
      -font  $text_font -foreground $color(dwinfg) -background $color(dwinbg) \
      -spacing3 1.2
   scrollbar $w.scroll -command "$w.text yview"
   pack $w.scroll -side right -fill y
   pack $w.text -side top -expand yes -fill both
   ::autoscroll::autoscroll $w.scroll

   set w .histtl.dismiss
   button $w -text "Dismiss" -command {destroy .histtl}
   pack $w -side top

   st_hist $name tk_hist_puts
   tk_hist_puts ""
   .histtl.txtfr.text see 0.0
}



proc list_radii {} {
   global st_times

   foreach name [.ltop.listfr.list2 get 0 end] {
      set name [string toupper $name]
      set tmplist [split "$st_times($name)"]
      foreach timestamp $tmplist { radii_plot $name $timestamp }
   }
}


proc list_rm_radii {} {
   global st_times auto_fc

   foreach name [.ltop.listfr.list2 get 0 end] {
      set name [string toupper $name]
      set tmplist [split "$st_times($name)"]
      foreach timestamp $tmplist { canvas_delete_wtags wind_radii.$name$timestamp }
      set tmp_fc $auto_fc ; set auto_fc 0
      plot_last $name
      set auto_fc $tmp_fc
   }
}


proc tk_hist_puts {args} {
   set w .histtl.txtfr.text

   if {[llength $args] == 1} {
      set text "[lindex $args 0]"
      $w insert end "$text\n"
   } elseif {[llength $args] == 2 && [lindex $args 0] == "-nonewline"} {
      set text "[lindex $args 1]"
      $w insert end "$text"
   }
   $w see end
}

proc newmap {} {
   global home_latt home_long color stfile altprint color cities_loaded

   set c white ; set hc $color(homex)
   # override for ink-friendly colors
   if {$altprint} { set c black ; set hc red }
   set color(homex) $hc ;# 'X' for home location
   set color(b3box) $c ;# box for button 3 binding

   foreach child [winfo children .warnframe] {
      regexp {^.warnframe.([a-z]+)$} $child a name
      catch { reload $stfile($name) }
   }

   plot_home_x
   if {$cities_loaded} { plot_user_cities }
}



