#!/usr/local/bin/tclsh8.4
#!/usr/local/bin/tclsh8.4
#!/usr/local/bin/tclsh8.4

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


# Format for output from this script is as follows:
#
#  As a comment (one line):
#
#  1) Time (UTC)
#  2) Month Date Year (UTC)
#
# Actual information for the tracker, with spaces between fields (one line):
#
#  Tcl procedure call:  curr
#  1) Timestamp (e.g., 06/2100Z)
#  2) Storm type indicator
#     For a Hurricane:            HR
#           Tropical Storm:       TS
#           Tropical Depression:  TD
#  3) Name of storm
#  4) Latitude (e.g., 17.8) (assumed to be N)
#  5) Longitude (e.g., 84.1) (assumed to be W)
#  6) Course (degrees) Speed (Kt)  (e.g., 340 8.05 for 340 deg at 8.05 Kt)
#     XX XX implies a stationary, or almost stationary, storm
#  7) Estimated minimum central pressure (MB)
#  8) Maximum sustained winds (Kt)
#  9) ... with gusts to (Kt)
# 10) Eye diameter (miles)   XX == not given
#
# Advisory number is then stored directly in advisory_list
#
# Wind radii:
#
#  Tcl procedure call:  radii
#  1) Timestamp (same as above)
#  2) Storm name
#  3) Wind speed (mph)
#  4) Distance to NE SE SW NW (nautical miles)
#
# Forecast positions for the storm (one line per forecast position, also
# used by the tracker):
#
#  Tcl procedure call:  fc
#  1) Timestamp (same as above)
#  2) Storm name
#  3) Timestamp for forecast
#  4) Latitude (e.g., 17.8) (assumed to be N)
#  5) Longitude (e.g., 84.1) (assumed to be W)
#  6) Maximum sustained winds (Kt)
#  7) ... with gusts to (Kt)
#
#  Forecast wind radii:  same format as for current wind radii, except
#  for the additional timestamp (forecast timestamp) after the advisory
#  timestamp.
#
#  Tcl procedure call:  fc_radii

# stripzeros:  strip leading zeros from numbers (e.g., 098 --> 98)

proc stripzeros {value} {
   set retval [string trimleft $value 0]
   if {![string length $retval]} { return 0 }
   return $retval
}


proc get_newts {sttm st nhc} {
   set streg {([A-Z][A-Z][A-Z]) ([0-9][0-9]) ([12][0-9][0-9][0-9])}
   regexp $streg $st a mon stdate year
   set month [clock format [clock scan "$mon $stdate, $year"] -format %m]
   set stmon [stripzeros $month]
   set cmpstdate [stripzeros $stdate]

   if {![regexp {([0-9][0-9])([0-9][0-9])Z} $sttm a sthour stmin]} {
      regexp {([0-9][0-9])([0-9][0-9]) UTC} $sttm a sthour stmin
   }

   set st_tm [clock scan "$sthour:$stmin $st"]

   set nhcreg {([0-9][0-9])([0-9][0-9][0-9][0-9])}
   regexp $nhcreg $nhc a nhcdate nhctime
   set cmpnhcdate [stripzeros $nhcdate]

   regexp {([0-9][0-9])([0-9][0-9])} $nhctime a nhchour nhcmin

   # While not the norm, there could be an advisory that is for one
   # month (UTC) but written/updated during another month (e.g., around
   # the end/beginning of the month in the 23xxZ--00xxZ time frame).
   # It doesn't take much code or effort to handle this, so.....
   #
   # Compare the dates (both UTC) as follows:
   #    1) if the advisory date (st) and the *ACTUAL* date (nhc,
   #       from the KNHC line) are equal, it's easy....
   #    2) if st == 1 and nhc > 27:  e.g., written 31/2355Z for 01/0000Z
   #       ... use month from st, minus one.
   #    3) if st > 27 and nhc == 1:  e.g., advisory for 31/2300Z,
   #       updated 01/0100Z (not likely...but we'll handle it anyways).
   #    4) otherwise, use nhc date and st month (both are same month)

   # Same date, we're done...easy
   if {$cmpnhcdate == $cmpstdate} { return "$year$month$nhc" }

   set base [clock scan "$stmon/$cmpnhcdate/$year"]

   if {$cmpnhcdate > 27 && $cmpstdate == 1} {
      set ybase [clock scan yesterday -base $base]      ;# #2 above
      set stmon [clock format $ybase -format %m]
   } elseif {$cmpnhcdate == 1 && $cmpstdate > 27} {
      set tbase [clock scan tomorrow -base $base]       ;# #3 above
      set stmon [clock format $tbase -format %m]
   }

   # A bit of error detection.  This is to handle situations like
   # the 04/2330Z Special Forecast/Advisory for Bertha, which was
   # incorrectly dated 05Aug02 instead of 04Aug02.  Before adding
   # this test, an entry was created for 05/2330Z, followed by an
   # entry for 04/2330Z when the corrected advisory was released.
   #
   # This FAILED to work properly for the Special Forecast/Advisory
   # for Felix in 2007 (adv. number 10), which was dated correctly.
   #
#  set nhc_tm [clock scan "$nhchour:$nhcmin $nhcdate/$stmon/$year"]
#  if {[expr {abs($nhc_tm - $st_tm)}] > 21600} {
#     puts "# KNHC Line Timestamp $nhc, Advisory for $sttm $st ..."
#     puts "# ... OBVIOUS ERROR (difference greater than six hours)"
#     puts "# ... Ignoring and waiting for corrected advisory."
#     exit
#  }
   # If we get this far, we're PROBABLY OK....

   return "$year[format %02d $stmon]$nhc"
}


proc data_err {errtxt {fatal 1}} {
   if {$fatal} {
      puts "# ERROR:  $errtxt (fatal)"
      puts "lappend data_errors \"$errtxt (fatal)\""
      exit 1
   } else {
      puts "# WARNING:  $errtxt"
      puts "lappend data_errors \"$errtxt\""
   }
}

# Search for the name/status of the storm (skips headers and blank lines)

proc find_fc_data {infn outfn} {

   set found 0
   set newtimestamp ""
   set knhcreg {WTNT[0-9][0-9].KNHC.([0123][0-9][012][0-9][0-5][0-9])}
   set creg {([^ ]+)  *[^ ]* *FORECAST/ADVISORY *NUMBER *([0-9]+[A-Z]*)}
   set tdreg "^TROPICAL DEPRESSION $creg"
   set tsreg "^TROPICAL STORM $creg"
   set hrreg "^HURRICANE $creg"
   set etreg "^EXTRATROPICAL STORM $creg"
   set streg "^SUBTROPICAL STORM $creg"
   set datereg {^([0-9][0-9][0-9][0-9]Z) *[^ ]+ ([A-Z 0-9]*)}
   set dateregb {^([0-9][0-9][0-9][0-9]) UTC *[^ ]+ ([A-Z 0-9]*)}

   set f [open $infn r]
   set fout [open $outfn a]

   while {$found == 0} {

      set line [gets $f]
      if {[eof $f]} {
         puts $fout "# ERROR:  Could not find storm name. (fatal)"
         return 1
      }
      if {[regexp $knhcreg $line a t]} { set newtimestamp $t }
      if       {[regexp $tdreg $line a name advno]} { set storm_type TD
      } elseif {[regexp $tsreg $line a name advno]} { set storm_type TS
      } elseif {[regexp $hrreg $line a name advno]} { set storm_type HR
      } elseif {[regexp $etreg $line a name advno]} { set storm_type ET
      } elseif {[regexp $streg $line a name advno]} { set storm_type ST
      } elseif {[regexp $datereg $line a st_time st_date]} {
         set found 1
      } elseif {[regexp $dateregb $line a st_time st_date]} {
         set st_time ${st_time}Z
         set found 1
      }
   }

   # Find the center of the storm

   set found 0

   while {$found == 0} {
      set line [gets $f]
      if {[eof $f]} { data_err "Could not find storm position for $st_time." }
      if {[regexp {CENTER LOCATED NEAR *([^ ]+)N *([^ ]+)W AT *([0-9Z/]+)} \
                  $line a latt long timestamp]} {
         set found 1
      }
   }

   set found 0

   while {$found == 0} {
      set line [gets $f]
      if {[eof $f]} { data_err "Could not find storm movement for $st_time." }
      if {[regexp {MOVEMENT TOWARD THE .*OR *([^ ]+) DEGREES AT *([^ ]+)} \
                  $line a course sp]} {
         set speed $sp
         set found 1
      } elseif {[regexp {^PRESENT MOVEMENT} $line]} {
         set course XX
         set speed XX
         set found 1
      }
   }

   set found 0

   while {$found == 0} {
      set line [gets $f]
      if {[eof $f]} { data_err "Could not find pressure for $st_time." }
      if {[regexp {MINIMUM CENTRAL PRESSURE *([^ ]+)} $line a pressure]} {
         set found 1
      }
   }

   set found 0

   set eye_diameter XX
   while {$found == 0} {
      set line [gets $f]
      if {[eof $f]} { data_err "Could not find wind info." }
      if {[regexp {EYE DIAMETER *([0-9]+) NM} $line a eye]} {
         set eye_diameter $eye
      } elseif {[regexp \
               {MAX SUSTAINED WINDS *([^ ]+) KT WITH GUSTS TO *([^ ]+) KT} \
               $line a wnd gst]} {
         set winds $wnd
         set gusts $gst
         set found 1
      }
   }

   # print the data to the standard output

   if {$newtimestamp != ""} {
      set newts [get_newts $st_time $st_date $newtimestamp]
      # New format for data files: basically, we add a timestamp that we
      # can sort by.  But, we also use a different proc so we can handle
      # it differently within the tracker.

      puts -nonewline $fout "newtrk $newts $timestamp $storm_type $name $latt $long "
      puts $fout "$course $speed $pressure $winds $gusts $eye_diameter"
      puts $fout "set advisory_list($name$timestamp) \"$advno\""
   } else {
      puts $fout "# Valid (KNHC line) timestamp not found ... using old format"
      puts $fout "# for $st_time $st_date"

      puts -nonewline $fout "curr $timestamp $storm_type $name $latt $long "
      puts $fout "$course $speed $pressure $winds $gusts $eye_diameter"
      puts $fout "set advisory_list($name$timestamp) \"$advno\""
   }

   # From this point, the procs called from the .trk file simply store
   # stuff to variables...so they're OK as is.

   set found 0


   while {$found == 0} {
      set line [gets $f]
      if {[eof $f]} {
         data_err "Could not find wind radii info for $st_time." 0
         set found 1
      }
      if {[regexp "REPEAT.*CENTER LOCATED" $line]} {
         set found 1
      } elseif {[regexp \
         {^([0-9]+) KT[^0-9]+([^ ]+)NE *([^ ]+)SE *([^ ]+)SW *([^ ]+)NW} \
               $line a wnd ne se sw nw]} {
         puts $fout "radii $timestamp $name $wnd $ne $se $sw $nw"
      } elseif {[regexp \
         {^12 FT SEAS[^0-9]*([0-9]+)NE *([0-9]+)SE *([0-9]+)SW *([0-9]+)NW} \
               $line a seas_ne seas_se seas_sw seas_nw]} {
         puts $fout "twlv_ft_seas $timestamp $name $seas_ne $seas_se $seas_sw $seas_nw"
      } elseif {[regexp "ALL QUADRANT RADII" $line]} {
         set found 1
      }
   }


   # find the forecast positions for the storm---print this as a new line
   # for each forecast position.

   set found 0
   while {$found == 0} {
      set line [gets $f]
      if {[eof $f]} { set found 1 }
      if {[regexp {FORECAST VALID *([^ ]+) *([^ ]+)N *([^ ]+)W} \
                  $line a fc_ts fc_latt fc_long]} {
         set extratropical 0
         set subtropical 0
         set remlow 0
         if {[regexp EXTRATROPICAL $line]} { set extratropical 1 }
         if {[regexp SUBTROPICAL $line]} { set subtropical 1 }
         if {[regexp "REMNANT LOW" $line]} { set remlow 1 }
         set line [gets $f]
         if {[regexp {MAX WIND *([^ ]+) *KT.*GUSTS *([^ ]+) *KT} \
                     $line a fc_wind fc_gusts]} {
            puts -nonewline $fout "fc $name $timestamp $fc_ts $fc_latt $fc_long "
            if {$extratropical} {
               puts $fout "$fc_wind $fc_gusts EXTRATROPICAL"
            } elseif {$subtropical} {
               puts $fout "$fc_wind $fc_gusts SUBTROPICAL"
            } elseif {$remlow} {
               puts $fout "$fc_wind $fc_gusts REMLOW"
            } else {
               puts $fout "$fc_wind $fc_gusts"
            }
         }
      } elseif {[regexp {OUTLOOK VALID *([^ ]+) *([^ ]+)N *([^ ]+)W} \
                  $line a fc_ts fc_latt fc_long]} {
         set extratropical 0
         set subtropical 0
         set remlow 0
         if {[regexp EXTRATROPICAL $line]} { set extratropical 1 }
         if {[regexp SUBTROPICAL $line]} { set subtropical 1 }
         if {[regexp "REMNANT LOW" $line]} { set remlow 1 }
         set line [gets $f]

         if {[regexp {MAX WIND *([^ ]+) *KT.*GUSTS *([^ ]+) *KT} \
                     $line a fc_wind fc_gusts]} {

            puts -nonewline $fout "fc $name $timestamp $fc_ts $fc_latt $fc_long "
            if {$extratropical} {
               puts $fout "$fc_wind $fc_gusts EXTRATROPICAL"
            } elseif {$subtropical} {
               puts $fout "$fc_wind $fc_gusts SUBTROPICAL"
            } elseif {$remlow} {
               puts $fout "$fc_wind $fc_gusts REMLOW"
            } else {
               puts $fout "$fc_wind $fc_gusts"
            }
         }
      } elseif {[regexp \
         {^([0-9]+) KT[^0-9]+([^ ]+)NE *([^ ]+)SE *([^ ]+)SW *([^ ]+)NW} \
               $line a wnd ne se sw nw]} {
         puts $fout "fc_radii $timestamp $fc_ts $name $wnd $ne $se $sw $nw"
      }
   }

   close $f
   close $fout
}



