1# JStrack: copyright 1997/2010 by Jim Graham, N5IAL, all rights reserved. 2# 3 4# Replaced by mods to track.tk...doing it right! 5# bind Entry <Delete> { tkEntryBackspace %W } 6 7proc tk_st_data {} { 8 global advisory_list storms units 9 10 catch { destroy .stdata } 11 set w .stdata 12 toplevel $w 13 wm title $w "Manually-entered storm data" 14 wm geometry $w +0+0 15 wm attributes $w -topmost true 16 17 set w .stdata.type 18 frame $w -bd 2 -relief sunken 19 pack $w -side top -fill x 20 21 set tksttype "" 22 radiobutton $w.td -text "Tropical Depression" -variable tksttype -value "TD" 23 radiobutton $w.ts -text "Tropical Storm" -variable tksttype -value "TS" 24 radiobutton $w.hr -text "Hurricane" -variable tksttype -value "HR" 25 label $w.nmlbl -text Name: 26 entry $w.name -width 20 ; set entry_name $w.name 27 pack $w.td $w.ts $w.hr -side left 28 pack $w.name -side right -anchor e 29 pack $w.nmlbl -side right -anchor e 30 31 set w .stdata.dat1 32 frame $w -bd 2 -relief sunken 33 pack $w -side top -fill x 34 35 label $w.tslbl -text "Timestamp (UTC):" 36 entry $w.ts -width 9 ; set entry_timestamp $w.ts 37 button $w.tshelp -text "?" -command { tk_timestamp_menu } 38 label $w.adlbl -text "NHC Advisory Number (if available):" 39 entry $w.advno -width 4 ; set entry_advno $w.advno 40 41 pack $w.tslbl $w.ts $w.tshelp -side left -anchor w 42 pack $w.advno -side right -anchor e 43 pack $w.adlbl -side right -anchor e 44 45 set w .stdata.dat2 46 frame $w -bd 2 -relief sunken 47 pack $w -side top -fill x 48 49 set w .stdata.dat2.info 50 frame $w 51 pack $w -side top 52 label $w.infotxt -text \ 53 "For a stationary storm, do not enter any course or speed" 54 pack $w.infotxt -side top 55 56 set w .stdata.dat2.work 57 frame $w 58 pack $w -side top -fill x -expand 1 59 60 frame $w.ltfr ; set fr $w.ltfr 61 label $fr.ltlbl -text Latitude: 62 entry $fr.latt -width 5 ; set entry_latt $fr.latt 63 label $fr.ltlb2 -text N 64 pack $fr.ltlbl $fr.latt $fr.ltlb2 -side left 65 pack $fr -side left -anchor w -expand 1 66 67 frame $w.lnfr ; set fr $w.lnfr 68 label $fr.lnlbl -text Longitude: 69 entry $fr.long -width 5 ; set entry_long $fr.long 70 label $fr.lnlb2 -text W 71 pack $fr.lnlbl $fr.long $fr.lnlb2 -side left 72 pack $fr -side left -expand 1 73 74 frame $w.crfr ; set fr $w.crfr 75 label $fr.crlbl -text "Course (deg):" 76 entry $fr.course -width 5 ; set entry_course $fr.course 77 button $fr.crhelp -text "?" -command { tk_course_menu } 78 pack $fr.crlbl $fr.course $fr.crhelp -side left 79 pack $fr -side left -expand 1 80 81 frame $w.spfr ; set fr $w.spfr 82 label $fr.splbl -text "Speed ($units):" 83 entry $fr.speed -width 3 ; set entry_speed $fr.speed 84 pack $fr.splbl $fr.speed -side left 85 pack $fr -side right -anchor e -expand 1 86 87 set w .stdata.dat3 88 frame $w -bd 2 -relief sunken 89 pack $w -side top -fill x -expand 1 90 91 frame $w.wndfr ; set fr $w.wndfr 92 label $fr.lbl -text "Max. winds ($units):" 93 entry $fr.ent -width 3 ; set entry_winds $fr.ent 94 label $fr.sp -width 1 95 pack $fr.lbl $fr.ent $fr.sp -side left 96 pack $fr -side left -anchor w -expand 1 97 98 frame $w.gstfr ; set fr $w.gstfr 99 label $fr.lbl -text "Max. gusts ($units):" 100 entry $fr.ent -width 3 ; set entry_gusts $fr.ent 101 label $fr.sp -width 1 102 pack $fr.lbl $fr.ent $fr.sp -side left 103 pack $fr -side left -expand 1 104 105 frame $w.psifr ; set fr $w.psifr 106 label $fr.lbl -text "Press. (mb):" 107 entry $fr.ent -width 4 ; set entry_press $fr.ent 108 label $fr.sp -width 1 109 pack $fr.lbl $fr.ent $fr.sp -side left 110 pack $fr -side left -expand 1 111 112 if {$units == "MPH"} { set eyeunits Miles 113 } else { set eyeunits NM } 114 115 frame $w.eyefr ; set fr $w.eyefr 116 label $fr.lbl -text "Eye diam. ($eyeunits):" 117 entry $fr.ent -width 2 ; set entry_eye $fr.ent 118 pack $fr.lbl $fr.ent -side left 119 pack $fr -side right -anchor e -expand 1 120 121 set w .stdata.end 122 frame $w 123 pack $w -side top -anchor center 124 125 button $w.dismiss -text "Dismiss" -command { destroy .stdata } 126 button $w.done -text "Done" -command [subst "test_stdata \ 127 $entry_name $entry_timestamp $entry_advno $entry_latt \ 128 $entry_long $entry_course $entry_speed $entry_winds \ 129 $entry_gusts $entry_press $entry_eye"] 130 pack $w.dismiss $w.done -side left 131 132 bind $entry_name <Return> [subst "focus $entry_timestamp"] 133 bind $entry_timestamp <Return> [subst "focus $entry_advno"] 134 bind $entry_advno <Return> [subst "focus $entry_latt"] 135 bind $entry_latt <Return> [subst "focus $entry_long"] 136 bind $entry_long <Return> [subst "focus $entry_course"] 137 bind $entry_course <Return> [subst "focus $entry_speed"] 138 bind $entry_speed <Return> [subst "focus $entry_winds"] 139 bind $entry_winds <Return> [subst "focus $entry_gusts"] 140 bind $entry_gusts <Return> [subst "focus $entry_press"] 141 bind $entry_press <Return> [subst "focus $entry_eye"] 142 bind $entry_eye <Return> [subst "focus $entry_name"] 143 focus $entry_name 144} 145 146 147proc sterr {msg} { 148 bell 149 tk_messageBox -parent .stdata \ 150 -message "Data for \"$msg\" must be entered!" -type ok 151} 152 153 154proc test_stdata {entry_name entry_timestamp entry_advno \ 155 entry_latt entry_long entry_course entry_speed entry_winds \ 156 entry_gusts entry_press entry_eye} { 157 158 global tksttype storms units 159 160 set type $tksttype 161 set name [$entry_name get] 162 set timestamp [$entry_timestamp get] 163 set advno [$entry_advno get] 164 set latt [$entry_latt get] 165 set long [$entry_long get] 166 set course [$entry_course get] 167 set speed [$entry_speed get] 168 set winds [$entry_winds get] 169 set gusts [$entry_gusts get] 170 set press [$entry_press get] 171 set eye [$entry_eye get] 172 173 if {[string compare $advno ""] == 0} { set advno XX } 174 if {[string compare $course ""] == 0} { set course XX ; set speed XX } 175 if {[string compare $eye ""] == 0} { set eye XX } 176 177 if {[string compare $type ""] == 0} { return [sterr "Storm type"] } 178 if {[string compare $name ""] == 0} { return [sterr "Storm name"] } 179 if {[string compare $timestamp ""] == 0} { return [sterr "Timestamp"] } 180 if {[string compare $latt ""] == 0} { return [sterr "Latitude"] } 181 if {[string compare $long ""] == 0} { return [sterr "Longitude"] } 182 if {[string compare $speed ""] == 0} { return [sterr "Speed"] } 183 if {[string compare $winds ""] == 0} { return [sterr "Max. winds"] } 184 if {[string compare $gusts ""] == 0} { return [sterr "Max. gusts"] } 185 if {[string compare $press ""] == 0} { return [sterr "Pressure"] } 186 187 set name [string toupper $name] 188 set timestamp [string toupper $timestamp] 189 set advno [string toupper $advno] 190 191 if {$units == "MPH"} { 192 if {$speed != "XX"} { set speed [expr {round($speed / 1.15)}] } 193 if {$winds != ""} { set winds [expr {round($winds / 1.15)}] } 194 if {$gusts != ""} { set gusts [expr {round($gusts / 1.15)}] } 195 if {$eye != "XX"} { set eye [expr {round($eye / 1.15)}] } 196 } 197 198 curr $timestamp $type $name $latt $long \ 199 $course $speed $press $winds $gusts $eye 200 set advisory_list($name$timestamp) $advno 201 202 set save [tk_messageBox -message "Append to $storms/$name.trk?" \ 203 -type yesno] 204 205 if {$save == "yes"} { 206 set f [open $storms/[string tolower $name].trk a] 207 puts -nonewline $f "curr $timestamp $type $name $latt $long " 208 puts $f "$course $speed $press $winds $gusts $eye" 209 puts $f "set advisory_list($name$timestamp) \"$advno\"" 210 close $f 211 } 212 213} 214 215proc tk_course_menu {} { 216 catch {destroy .cst} 217 toplevel .cst 218 219 set tw .stdata.dat3.wndfr.ent 220 set x [winfo rootx $tw] 221 set y [winfo rooty $tw] 222 wm geometry .cst +$x+$y 223 wm attributes .cst -topmost true 224 225 set w .cst.f1 ; frame $w ; pack $w -side top 226 button $w.b1 -text "N (0.0 deg.)" -command {set cstval 0.0} 227 button $w.b2 -text "NNE (22.5 deg.)" -command {set cstval 22.5} 228 button $w.b3 -text "NE (45.0 deg.)" -command {set cstval 45.0} 229 button $w.b4 -text "ENE (67.5 deg.)" -command {set cstval 67.5} 230 pack $w.b1 $w.b2 $w.b3 $w.b4 -side left -expand 1 231 232 set w .cst.f2 ; frame $w ; pack $w -side top 233 button $w.b1 -text "E (90.0 deg.)" -command {set cstval 90.0} 234 button $w.b2 -text "ESE (112.5 deg.)" -command {set cstval 112.5} 235 button $w.b3 -text "SE (135.0 deg.)" -command {set cstval 135.0} 236 button $w.b4 -text "SSE (157.5 deg.)" -command {set cstval 157.5} 237 pack $w.b1 $w.b2 $w.b3 $w.b4 -side left -expand 1 238 239 set w .cst.f3 ; frame $w ; pack $w -side top 240 button $w.b1 -text "S (180.0 deg.)" -command {set cstval 180.0} 241 button $w.b2 -text "SSW (202.5 deg.)" -command {set cstval 202.5} 242 button $w.b3 -text "SW (225.0 deg.)" -command {set cstval 225.0} 243 button $w.b4 -text "WSW (247.5 deg.)" -command {set cstval 247.5} 244 pack $w.b1 $w.b2 $w.b3 $w.b4 -side left -expand 1 245 246 set w .cst.f4 ; frame $w ; pack $w -side top 247 button $w.b1 -text "W (270.0 deg.)" -command {set cstval 270.0} 248 button $w.b2 -text "WNW (292.5 deg.)" -command {set cstval 292.5} 249 button $w.b3 -text "NW (315.0 deg.)" -command {set cstval 315.0} 250 button $w.b4 -text "NNW (337.5 deg.)" -command {set cstval 337.5} 251 pack $w.b1 $w.b2 $w.b3 $w.b4 -side left -expand 1 252 253 global cstval 254 tkwait variable cstval 255 .stdata.dat2.work.crfr.course delete 0 end 256 .stdata.dat2.work.crfr.course insert end $cstval 257 destroy .cst 258} 259 260 261proc tk_ts_puts_a {args} { 262 set w .tsmenu.text 263 264 if {[llength $args] == 1} { 265 set text "[lindex $args 0]" 266 $w insert end "$text\n" 267 } elseif {[llength $args] == 2 && [lindex $args 0] == "-nonewline"} { 268 set text "[lindex $args 1]" 269 $w insert end "$text" 270 } 271 $w see end 272} 273 274 275proc tk_ts_puts_b {args} { 276 set w .tsmenu.text2 277 278 if {[llength $args] == 1} { 279 set text "[lindex $args 0]" 280 $w insert end "$text\n" 281 } elseif {[llength $args] == 2 && [lindex $args 0] == "-nonewline"} { 282 set text "[lindex $args 1]" 283 $w insert end "$text" 284 } 285 $w see end 286} 287 288 289proc tk_timestamp_menu {} { 290 global text_font 291 set seconds [clock seconds] 292 293 toplevel .tsmenu 294# Try to figure out the best place to put the window. 295# If this fails, leave it up to the window manager. 296 if {[regexp "(\[0-9]+)x(\[0-9]+)\[+](\[0-9]+)\[+](\[0-9]+)" \ 297 [winfo geometry .stdata.dat1.tshelp] \ 298 a x1 y1 x2 y2] == 1} { 299 eval wm geometry .tsmenu +[expr {$x1 + $x2}]+[expr {$y1 + $y2 + 60}] 300 } 301 302 set w .tsmenu 303 wm attributes $w -topmost true 304 text $w.text -width 70 -height 6 -font $text_font \ 305 -foreground black -background white -spacing3 1.2 306 pack $w.text -side top 307 set cmd tk_ts_puts_a 308 309 set timezone [clock format $seconds -format %Z] 310 if {[regexp ".DT" $timezone] == 1} { 311 set etz "EDT" ; set egmt 4 ; set msg "appears" 312 } else { 313 set etz "EST" ; set egmt 5 ; set msg "does not appear" 314 } 315 $cmd "Daylight savings time $msg to be in effect (TZ=$timezone)." 316 $cmd "" 317 set ld [clock format $seconds -format %d] 318 set localhour [clock format $seconds -format %H] 319 set gmtdate [clock format $seconds -format %d -gmt true] 320 set gmthour [clock format $seconds -format %H -gmt true] 321 set gmtdiff [clock format [clock scan "00:00"] -format %H -gmt true] 322 set etzdiff [expr {$gmtdiff - $egmt}] 323 set nhcdate [clock format [clock scan "$etzdiff hour"] -format %d] 324 set nhchour [clock format [clock scan "$etzdiff hour"] -format %H] 325 326 $cmd "Based on the current date and time, I'm guessing that the storm data" 327 $cmd -nonewline "is from the [subst $localhour]00 $timezone advisory, or " 328 $cmd "[subst $nhchour]00 $etz, for day $ld ($timezone) of the" 329 $cmd -nonewline "month. In other words, it appears to be for " 330 $cmd "[subst $gmtdate/$gmthour]00Z." 331 332 button $w.default -text "Use the above value" \ 333 -command [subst ".stdata.dat1.ts insert end [subst $gmtdate/$gmthour]00Z ; \ 334 destroy $w"] 335 pack $w.default -side top 336 337# Let's use some real values to look better/cleaner 338 set mont [clock format [clock seconds] -format %b] 339 set monn [clock format [clock seconds] -format %m] 340 set lh [subst $localhour]00 341 set eh [subst $nhchour]00 342 set gh [subst $gmthour]00 343 set gd $gmtdate 344 set ed $nhcdate 345 346 text $w.text2 -height 8 -width 70 -font $text_font \ 347 -foreground black -background white -spacing3 1.2 348 pack $w.text2 -side top 349 set cmd tk_ts_puts_b 350 351 $cmd "Ok, I need you to enter the correct date/time for the advisory." 352 $cmd "The format for this is as in the examples below:" 353 $cmd "" 354 $cmd " $mont $ld $lh $timezone -OR- $monn/$ld $lh $timezone" 355 $cmd " $mont $ed $eh $etz -OR- $monn/$ed $eh $etz" 356 $cmd " $mont $gd $gh UTC -OR- $monn/$gd $gh UTC" 357 $cmd " $mont $gd $gh GMT -OR- $monn/$gd $gh GMT" 358 359 frame $w.entfr 360 pack $w.entfr -side top -expand 1 -fill x 361 label $w.entfr.entlbl -text "Date/Time:" 362 entry $w.entfr.entry -width 30 363 pack $w.entfr.entlbl $w.entfr.entry -side left -anchor center 364 bind $w.entfr.entry <Return> [subst "test_ts_entry $gmtdate $gmthour"] 365} 366 367proc test_ts_entry {gmtdate gmthour} { 368 set dt [.tsmenu.entfr.entry get] 369 if {[catch {set ds [clock scan "$dt"]} err] == 1} { 370 bgerror $err 371 } else { 372 set ldt [clock format $ds -format "%b %d %H00"] 373 set gdt [clock format $ds -format "%b %d %H00" -gmt true] 374 set retval [clock format $ds -format "%d/%H00Z" -gmt true] 375 376 set ok [tk_messageBox -message " 377Local: $ldt 378UTC: $gdt 379Timestamp: $retval 380 381Is this ok? 382" -type yesno] 383 if {$ok == "yes"} { 384 .stdata.dat1.ts insert end [subst $gmtdate/$gmthour]00Z 385 destroy .tsmenu 386 } 387 } 388} 389 390 391