1
2# JStrack:  copyright 1997/2010 by Jim Graham, N5IAL, all rights reserved.
3
4source $libdir/imagery_links.tcl
5source $libdir/anigif.tcl
6# source $libdir/jpg_xy.tcl
7
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 debug {s} {
17   set e [open errlog a]
18   set ts [clock format [clock seconds]]
19   puts $e "$ts $s"
20   close $e
21}
22
23
24# proc get_remote {link filename} {
25#    set f [open $filename w]
26#
27#    http::register https 443 [list ::tls::socket -tls1 1]
28#
29#    # debug "just ran http::register"
30#
31#    if {[catch { set token [http::geturl $link -channel $f] }]} { return -1 }
32#
33#    # debug "still here after catch set token"
34#
35#    upvar #0 $token state
36#    regexp {([234][0-9][0-9]) (.*)} $state(http) a code msg
37#    if {$code != 200} { return -1 }
38#    # debug "code was NOT 200, so returning normally after closing file"
39#    close $f
40#    return 0
41# }
42
43
44if {[catch { set img_version [package require Img] }]} {
45   set img_version -1
46}
47
48
49proc check_img {} {
50   global img_version
51
52   if {$img_version < 0} {
53      tk_messageBox -type ok -message \
54      "The Img extension is
55REQUIRED for displaying
56satellite imagery.
57
58See the JStrack web page
59for more information
60about adding the Img extension."
61      return 0
62   }
63   return 1
64}
65
66proc download_img {link} {
67   global trackdir libdir
68
69   catch { file mkdir $trackdir/imagery }
70   set linkfn [string tolower [file tail $link]]
71   set filename $trackdir/imagery/$linkfn
72   catch { exec wget $link -O $filename }
73   # get_remote $link $filename
74   return $filename
75}
76
77
78proc goes_east_mktop {w title html_link} {
79   catch { destroy $w }
80   toplevel $w
81   wm withdraw $w
82   wm title $w "Satellite Imagery"
83   wm geometry $w +[winfo rootx .c]+[winfo rooty .c]
84   wm attributes $w -topmost true
85
86   label $w.l1 -text "GOES East Hurricane Sector" \
87      -font {Helvetica 14 bold}
88   label $w.l2 -text "$title" -font {Helvetica 12 bold}
89   label $w.l3 -text "($html_link)" -font {Helvetica 12}
90   pack $w.l1 $w.l2 $w.l3 -side top -expand y -fill x
91   update
92}
93
94
95proc goes_east_hurrsec {title link {isgif 0}} {
96   global goeslinks noaacredits
97
98   if {![check_img]} { return }
99   set w .imagery
100
101   # Create the toplevel and top portion of the window
102   goes_east_mktop $w $title $link
103   wm attributes $w -topmost true
104
105   set fn [download_img $link]
106   if {$fn == ""} {
107      label $w.l4 -text "Imagery download failed!"
108      label $w.l5 -text \
109         "Use a web browser and the link above to find the image...."
110      $w.l4 configure -font {Helvetica 12 bold} -foreground red
111      $w.l5 configure -font {Helvetica 12 bold} -foreground red
112
113      pack $w.l4 $w.l5 -side top -expand y -fill x
114   } else {
115      pack [canvas $w.c -width 900 -height 540] -side top \
116            -anchor center
117      if {$isgif} {
118         animate_in_canvas $w.c $fn
119      } else {
120         image create photo statimage -file $fn
121         $w.c create image 0 0 -image statimage -anchor nw
122      }
123   }
124
125   label $w.endl1 -text $noaacredits
126   label $w.endl2 -text "($goeslinks(SSD_Home))" -font {Helvetica 12}
127   button $w.dismiss -text "Dismiss" -command {
128      catch { image delete statimage }
129      catch { file delete $fn }
130      debug "About to destroy .imagery"
131      destroy .imagery
132      debug "Just destroyed .imagery:  [winfo exists .imagery]"
133      }
134   pack $w.endl1 $w.endl2 $w.dismiss -side top -expand y -fill x
135   wm deiconify $w
136}
137
138
139