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