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

# This file contains procedures which plot/remove points on the chart,
# handle the wind radii, etc.

array set storm_x {}
array set storm_y {}
set lastx 0
set lasty 0
set plot_all 0
set tmp_plot 0

proc offmap_arrow {x y name} {
   global color plot_err
   set ex2 $x ; set ey2 $y
   switch $plot_err {
       1 { set ey2 [expr {$y + 20}] }
       2 { if {$y < 20} { set y 20 } ; set ey2 [expr {$y - 20}] }
       3 { set ex2 [expr {$x + 20}] }
       4 { if {$x < 20} { set x 20 } ; set ex2 [expr {$x - 20}] }
      11 { set ey2 [expr {$y + 20}] ; set ex2 [expr {$x + 20}] }
      12 {
         set ey2 [expr {$y + 20}]
         if {$x < 20} { set x 20 }
         set ex2 [expr {$x - 20}]
         }
      13 {
         if {$y < 20} { set y 20 }
         set ey2 [expr {$y - 20}]
         set ex2 [expr {$x + 20}]
         }
      14 { if {$x < 20} { set x 20 } ; set ex2 [expr {$x - 20}] }
   }

   set item [.c create line $x $y $ex2 $ey2 -arrow last \
      -fill $color(invalidxy) -width 5 -arrowshape {10 10 10}]
   addtags $item arrow.$name wipeme$name wipeme
}


proc plot_hrdot {flg x y name cat {tmp_plot 0} {ts ""}} {
   global color
   set x1 [expr {$x - 4}] ; set y1 [expr {$y - 4}]
   set x2 [expr {$x + 4}] ; set y2 [expr {$y + 4}]
   set x3 [expr {$x + 8}] ; set y3 [expr {$y - 8}]
   switch $flg {
      "CURRENT"  { set dc $color(hrdot) ; set lc $color(b3box) }
      "FORECAST" { set dc $color(fcdot) ; set lc $color(fcline) }
      "OUTLOOK"  { set dc $color(b3box) ; set lc $color(b3box) }
   }

   set item [.c create oval $x1 $y1 $x2 $y2 -width 1 -outline black -fill $dc]
   addtags $item raise_curr
   set item2 [.c create text $x3 $y3 -width 1 -text "$cat" -fill $lc]
   addtags $item2 pt_txt.$name wipeme$name wipeme
   if {$tmp_plot} { addtags $item2 tmp_forecast.$name tmp_forecast.$name$ts }
   return $item
}


proc plot_tsdot {flg x y} {
   global color
   set x1 [expr {$x - 4}] ; set y1 [expr {$y - 4}]
   set x2 [expr {$x + 4}] ; set y2 [expr {$y + 4}]
   switch $flg {
      "CURRENT"  { set dc $color(tsdot) ; set lc $color(b3box) }
      "FORECAST" { set dc $color(fcdot) ; set lc $color(fcline) }
      "OUTLOOK"  { set dc $color(b3box) ; set lc $color(b3box) }
   }
   set item [.c create rectangle $x1 $y1 $x2 $y2 -width 1 \
      -outline black -fill $dc]
   return $item
}


proc plot_tddot {flg x y} {
   global color

   set x1 [expr {$x - 6}] ; set y1 [expr {$y - 6}]
   set x2 [expr {$x + 6}] ; set y2 [expr {$y + 6}]

   switch $flg {
      "CURRENT"  { set dc $color(tddot) ; set lc $color(b3box) }
      "FORECAST" { set dc $color(fcdot) ; set lc $color(fcline) }
      "OUTLOOK"  { set dc $color(b3box) ; set lc $color(b3box) }
   }
   set item [.c create polygon $x $y1 $x1 $y2 $x2 $y2 -width 1 \
      -outline black -fill $dc]
   return $item
}


# This procedure plots the forecast position for a storm (name) from
# a given NHC advisory (timestamp) at time fc_ts.

proc fc_plot_tk {nm ts fc_ts fc_latt fc_long fc_winds fc_gusts outlook {xt 0}} {
   global lastx lasty tmp_plot storm_x storm_y libdir color altprint

   set nm [string toupper $nm]
   set ts [string toupper $ts]
   set fc_ts [string toupper $fc_ts]

   if {[valid_coords $fc_latt $fc_long] == 0} { return }
   set x [set_long $fc_long]
   set y [set_latt $fc_latt]

   set x1 [expr {$x - 4}] ; set y1 [expr {$y - 4}]
   set x2 [expr {$x + 4}] ; set y2 [expr {$y + 4}]

   if {$outlook} {
      set flag OUTLOOK
      set use_color $color(b3box)
      if {$altprint} { set use_color black }
      set fcline_color $use_color
      set fcdot_color $use_color
   } else {
      set flag FORECAST
      set fcline_color $color(fcline)
      set fcdot_color $color(fcdot)
   }

   set item [.c create line [expr {$lastx + 2}] [expr {$lasty - 2}] $x $y \
      -fill $fcline_color -width 1.5]

   set tag fc_lines.$nm
   if {$tmp_plot} { set tag tmp_fc_lines.$nm$ts }
   addtags $item raiseline $tag wipeme wipeme$nm

   catch { .c itemconfigure $tag -state disabled }

   set lastx $x ; set lasty $y

   if       {$fc_winds >= 64} { set item [plot_hrdot $flag $x $y $nm \
                                            [st_cat $fc_winds] $tmp_plot $ts] ; set type HR
   } elseif {$xt == 1} {
      set item [.c create text $x $y -text "X" -fill $color(b3box)]
      set type ET
   } elseif {$xt == 2} {
      set item [.c create text $x $y -text "S" -fill $color(b3box)]
      set type ST
   } elseif {$xt == 3} {
      set item [.c create text $x $y -text "(LOW)" -fill $color(b3box)]
      set type RL
   } elseif {$fc_winds >= 34} { set item [plot_tsdot $flag $x $y] ; set type TS
   } else                     { set item [plot_tddot $flag $x $y] ; set type TD
   }
   addtags $item raisept wipeme wipeme$nm ID.$type.$nm.$fc_ts
   if {$tmp_plot} { addtags $item tmp_forecast.$nm tmp_forecast.$nm$ts
   } else {         addtags $item forecast.$nm
   }
   .c raise raisept
   set fclvl 1
   if {$outlook} { set fclvl 2}
   if {$type == "HR"} {
      .c bind ID.$type.$nm.$fc_ts <Enter> "pr_storm_id $type $nm $fc_ts [st_cat $fc_winds] $fclvl"
   } else {
      .c bind ID.$type.$nm.$fc_ts <Enter> "pr_storm_id $type $nm $fc_ts {} $fclvl"
   }
   .c bind ID.$type.$nm.$fc_ts <Leave> {
      set ptrstormid ""
      .ptrloc.l3 configure -foreground black -background #d9d9d9
   }
}


# This procedure plots the current position for (name) given in the
# NHC advisory (ts).

proc curr_plot {ts type name latt long course speed press winds gusts cat} {
   global lastx lasty plot_all storm_x storm_y plot_err color ptrstormid

   set name [string toupper $name]
   set ts [string toupper $ts]

   set x [set_long $long] ; set lastx $x
   set y [set_latt $latt] ; set lasty $y

   if {[valid_coords $latt $long] == 0} {
      offmap_arrow $x $y $name
   } else {
      if       {$type == "HR"} { set item [plot_hrdot CURRENT $x $y $name $cat]
      } elseif {$type == "TS"} { set item [plot_tsdot CURRENT $x $y]
      } elseif {$type == "ET"} { set item [.c create text $x $y -text "X" \
                                             -fill $color(b3box)]
      } elseif {$type == "ST"} { set item [.c create text $x $y -text "S" \
                                             -fill $color(b3box)]
      } else                   { set item [plot_tddot CURRENT $x $y]
      }
      addtags $item point.$name raisept $name$ts wipeme wipeme$name point \
         ID.$type.$name.$ts
      if {$type == "HR"} {
         .c bind ID.$type.$name.$ts <Enter> "pr_storm_id $type $name $ts $cat"
      } else {
         .c bind ID.$type.$name.$ts <Enter> "pr_storm_id $type $name $ts {}"
      }
      .c bind ID.$type.$name.$ts <Leave> {
         set ptrstormid ""
         .ptrloc.l3 configure -foreground black -background #d9d9d9
      }
   }
   set storm_x($name$ts) "$x"
   set storm_y($name$ts) "$y"
}


proc pr_storm_id {type name ts cat {forecast 0}} {
   global ptrstormid color
   set fctxt ""
   if {$forecast == 1} { set fctxt " FORECAST POSITION" }
   if {$forecast == 2} { set fctxt " FORECAST POSITION" } ;# per NHC PAO
   if {$type == "HR"} {
      set ptrstormid "Cat $cat $type $name ($ts)$fctxt"
   } else {
      set ptrstormid "$type $name ($ts)$fctxt"
   }
#  if       {$type == "HR"} { set c $color(tsdot)
#  } elseif {$type == "TS"} { set c $color(tsdot)
#  } elseif {$type == "TD"} { set c $color(tddot)
#  } else                   { set c white
#  }
   .ptrloc.l3 configure -foreground $color(tsdot) -background black
}


# This procedure is called from wipeclean, and deletes those portions
# of the data that only apply when in the Tk version of the tracker.

proc tk_wipe {{name ""}} {
   global lastx lasty storm_x storm_y

   if {$name == ""} {
      catch { unset storm_x } ; array set storm_x {}
      catch { unset storm_y } ; array set storm_y {}
      set lastx 0 ; set lasty 0
      .c delete wipeme
      foreach i [winfo children .warnframe] { catch { destroy $i } }
      set nil .warnframe.nil ; label $nil ; pack $nil ; update ; destroy $nil
   } else {
      set idx "$name*"
      foreach i [array names storm_x "$idx"]  { unset storm_x($i) }
      foreach i [array names storm_y "$idx"]  { unset storm_y($i) }
      set lastx 0 ; set lasty 0
      .c delete wipeme$name
      set nm [string tolower $name]
      catch {
         destroy .warnframe.$nm
         set nil .warnframe.nil
         label $nil ; pack $nil ; update ; destroy $nil
      }
   }
   handle_resize 1
}


proc clear_ww {name} {
   global watchwarn

   if {[info exists watchwarn($name)]} {
      set idx $watchwarn($name)
      catch { unset watchwarn($name:$idx) }
      catch { unset watchwarn($name) }
      set tlist [list]
      foreach idx $watchwarn() {
         if {[string compare $idx $name]} { lappend tlist $idx }
         set watchwarn() $tlist
      }
   }
}


# This proc doesn't actually plot anything anymore.  What it DOES
# do is populate the watchwarn() array with the data for $name at
# $timestamp.

proc plot_watchwarn {name timestamp} {
   global storms bplist wwidx watchwarn
   global advisory_list stfile

   set idnum 1

# Get the contents of the FORECAST/ADVISORY file for $name
   set fn $storms/[string tolower $name].fc
   set path $stfile([string tolower $name])
   if {[string first old  $path] >= 0} { return } ;# old storm/no warnings
   if {![file exists $fn]} { return }
   set f [open $fn r]
   set flist [split [read $f] \n]
   close $f

# Find the LAST advisory by timestamp

   set len [llength $flist]
   set found 0
   # find the actual last advisory, even if the .fc file is out of order
   # for some reason (e.g., when you backfill missing advisories)

   set trgt "ADVISORY NUMBER  *$advisory_list([string toupper $name]$timestamp)"
   for {set i $len} {$i >= 0 && !$found} {incr i -1} {
      set line [lindex $flist $i]
      if {[regexp $trgt $line]} {
         set idx $i ; set found 1
      }
   }

# Grab any watch/warning data

   if {[lsearch -exact $watchwarn() $name] >= 0} {
      if {[info exists watchwarn($name)]} {
         set ts $watchwarn($name)
         set watchwarn($name:$ts) ""
         set watchwarn($name) $timestamp
      }
   } else {
      lappend watchwarn() $name
      set watchwarn($name) $timestamp
   }
   set done 0
   set indata 0
   for {set i $i} {$i <= $len && !$done} {incr i} {
      set line [lindex $flist $i]

      set trgt "ALL WATCHES AND WARNINGS HAVE BEEN DISCONTINUED"
      if {[string first $trgt $line] >= 0} { clear_ww $name ; return }

      set trgt "SUMMARY OF WATCHES AND WARNINGS IN EFFECT"
      if {[string first $trgt $line] >= 0} { set indata 1 }

      if {[regexp  {A .* WA.* MEANS THAT} $line]} {
         set done 1 ; set indata 0
      }

      set noww "THERE ARE NO COASTAL WATCHES OR WARNINGS IN EFFECT."
      if {[string first $noww $line] >= 0} { clear_ww $name ; return }

      set noww "THERE ARE NO COASTAL WATCHES AND WARNINGS IN EFFECT."
      if {[string first $noww $line] >= 0} { clear_ww $name ; return }

      if {$indata && [string compare $line NONE] == 0} {
         clear_ww $name ; return
      }

      if {[regexp  "CENTER LOCATED NEAR.*$timestamp" $line]} {
         set done 1 ; set indata 0
      }
      if {[string compare $line {$$}] == 0} { set done 1 ; set indata 0 }

      # We will still see the SUMMARY line and add it here
      if {$indata} {
         lappend watchwarn($name:$timestamp) [lindex $flist $i]
      }


      if {$done} { continue } ;# this should never be true
   }
}

# This procedure plots the latest forecast positions and wind radii
# for (name).

proc plot_last {name} {
   global st_times auto_fc auto_radii plot_err newtrk_used

#  if {$newtrk_used} { newtrk_curr }

   set name [string toupper $name]
   set tmplist [split "$st_times($name)"]
   set timestamp [lindex $tmplist end]
   plot_watchwarn $name $timestamp
   check_ww

   if {$auto_radii && !$plot_err} { radii_plot $name $timestamp }
   if {$auto_fc} { fc_plot $name $timestamp }
   if {$auto_radii && $auto_fc} { fc_radii_plot $name $timestamp }
   test_prox $name $timestamp
}


# This procedure plots the forecast positions for (name) given in the
# NHC advisory from (timestamp).

proc fc_plot {name timestamp} {
   global forecasts fc_tm_idx lastx lasty storm_x storm_y

   set name [string toupper $name]
   set timestamp [string toupper $timestamp]

   set lastx $storm_x($name$timestamp)
   set lasty $storm_y($name$timestamp)

   set counter 0 ; set outlook 0
   if {[array get fc_tm_idx $name$timestamp] != ""} {
      foreach i $fc_tm_idx($name$timestamp) {
         incr counter
         if {$counter == 4} { set outlook 1 }
         set idx "$name $timestamp $i"
         set xt $forecasts($idx,xt)
         eval fc_plot_tk $name $timestamp $i $forecasts($idx) $outlook $xt
      }
   }
}


# This procedure plots the wind radii for the storm (nm) given by the
# NHC advisory (ts), where nm is the name of the storm, and ts is the
# timestamp of the advisory.

proc radii_plot {nm ts} {
   global stradii stradii_seas color

   set nm [string toupper $nm]
   set ts [string toupper $ts]

   foreach idx [array get stradii $nm$ts*] {
      if {[regexp ".+/\[0-9]+Z(\[0-9]+)" $idx a w] == 1} {
         set item [eval .c create line [calc_radii $ts $nm $w] \
                        -smooth true -width 1.5 -splinesteps 100]
         if {$w >= 64} { .c itemconfigure $item -fill $color(hrwind)
         } else        { .c itemconfigure $item -fill $color(tswind)
         }
         addtags $item wind_radii wind_radii.$nm wind_radii.$nm$ts \
                 wind_radii.$nm$ts$w wipeme wipeme$nm
#        catch { .c itemconfigure $item -state disabled }
         .c raise raise_curr wind_radii
      }
   }
   # Handle 12' seas ... if the data is there.
   set found ""
   catch { set found $stradii_seas($nm${ts}12) }
   if {$found != ""} {
      set item [eval .c create line [calc_radii $ts $nm 12 0 0 1] \
                     -smooth true -width 1.5 -splinesteps 100]
      .c itemconfigure $item -fill $color(12ft)
      addtags $item seas seas_radii.$nm seas_radii.$nm$ts wipeme wipeme$nm
#     catch { .c itemconfigure $item -state disabled }
      .c raise raise_curr seas
   }
}


# This procedure plots the forecast wind radii for the storm (nm) given
# by the NHC advisory (ts), where nm is the name of the storm, and ts is
# the timestamp of the advisory.

proc fc_radii_plot {nm ts} {
   global fc_stradii color

   set nm [string toupper $nm]
   set ts [string toupper $ts]

   foreach idx [array get fc_stradii $nm$ts*] {
      if {[regexp ".+/\[0-9]+Z(.+/\[0-9]+Z)(\[0-9]+)" $idx a fcts w]} {
         set xylist [calc_radii $ts $nm $w 1 $fcts]
         if {[llength $xylist] == 0} { continue } ;# 14 Sep 1999 (was return)
         set item [eval .c create line $xylist -smooth true \
                        -splinesteps 8 -width 1.5]
         if {$w >= 64} { .c itemconfigure $item -fill $color(hrwind)
         } else        { .c itemconfigure $item -fill $color(tswind)
         }
         addtags $item fc_radii fc_radii.$nm fc_radii.$nm$ts wipeme \
                       fc_radii.$nm$ts$fcts$w wipeme$nm
#        catch { .c itemconfigure $item -state disabled }
      }
   }
   catch { .c raise raise_curr fc_radii }
}


# This procedure calculates the actual positions on the chart to plot
# for the wind radii.  This is *WAY* too slow to calculate until we
# need it, so we don't....

proc calc_radii {timestamp name winds {use_fc 0} {fcts 0} {seas 0}} {
   global stradii_seas

   set name [string toupper $name]
   set timestamp [string toupper $timestamp]

   set latt [get_st_latt $name $timestamp]
   if {$latt == -1} { return } ;# storm data for this name/ts not present

   if {!$use_fc} {
      set long [get_st_long $name $timestamp]
      if {!$seas} {
         set radlist [get_st_radii $name $timestamp $winds]
      } else {
         set radlist $stradii_seas($name$timestamp$winds)
      }
   } else {
      set latt [get_fc_latt $name $timestamp $fcts]
      set long [get_fc_long $name $timestamp $fcts]
      if {[valid_coords $latt $long] == 0} { return }
      set radlist [get_fc_radii $name $timestamp $fcts $winds]
   }

   if {[llength $radlist] == 0} { return }
   foreach {trash ne se sw nw} $radlist { break }

   set diff [convert_radii $ne]
   set x1 [set_long [expr {$long - $diff}]]
   set y1 [set_latt [expr {$latt + $diff}]]

   set diff [convert_radii $se]
   set x2 [set_long [expr {$long - $diff}]]
   set y2 [set_latt [expr {$latt - $diff}]]

   set diff [convert_radii $sw]
   set x3 [set_long [expr {$long + $diff}]]
   set y3 [set_latt [expr {$latt - $diff}]]

   set diff [convert_radii $nw]
   set x4 [set_long [expr {$long + $diff}]]
   set y4 [set_latt [expr {$latt + $diff}]]

   return [list $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4 $x1 $y1]
}


# Called by Tk (or user) to plot probabilities as a swath
proc pr_plot {name timestamp delay} {
   global plot_ts plot_fctime storms problist minprob maxprob

   set name [string tolower $name]
   set plot_ts [string toupper $timestamp]
   set plot_fctime $delay
   set problist [list]
   set minprob 100
   set maxprob 0
   if {[file exists $storms/$name.pr]} {
      source $storms/$name.pr
   } else {
      if {[catch {set file [glob $storms/*/$name.pr]}] == 0} {
         source $file
      } else {
         bgerror "$storms/$name.pr does not exist!"
         return
      }
   }

   if {[llength $problist] == 0} {
      tk_messageBox -type ok -message "No probability data found"
      return
   }

   set_prob_colors normal

   foreach sublist $problist {
      foreach {name timestamp latt long pr} $sublist {
         do_plot_prob $name $timestamp $latt $long $pr
      }
   }
}


# This procedure is called when storm_name.pr is sourced---it plots the
# requested data, and ignores the rest.

proc prob_plot {name timestamp latt long pr24 pr36 pr48 pr72 prtot} {
   global plot_ts plot_fctime problist minprob maxprob

   if {[string compare $timestamp $plot_ts]} { return }

   if       {[string compare $plot_fctime "24"]  == 0} { set pr $pr24
   } elseif {[string compare $plot_fctime "36"]  == 0} { set pr $pr36
   } elseif {[string compare $plot_fctime "48"]  == 0} { set pr $pr48
   } elseif {[string compare $plot_fctime "72"]  == 0} { set pr $pr72
   } elseif {[string compare $plot_fctime "tot"] == 0} { set pr $prtot
   }
   if {[string compare $pr "X"] == 0} { return }

   lappend problist [list $name $timestamp $latt $long $pr]
   if {$pr < $minprob} { set minprob $pr }
   if {$pr > $maxprob} { set maxprob $pr }
}


# This does the actual plotting....

proc do_plot_prob {nm ts latt long prob} {
   global storm_x storm_y redmin orangemin yellowmin color

   set nm [string toupper $nm]
   set stx $storm_x($nm$ts)  ;  set sty $storm_y($nm$ts)

   set x [set_long $long]
   set y [set_latt $latt]
   set x1 [expr {$x - 4}] ; set y1 [expr {$y - 4}]
   set x2 [expr {$x + 4}] ; set y2 [expr {$y + 4}]
   set y3 [expr {$y + 12}]

# This is about as close to the NHC display's colors as I can get....

   if {$prob >= $redmin} { set tmpcolor $color(prred)
   } elseif {$prob >= $orangemin} { set tmpcolor $color(prorange)
   } elseif {$prob >= $yellowmin} { set tmpcolor $color(pryellow)
   } else { set tmpcolor $color(prblue)
   }

   set item [.c create polygon $x $y1 $x1 $y2 $x $y3 $x2 $y2 -width 1 \
            -outline black -fill $tmpcolor]
   set item2 [.c create text [expr {$x + 8}] [expr {$y - 8}] \
            -fill $color(b3box) -text "$prob"]
   set item3 [.c create line $x $y $stx $sty -fill $tmpcolor -width 1.5]

   foreach tag [list $item $item2 $item3] { addtags $tag wipeme prob$nm$ts }
}


# Test the distance between home coordinates and the current position,
# as well as the distance between home and the forecast track.  If less
# than $warn_at_nm nm, sound alarm.

proc test_prox {name timestamp} {
   global fc_tm_idx storm_x storm_y warn_at_nm stfile

   set path $stfile([string tolower $name])
   if {[string first old  $path] >= 0} {
      if {[regexp {^old/([12][0-9][0-9][0-9])/} $path a year]} {
         set year "$year/"
      } else { set year ""
      }
   } else { set year ""
   }

   # Normal
   set nm [string tolower $name]
   catch { destroy .warnframe.$nm }

   set type [get_st_type $name $timestamp]
   if {$type == -1} { set type "" }

   pack [label .warnframe.$nm -text "" ] -side left -expand y -fill x
   .warnframe.$nm configure -foreground #ffffff -background #0000b0
   if {[string compare $type "HR"] == 0} {
      set ctmp [get_st_cat $name $year$timestamp]
      .warnframe.$nm configure -text "$ctmp $type $name ($year$timestamp)"
   } else {
      .warnframe.$nm configure -text "$type $name ($year$timestamp)"
   }

   if {[info exists warn_at_nm] == 0} { set warn_at_nm 60 }
   set name [string toupper $name]
   set timestamp [string toupper $timestamp]

   set ptlastx $storm_x($name$timestamp)
   set ptlasty $storm_y($name$timestamp)
   set x1 $ptlastx  ;  set y1 $ptlasty
   if {[test_range $x1 $y1 $x1 $y1]} {
      prox_warning CURRENT $type $name $timestamp
      return
   }

   if {[array get fc_tm_idx $name$timestamp] != ""} {
      foreach i $fc_tm_idx($name$timestamp) {
         set latt [get_fc_latt $name $timestamp $i]
         set long [get_fc_long $name $timestamp $i]
         set fctm $i
         set x1 $ptlastx          ;  set y1 $ptlasty
         set x2 [set_long $long]  ;  set y2 [set_latt $latt]
         if {[test_range $x1 $y1 $x2 $y2]} {
            prox_warning FORECAST $type $name $timestamp $fctm
         }
         set ptlastx $x2
         set ptlasty $y2
      }
   }
}


# This does the actual work for the test.

proc test_range {x1 y1 x2 y2} {
   global home_latt home_long  ;# latt/long for home coordinates
   global warn_at_nm           ;# distance (in nm) to sound alarm at
   global map_specs

   if {[info exists home_latt] == 0 || [info exists home_long] == 0 || \
       [info exists warn_at_nm] == 0} { return 0 }

   set alarm 0
   set home_x [set_long $home_long]
   set home_y [set_latt $home_latt]
   set min $map_specs(min)
   set dxy $map_specs(dxy)

   if {$warn_at_nm < $min} { set warn_at_nm $min }
   set range [expr {round($dxy * double($warn_at_nm / $min))}]

   .c create line $x1 $y1 $x2 $y2 -tags TEST
   .c addtag HIT closest $home_x $home_y $range
   foreach i [.c gettags TEST] {
      if {[string compare $i "HIT"] == 0} { set alarm 1 ; break }
   }

   .c delete withtag TEST   ;# delete the temporary line
   .c dtag HIT HIT          ;# delete the HIT tags

   if {$alarm} { return 1 }
   return 0
}


# Globals here must mirror prox_warning below
proc test_prox_warning_progs {cmd} {
   global warn_at_nm current_prog forecast_prog

   if {[catch { eval exec $cmd } msg]} {
      tk_messageBox -type ok -message $msg
   }
}


# Globals here must be mirrored in test_prox_warning_progs above
proc prox_warning {when type name timestamp {fctm ""}} {
   global warn_at_nm current_prog forecast_prog

   set nm [string tolower $name]
   if {[string compare $type "HR"] == 0} {
      set ctmp "[get_st_cat $name $timestamp] "
   } else {
      set ctmp ""
   }
   if {$when == "CURRENT"} {
      # Red alarm
      .warnframe.$nm configure -foreground #ffffff -background #c70000
      .warnframe.$nm configure \
         -text "$ctmp$type $name now within $warn_at_nm nm! ($timestamp)"
      if {[info exists current_prog] && $current_prog != ""} {
         catch { eval exec $current_prog }
      }
   } elseif {$when == "FORECAST"} {
      # Yellow alarm
      .warnframe.$nm configure -foreground #000000 -background #f6c300
      .warnframe.$nm configure -text \
         "$ctmp$type $name forecast to come within $warn_at_nm nm! ($timestamp)"
      if {[info exists forecast_prog] && $forecast_prog != ""} {
         catch { eval exec $forecast_prog }
      }
   }
}


proc set_prob_colors {mode} {
   global redmin orangemin yellowmin rtxt otxt ytxt btxt minprob maxprob

   if {$mode == "normal"} {
      set redmin 99
      set orangemin 50
      set yellowmin 20
   } else {
      set redmin [expr {int($maxprob - (0.1 * ($maxprob - $minprob)))}]
      set inc [expr {int(($redmin - $minprob)/3)}]
      set yellowmin [expr {$minprob + $inc}]
      set orangemin [expr {$minprob + ($inc * 2)}]
#     set redmin [expr {$minprob + ($inc * 3)}]
   }

   set rtxt "$redmin% or higher"
   set otxt "$orangemin% to $redmin%"
   set ytxt "$yellowmin% to $orangemin%"
   set btxt "less than $yellowmin%"
}


proc redraw_prob {mode nm ts} {
   global problist

   .c delete prob$nm$ts
   set_prob_colors $mode
   foreach sublist $problist {
      foreach {name timestamp latt long pr} $sublist {
         do_plot_prob $name $timestamp $latt $long $pr
      }
   }
}

