'''Aug 28 2005''' [SRIV] After noticing that some of the NOAA enhance satellite images were being delayed around 1-2 hours, I decided to try to enhance the higher resolution black & white images.

This script will download and display the latest North America image, then enhance the image with colors.
Here is what the output looks like: http://server.linuxsys.net/images/latest_eastir_eh.gif compared to NOAA's image http://server.linuxsys.net/images/satimg.jpg .

[RS] Here's a snapshot of the [Katrina] Category 5 Hurricane (between Florida and N.O.) on 2005-08-28:

[WikiDbImage katrina.gif]
----
        # satenhance.tcl 08-28-2005 Steve Redler IV
        # 10-27-2012 updated to new url for source image
        package require Tk
        package require http
        canvas .c -width 1000 -height 900
        pack .c
        proc comb {x spec} {
                foreach {value limit} $spec {if {$x<$limit} break}
                set value
        }
        proc colorize {image} {
                # get image sizes
                set width  [image width  $image]
                set height [image height $image]
                set height [image height $image]
                set filterlist {
                        #646400 170
                        #a0a000 180
                        #f0f000 185
                        #000b64 190
                        #0064aa 195
                        #00d7e6 200
                        #720000 205
                        #960000 210
                        #d90000 214
                        #ff5b62 218
                        #f97f7c 222
                        #3cd612 226
                        #84f780 230
                        #323232 240
                        #ffffff 254
                }
                # compute new colors
                for {set y 0} {$y < $height} {incr y} {
                        #puts "row=$y"
                        set row {}
                        for {set x 0} {$x < $width} {incr x} {
                                # save transparency
                                lappend trans $x $y [$image transparency get $x $y]
                                # compute the new color
                                foreach {r g b} [$image get $x $y] break
                                if {$r < 170} {
                                        lappend row [format #%02x%02x%02x $r $b $g]
                                } else {
                                        lappend row [comb $r $filterlist]
                                }
                        }
                        # update the row of the image
                        $image put \{$row\} -to 0 $y
                        update
                }
                # restore transparency
                foreach {x y t} $trans { $image transparency set $x $y $t }
        }
        set imagedata [http::data [http::geturl http://www.ssec.wisc.edu/data/geo/east/latest_east_ir2_conus.gif]]
        image create photo satimage -data $imagedata
        .c create image 0 0 -image satimage -tag imgtag -anchor nw
        update
        after 100 [colorize satimage]
        update
        satimage write latest_eastir_eh.gif -format gif
----
21-november-2006 Harm Olthof: changed proc colorize to use proc argument in the put statement.

2011-03-19 [tomas] Nifty! Some lines in the program were doubled, I don't know why. I removed them.

<<categories>> Application | Science