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

# This file contains the button-based menu for plotted points on the
# chart, etc.

# Check any window we create to make sure it's on-screen...if not,
# adjust so it is

proc ck_win_onscreen {w} {
   update
   set fix 0
   regexp {\+([0-9]*)\+([0-9]*)} [winfo geometry .c] a cx cy
   regexp {\+([0-9]*)\+([0-9]*)} [winfo geometry $w] a wx wy
   set newy $wy ; set newx $wx

   set ch [winfo height .c] ; set cw [winfo width .c]
   set wh [winfo height $w] ; set ww [winfo width $w]
   set maxcy [expr {$ch + $cy}] ; set maxcx [expr {$cw + $cx}]
   set wboty [expr {$wh + $wy}] ; set wrgtx [expr {$ww + $wx}]

   # check to see if the window is off-screen to the right
   if {$wrgtx > $maxcx} {
      set fix 1 ; set newx [expr {$maxcx - ($ww + 10)}]
   }

   # check to see if the window is off-screen to the bottom
   if {$wboty > $maxcy} {
      set fix 1 ; set newy [expr {$maxcy - ($wh + 10)}]
   }

   if {$fix} { wm geometry $w +${newx}+$newy ; update }
}


# This procedure builds a button-based menu when the user clicks
# on a plotted point on the chart.

proc point_menu {x y nm ts args} {
   global advisory_list storms tcl_platform stfile
   catch { destroy .pmbox }
   toplevel .pmbox
   wm geometry .pmbox +[expr {$x + 4}]+[expr {$y + 4}]
   wm attributes .pmbox -topmost true
   set wmtitle "[get_st_type $nm $ts] $nm $ts"
   wm title .pmbox $wmtitle

   label .pmbox.title -text $wmtitle
   pack .pmbox.title -side top -fill x

   button .pmbox.detail -text "Detailed Info/NHC Data" -anchor w \
      -command [subst "tk_detail \"$wmtitle\" $nm $ts $x $y"]
   pack .pmbox.detail -side top -fill x
   if {[string compare $advisory_list($nm$ts) "PE"]} {
#     catch {
#        if {$advisory_list($nm$ts) != "XX"} {
#           button .pmbox.adv -text "NHC Advisory Data" -anchor w \
#              -command [subst "tk_nhc_adv_menu $x $y $nm $ts"]
#           pack .pmbox.adv -side top -fill x
#           }
#     }
      if {[.c find withtag tmp_fc_lines.$nm$ts] == ""} {
         button .pmbox.plotfc -text "Plot Forecast Positions" -anchor w \
            -command [subst "global tmp_plot ; set tmp_plot 1 ; \
                     fc_plot $nm $ts ; set tmp_plot 0 ; \
                     update_point_menu $x $y $nm $ts"]
      } else {
         button .pmbox.plotfc -text "Delete Forecast Positions" -anchor w \
            -command [subst "nuke_fc $nm$ts ; update_point_menu $x $y $nm $ts"]
      }
      pack .pmbox.plotfc -side top -fill x
      if {[.c find withtag wind_radii.$nm$ts] == ""} {
         button .pmbox.plotwr -text "Plot Wind/Seas Radii" -anchor w \
            -command [subst "radii_plot $nm $ts ; update_point_menu $x $y $nm $ts"]
      } else {
         button .pmbox.plotwr -text "Delete Wind/Seas Radii" -anchor w \
            -command [subst ".c delete wind_radii.$nm$ts ; \
                             .c delete seas_radii.$nm$ts ; \
                     update_point_menu $x $y $nm $ts"]
      }
      pack .pmbox.plotwr -side top -fill x
      if {[.c find withtag fc_radii.$nm$ts] == ""} {
         button .pmbox.plotfcwr -text "Plot Forecast Radii" -anchor w \
            -command [subst "fc_radii_plot $nm $ts ; update_point_menu $x $y $nm $ts"]
      } else {
         button .pmbox.plotfcwr -text "Delete Forecast Radii" -anchor w \
            -command [subst ".c delete fc_radii.$nm$ts ; \
                     update_point_menu $x $y $nm $ts"]
      }
      pack .pmbox.plotfcwr -side top -fill x
      if {[file exists $stfile([string tolower $nm]).pr]} {
         if {[llength [findtags {^prob}]] == 0} {
            button .pmbox.probwr -text "Plot Probabilities" -anchor w \
               -command [subst "prob_menu $nm $ts $x $y ;
                              update_point_menu $x $y $nm $ts"]
         } else {
            button .pmbox.probwr -text "Delete Probabilities" -anchor w \
               -command "
                  foreach tag [findtags {^prob}] { .c delete \$tag }
                  update_point_menu $x $y $nm $ts
                  catch {destroy .probcolors}
                  "
         }
         pack .pmbox.probwr -side top -fill x
      } else {
         button .pmbox.probwr -text "(no probabilities data)" -anchor w \
            -state  disabled
         pack .pmbox.probwr -side top -fill x
      }
   }
   button .pmbox.history -text "Storm History" -anchor w \
   -command { draw_hist $nm }
   pack .pmbox.history -side top -fill x
   button .pmbox.clear -text "Remove from Map" -anchor w \
   -command { wipeclean $nm; destroy .pmbox }
   pack .pmbox.clear -side top -fill x
   button .pmbox.dismiss -text "Dismiss" -anchor w -command { destroy .pmbox }
   pack .pmbox.dismiss -side top -fill x

   # See if we're off-screen, and if so, fix
   ck_win_onscreen .pmbox
}



proc update_point_menu {x y nm ts} {
   if {[.c find withtag tmp_fc_lines.$nm$ts] == ""} {
      .pmbox.plotfc configure -text "Plot Forecast Positions" -anchor w \
         -command [subst "global tmp_plot ; set tmp_plot 1 ; \
                  fc_plot $nm $ts ; set tmp_plot 0 ; \
                  update_point_menu $x $y $nm $ts"]
   } else {
      .pmbox.plotfc configure -text "Delete Forecast Positions" -anchor w \
         -command [subst "nuke_fc $nm$ts ; update_point_menu $x $y $nm $ts"]
   }
   if {[.c find withtag wind_radii.$nm$ts] == ""} {
      .pmbox.plotwr configure -text "Plot Wind/Seas Radii" -anchor w \
         -command [subst "radii_plot $nm $ts ; update_point_menu $x $y $nm $ts"]
   } else {
      .pmbox.plotwr configure -text "Delete Wind/Seas Radii" -anchor w \
         -command [subst ".c delete wind_radii.$nm$ts ; \
                          .c delete seas_radii.$nm$ts ; \
                  update_point_menu $x $y $nm $ts"]
   }
   if {[.c find withtag fc_radii.$nm$ts] == ""} {
      .pmbox.plotfcwr configure -text "Plot Forecast Radii" -anchor w \
         -command [subst "fc_radii_plot $nm $ts ; update_point_menu $x $y $nm $ts"]
   } else {
      .pmbox.plotfcwr configure -text "Delete Forecast Radii" -anchor w \
         -command [subst ".c delete fc_radii.$nm$ts ; \
                  update_point_menu $x $y $nm $ts"]
   }
   if {[.c find withtag prob$nm$ts] == ""} {
      .pmbox.probwr configure -text "Plot Probabilities" -anchor w \
         -command "
            prob_menu $nm $ts $x $y
            update_point_menu $x $y $nm $ts
         "
   } else {
      .pmbox.probwr configure -text "Delete Probabilities" -anchor w \
         -command "
            .c delete prob$nm$ts
            update_point_menu $x $y $nm $ts
            catch {destroy .probcolors}
         "
   }
}


proc prob_range_menu {nm ts x y} {
   global minprob maxprob color

   catch { destroy .probcolors }
   toplevel .probcolors -background black
   wm title .probcolors "Plot Color Scale"
   wm geometry .probcolors \
   wm attributes .probcolors -topmost true
      +[winfo rootx .pmbox.detail]+[winfo rooty .pmbox.detail]

   set w .probcolors.gridf
   pack [frame $w -background black] -side top -expand y -fill x
   label $w.r1c1 -text "Red"     -foreground $color(prred)    -background black
   label $w.r2c1 -text "Orange"  -foreground $color(prorange) -background black
   label $w.r3c1 -text "Yellow"  -foreground $color(pryellow) -background black
   label $w.r4c1 -text "Blue"    -foreground $color(prblue)   -background black

   label $w.r1c2 -textvariable rtxt -foreground $color(prred)    -background black
   label $w.r2c2 -textvariable otxt -foreground $color(prorange) -background black
   label $w.r3c2 -textvariable ytxt -foreground $color(pryellow) -background black
   label $w.r4c2 -textvariable btxt -foreground $color(prblue)   -background black

   foreach row {1 2 3 4} {
      foreach col {1 2} {
         grid $w.r[subst $row]c$col -row $row -column $col -sticky w
      }
   }

   set w .probcolors

   button $w.normal -text "Use range 0--100%" \
      -command { redraw_prob "normal" $nm $ts }
   button $w.fine -text "Use range $minprob--$maxprob%" \
      -command { redraw_prob "fine" $nm $ts }
   button $w.delete -text "Delete Probabilities" -command "
            .c delete prob$nm$ts
            catch {update_point_menu $x $y $nm $ts}
            catch {destroy .probcolors}
         "
   pack $w.normal $w.fine $w.delete -side top -expand y -fill x

   # See if we're off-screen, and if so, fix
   ck_win_onscreen .probcolors
}


proc prob_menu {nm ts x y} {
   global never_mind
   set never_mind 0

   catch { destroy .prob }
   toplevel .prob
   wm title .prob "Plot Probabilities"
   wm geometry .prob +$x+$y
   wm attributes .prob -topmost true

   button .prob.t24 -text "0--24 Hours" -command {
      pr_plot $nm $ts 24 ; destroy .prob
   }
   button .prob.t36 -text "24--36 Hours" -command {
      pr_plot $nm $ts 36 ; destroy .prob
   }
   button .prob.t48 -text "36--48 Hours" -command {
      pr_plot $nm $ts 48 ; destroy .prob
   }
   button .prob.t72 -text "48--72 Hours" -command {
      pr_plot $nm $ts 72 ; destroy .prob
   }
   button .prob.ttot -text "Total:  0--72 Hours" -command {
      pr_plot $nm $ts tot ; destroy .prob
   }
   button .prob.nm -text "Never mind" -command {
      set never_mind 1
      destroy .prob
   }
   pack .prob.t24 .prob.t36 .prob.t48 .prob.t72 .prob.ttot .prob.nm -side top
   tkwait window .prob
   if {!$never_mind} { prob_range_menu $nm $ts $x $y }

   # See if we're off-screen, and if so, fix
   ck_win_onscreen .prob
}


proc nuke_fc {tag} {
   .c delete tmp_forecast.$tag
   .c delete tmp_fc_lines.$tag
}


proc tk_detail {wmtitle nm ts x y} {
   global text_font color stfile
   catch { destroy .det_tl }
   toplevel .det_tl
   wm title .det_tl $wmtitle
   wm geometry .det_tl +$x+$y
   wm attributes .det_tl -topmost true

   set w .det_tl.data
   pack [frame $w] -side top -expand y -fill x
   text $w.text -relief sunken -bd 2 -width 64 -height 20 \
      -font $text_font -yscrollcommand "$w.scroll set" \
      -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 .det_tl.nhcframe
   frame $w ; pack $w -side top -expand yes -fill x
   button $w.fc -text "Forecast/Advisory" \
      -command [subst "tk_nhc_adv_view FORECAST/ADVISORY $nm $ts"]
   button $w.adv -text "Public Advisory" \
      -command [subst "tk_nhc_adv_view ADVISORY $nm $ts"]
   button $w.dis -text "Discussion" \
      -command [subst "tk_nhc_adv_view DISCUSSION $nm $ts"]
   pack $w.fc $w.adv $w.dis -side left -expand y -fill x

   if {[file exists $stfile([string tolower $nm]).pr]} {
      button $w.prob -text "Probabilities" \
         -command [subst "tk_nhc_adv_view PROBABILITIES $nm $ts"]
      pack $w.prob -side left -expand y -fill x
   }


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

   tk_detail_puts "CURRENT DATA:"   
   tk_detail_puts ""   
   st_info $nm $ts tk_detail_puts
   tk_detail_puts "FORECAST DATA:"   
   tk_detail_puts ""   
   tk_fc_info $nm $ts
   .det_tl.data.text see 0.0

   # See if we're off-screen, and if so, fix
   ck_win_onscreen .det_tl
}


proc tk_fc_info {name timestamp} {
   global forecasts fc_tm_idx

   set name [string toupper $name]
   if {[test_st_data] == -1} return
   if {$name != "" && [test_st_data $name] == -1} return
   set timestamp [string toupper $timestamp]

   if {[array get fc_tm_idx $name$timestamp] == ""} {
      tk_detail_puts "No forecast data loaded for $name at $timestamp"
      return
   }
   set counter 0
   foreach i $fc_tm_idx($name$timestamp) {
      incr counter
      set idx "$name $timestamp $i"
      if {$counter == 4} {
tk_detail_puts "EXTENDED OUTLOOK...USE FOR GUIDANCE ONLY...ERRORS MAY BE LARGE"
         tk_detail_puts ""
      }
      set xt $forecasts($idx,xt)
      eval plot_fc_info $name $timestamp $i $forecasts($idx) $xt tk_detail_puts
   }
}


proc tk_detail_puts {args} {
   set w .det_tl.data.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 tk_nhc_adv_menu {x y nm ts} {
   set x [expr {$x + 35}]
   set y [expr {$y + 35}]
   toplevel .tkadvm
   wm geometry .tkadvm +$x+$y
   wm attributes .tkadvm -topmost true

   button .tkadvm.fc   -text "NHC Forecast/Advisory" \
      -command [subst "tk_nhc_adv_view FORECAST/ADVISORY $nm $ts ; \
               destroy .tkadvm"]
   button .tkadvm.adv  -text "NHC Advisory" \
      -command [subst "tk_nhc_adv_view ADVISORY $nm $ts ; \
               destroy .tkadvm"]
   button .tkadvm.disc -text "NHC Discussion" \
      -command [subst "tk_nhc_adv_view DISCUSSION $nm $ts ; \
               destroy .tkadvm"]
   button .tkadvm.prob -text "NHC Probabilities" \
      -command [subst "tk_nhc_adv_view PROBABILITIES $nm $ts ; \
               destroy .tkadvm"]
   button .tkadvm.quit -text "dismiss" -command {destroy .tkadvm ; return}

   pack .tkadvm.fc   -side top -fill x -expand y
   pack .tkadvm.adv  -side top -fill x -expand y
   pack .tkadvm.disc -side top -fill x -expand y
   pack .tkadvm.prob -side top -fill x -expand y
   pack .tkadvm.quit -side top -fill x -expand y

   # See if we're off-screen, and if so, fix
   ck_win_onscreen .tkadvm
}

proc tk_nhc_adv_view {type nm ts} {
   global advisory_list text_font color stfile

   catch { destroy .nhcinfo }
   set w .nhcinfo
   toplevel $w
   wm geometry $w +0+0
   wm attributes $w -topmost true
   wm title $w "NHC $type for $nm at $ts"

   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
   button $w.dismiss -text "Dismiss" -command {destroy .nhcinfo}
   pack $w.dismiss -side top
   read_advisories tk_nhc_puts $nm $type $advisory_list($nm$ts) 0
}


proc tk_nhc_puts {flist} {
   foreach line $flist { .nhcinfo.text insert end "$line\n" }
}


proc findtags {pattern} {
   set retlist [list]
   foreach point [.c find all] {
      foreach tag [.c gettags $point] {
         if {[regexp $pattern $tag]} { lappend retlist $tag }
      }
   }
   return $retlist
}


