1 2# JStrack: copyright 1997/2010 by Jim Graham, N5IAL, all rights reserved. 3 4source $libdir/imagery_links.tcl 5source $libdir/jpg_xy.tcl 6 7set imgloop_delay 500 ;# good default 8set s1 "Imagery provided by the National Oceanic and" ;# just to cut 9set s2 "Atmospheric Administration (NOAA)." ;# line lengths 10set noaacredits "$s1 $s2" 11 12# Handle https 13package require http 14package require tls 15 16proc get_remote {link filename} { 17 set f [open $filename w] 18 19set e [open errlog w] 20puts $e "In get_remote $link $filename" 21 22 # "-tls1 1" is required since [POODLE] 23 http::register https 443 [list ::tls::socket -tls1 1] 24 25puts $e "just ran http::register" 26 27 if {[catch { set token [http::geturl $link -channel $f] }]} { return -1 } 28 29puts $e "still here after catch set token" 30 31 upvar #0 $token state 32 regexp {([234][0-9][0-9]) (.*)} $state(http) a code msg 33 if {$code != 200} { return -1 } 34puts $e "code was NOT 200, so returning normally after closing file" 35 close $f 36 return 0 37} 38 39 40if {[catch { set img_version [package require Img] }]} { 41 set img_version -1 42} 43 44 45proc check_img {} { 46 global img_version 47 48 if {$img_version < 0} { 49 tk_messageBox -type ok -message \ 50 "The Img extension is 51REQUIRED for displaying 52satellite imagery. 53 54See the JStrack web page 55for more information 56about adding the Img extension." 57 return 0 58 } 59 return 1 60} 61 62proc noaa_links {} { 63 global goeslinks tagidx 64 65 catch { destroy .imglinks } 66 toplevel .imglinks 67 wm attributes .imglinks -topmost true 68 wm title .imglinks "Satellite Imagery Links" 69 wm geometry .imglinks +[winfo rootx .c]+[winfo rooty .c] 70 set w .imglinks 71 text $w.text -background white -foreground black 72 button $w.dismiss -text "Dismiss" -command { destroy .imglinks } 73 pack $w.text $w.dismiss -side top -expand y -fill x 74 set t $w.text ; set txtfont {"Courier New" 14 bold} 75 76 $t tag configure wintitle -font {"Courier New" 18 bold} \ 77 -foreground #dd0000 -justify center 78 $t tag configure wintitleb -font $txtfont \ 79 -foreground #dd0000 -justify center 80 $t tag configure linktitle -font $txtfont 81 $t tag configure link -font $txtfont -foreground #0000dd 82 83 $t insert end "NOAA Satellite Services Division Links\n" wintitle 84 $t insert end "(cut/paste to your web browser)\n\n" wintitleb 85 $t insert end "NOAA SSD Home: " linktitle 86 $t insert end "$goeslinks(SSD_Home)\n\n" link 87 88 $t insert end \ 89 "NOAA SSD - Tropical Atlantic Satellite Imagery:\n" linktitle 90 $t insert end " $goeslinks(SSD_TropAtl)\n\n" link 91 92 foreach tlist $tagidx { 93 foreach {tag idx} $tlist { break } 94 $t insert end "GOES East $tag\n" linktitle 95 $t insert end " Current: " linktitle 96 $t insert end "$goeslinks($idx,html)\n" link 97 $t insert end " Loop: " linktitle 98 $t insert end "$goeslinks($idx,loop,html)\n\n" link 99 } 100} 101 102proc download_img {link} { 103 global trackdir libdir 104 105 catch { file mkdir $trackdir/imagery } 106 set linkfn [string tolower [file tail $link]] 107 set filename $trackdir/imagery/$linkfn 108 # catch { exec wget $link -O $filename } 109 get_remote $link $filename 110 return $filename 111} 112 113 114# Make top part of the window for the two imagery display procs. 115# They have a few differences in the middle, so each proc does that 116# bit. But for the bits that are the identical, why duplicate code? 117proc goes_east_mktop {w title html_link} { 118 catch { destroy $w } 119 toplevel $w 120 wm withdraw $w 121 wm title $w "Satellite Imagery" 122 wm geometry $w +[winfo rootx .c]+[winfo rooty .c] 123 wm attributes $w -topmost true 124 125 label $w.l1 -text "GOES East Hurricane Sector" \ 126 -font {Helvetica 14 bold} 127 label $w.l2 -text "$title" -font {Helvetica 12 bold} 128 label $w.l3 -text "($html_link)" -font {Helvetica 12} 129 pack $w.l1 $w.l2 $w.l3 -side top -expand y -fill x 130} 131 132 133proc goes_east_hurrsec {title link html_link} { 134 global goeslinks noaacredits 135 136 if {![check_img]} { return } 137 set w .imagery 138 139 # Create the toplevel and top portion of the window 140 goes_east_mktop $w $title $html_link 141 wm attributes $w -topmost true 142 143 set fn [download_img $link] 144 if {$fn == ""} { 145 label $w.l4 -text "Imagery download failed!" 146 label $w.l5 -text \ 147 "Use a web browser and the link above to find the image...." 148 $w.l4 configure -font {Helvetica 12 bold} -foreground red 149 $w.l5 configure -font {Helvetica 12 bold} -foreground red 150 151 pack $w.l4 $w.l5 -side top -expand y -fill x 152 } else { 153 foreach {width height} [jpg_xy $fn] { break } 154 pack [canvas $w.c -width $width -height $height] -side top \ 155 -anchor center 156 image create photo statimage -file $fn 157 $w.c create image 0 0 -image statimage -anchor nw 158 } 159 160 label $w.endl1 -text $noaacredits 161 label $w.endl2 -text "($goeslinks(SSD_Home))" -font {Helvetica 12} 162 button $w.dismiss -text "Dismiss" -command " 163 image delete statimage 164 catch { file delete $fn } 165 destroy .imagery 166 " 167 pack $w.endl1 $w.endl2 $w.dismiss -side top -expand y -fill x 168 wm deiconify $w 169 170} 171 172 173proc playstop {} { 174 global imgloop_delay imgloop_stop 175 176 set rb .imagery.control.rb 177 set bt .imagery.control.playstop 178 179 switch [$bt cget -text] { 180 Start { 181 $bt configure -text "Stop" 182 set imgloop_stop 0 183 while {!$imgloop_stop} { 184 for {set i 0} {$i < 8 && !$imgloop_stop} {incr i} { 185 $rb.rb$i invoke ; update 186 after $imgloop_delay 187 } 188 } 189 } 190 Stop { 191 $bt configure -text "Start" 192 set imgloop_stop 1 193 } 194 } 195} 196 197 198proc goes_east_hurrsec_loop {title idx html_link} { 199 global goeslinks cimg imgloop_delay loopimg noaacredits 200 201 if {![check_img]} { return } 202 set title "$title Loop" 203 204 set w .imagery 205 # Create the toplevel and top portion of the window 206 goes_east_mktop $w $title $html_link 207 wm attributes $w -topmost true 208 209 set spacertxt " " 210 ######## Control frame ######## 211 ################################# 212 pack [frame $w.control] -side top -expand n -anchor center 213 set wc $w.control 214 ### 215 ### Radiobuttons (to indicate/select image from loop) 216 ### 217 pack [frame $wc.rb] -side left -expand n 218 for {set i 0} {$i < 8} {incr i} { 219 radiobutton $wc.rb.rb$i -variable cimg -value loopimg($i) \ 220 -text " " 221 pack $wc.rb.rb$i -side left 222 } 223 pack [label $wc.spacer1 -text $spacertxt] -side left -expand n 224 ### 225 ### Start/Stop button 226 ### 227 button $wc.playstop -text Start -command { playstop } 228 pack $wc.playstop -side left 229 pack [label $wc.spacer2 -text $spacertxt] -side left -expand n 230 ### 231 ### Scale slider for delay 232 ### 233 pack [frame $wc.sf] -side left 234 pack [frame $wc.sf.sftop] -side top -expand y -fill x 235 set wt $wc.sf.sftop 236 pack [label $wt.l1 -text "Slow" -font {Helvetica 10 bold}] -side left 237 pack [label $wt.l2 -text "SPEED" -font {Helvetica 12 bold}] -side left \ 238 -expand y -fill x 239 pack [label $wt.l3 -text "Fast" -font {Helvetica 10 bold}] -side left 240 scale $wc.sf.delay -from 1000 -to 100 -variable imgloop_delay -showvalue 0 \ 241 -orient horizontal -length 300 242 pack $wc.sf.delay -side top -expand n -anchor center 243 244 245 # Create FRAME ONLY for canvas 246 pack [frame $w.canvas] -side top -expand y -fill x 247 set cwin $w.canvas.c 248 249 label $w.endl1 -text "Downloading images...." -font {Helvetica 16 bold} \ 250 -foreground #dd0000 251 label $w.endl2 -text "" -font {Helvetica 16 bold} -foreground #dd0000 252 253 button $w.dismiss -text "Dismiss" -command { 254 for {set i 0} {$i < 8} {incr i} { 255 if {[.imagery.control.playstop cget -text] == "Stop"} { 256 set imgloop_stop 1 257 } 258 catch { image delete loop$i } 259 } 260 destroy .imagery 261 } 262 pack $w.endl1 $w.endl2 $w.dismiss -side top -expand y -fill x 263 wm deiconify $w 264 265 set imgcnt 0 266 267 for {set i 0} {$i < 8} {incr i} { 268 $w.endl2 configure -text "Image [expr {$i + 1}] of 8" 269 $wc.rb.rb$i invoke 270 update 271 set fn [download_img [lindex $goeslinks($idx,loop) $i]] 272 if {$fn == ""} { 273 $wc.rb.rb$i configure -state disabled 274 } else { 275 if {$imgcnt == 0} { 276 foreach {width height} [jpg_xy $fn] { break } 277 pack [canvas $cwin -width $width -height $height] \ 278 -side top -expand y -fill x 279 } 280 incr imgcnt 281 image create photo loop$i -file $fn 282 catch { file delete $fn } 283 set loopimg($i) [$cwin create image 0 0 -image loop$i -anchor nw] 284 set cimg $loopimg($i) 285 $wc.rb.rb$i configure -command " $cwin raise $loopimg($i) " 286 } 287 } 288 289 $w.endl1 configure -text $noaacredits -font {Helvetica 12} \ 290 -foreground black 291 $w.endl2 configure -text "($goeslinks(SSD_Home))" \ 292 -font {Helvetica 12} -foreground black 293 update 294 if {$imgcnt} { 295 playstop 296 } else { 297 tk_messageBox -type ok -message {ALL images failed to download! 298The links may have changed.....} 299 destroy .imagery 300 return 301 } 302} 303 304