#
 # sat_pics.tcl - download,show,save,animate weather images
 # 
 # S.Mimmi 2007
 #
 
 package require http

 ####################  Configuration ######################
 
 # Web Proxy data (remove comment, configure if needed)
 #http::config -proxyhost hostname -proxyport port_num
 
 # URLs of the images to use, the index will be the filename 
 array set Url {
 IR-enh    http://weather.unisys.com/satellite/sat_ir_enh_us.gif
 Sat-sfc   http://weather.unisys.com/satellite/sat_sfc_map.gif
 Visible   http://weather.unisys.com/satellite/sat_vis_us.gif
 Wat-vap   http://weather.unisys.com/satellite/sat_wv_us.gif
 Sfc-dT24h http://weather.unisys.com/surface/sfc_con_24temp.gif
 Sat-rad   http://weather.unisys.com/satellite/sat_ir_rad.gif
 US-curr   http://image.weather.com/images/maps/current/curwx_600x405.jpg
 US-temp   http://image.weather.com/images/maps/current/acttemp_600x405.jpg
 }
 
 # Initial image to load
 set Opt(cur_pic)   US-curr
 
 # Init checkbutton to display on desktop background (1=display)
 set Opt(back)      0
 
 # Minutes to wait before downloading new image
 set Opt(ref_rate)   20
 
 # Milliseconds to wait before next image in slideshow
 set Opt(cyc_rate)   250
 # How many pictures to cycle thru (all newer than cyc_hours)
 set Opt(cyc_hours)  60
 
 # Number of days to store images
 set Opt(keep_days)  14
 
 # Where to store images
 set Opt(img_path)   "[pwd]/wea_img"
 
 # Start GUI
 set Opt(use_gui)    1
 
 # Where is irfanView (if running on windows)
 set Opt(iview)      "C:/Graphics/IrfanView/i_view32.exe"
 set Opt(screen_size) "(1280,1024)"
 
 # Where is xloadimage (if running on Unix)
 set Opt(xload)      "/usr/bin/xloadimage"
 
 ###################### End configuration #############################
 
 
 # Load user defaults (remove file after changing Opt() defaults above)
 if {$::tcl_platform(platform) == "windows"} {
    set ini_file "$env(HOME)/sat_pic.ini"
 } else {
    set ini_file "$env(HOME)/.sat_picrc"
 }
 
 catch {source $ini_file}
 if {$Opt(ref_rate) < 10} {set Opt(ref_rate) 10}
 if {[catch {set Url([set Opt(cur_pic)])}]} {
            set Opt(cur_pic) [lindex [array names Url] 0]
 }
 
 ####################### Procedures ###################################
 
 # Get image from web
 proc get_image { url } {
 
     for {set i 1} {$i < 4} {incr i} {
        set um [http::geturl $url -timeout [expr {1000 + $i * 3000}]]
        http::wait $um
 
        set ncode [http::ncode $um]
        if { $ncode == 200 } {
            break
        } else {
            http::cleanup $um
        }
    }
    if {$i == 4} {
        set htstat [http::status $um]
        wm title . "$htstat - code = $ncode"
        http::cleanup $um
        return {}
    }
 
    set pic [http::data $um]
    http::cleanup $um
    return $pic
 }
 
 
 # Get and save all images 
 proc get_all_images { } {
 global Opt Url
 
     foreach img_id [array names Url] {
        set pic [get_image $Url($img_id)]
        if {$pic != {}} {
            save_img [get_file_name $img_id] $pic
        }
    }
 }
 
 # Filename used to store image
 proc get_file_name {img_id} {
 global Opt Url
 
    set ext [file extension $Url($img_id)]
     set secs [clock seconds]
     set mins [string index [clock format $secs -format "%M"] 0]0
     return [clock format $secs -format "$Opt(img_path)/${img_id}_%Y%m%d_%H$mins$ext"]
 }
 
 # Get current image, display and save,
 # if repeat != 0 then start the timer for next download and get full set
 proc show_image { {repeat 0} } {
 global Opt Url
 
    set img_id $Opt(cur_pic)
     set url $Url($img_id)
    
    # Get the image
     set pic [get_image $url]
 
    # If picture found
    if { $pic != {} } {
 
         # Use our file identifiers since filenames from Web can change
        set filename [get_file_name $img_id]
 
        # Display in window
        if { $Opt(use_gui) } {
            wm title . [file tail $filename]
            catch {image delete wea_img}
            image create photo wea_img -data $pic
            wm sizefrom . program
            .l configure -image wea_img 
            set Opt(cur_idx) 0
        }
 
         # Save image: use our identifiers since filenames from Web can change
        set image_file [save_img $filename $pic]
 
        # After the image is saved check if need to change the background
        if {$Opt(back)} { load_background $image_file }
     }
 
    if { $repeat } {
        # get a new image after ref_rate min
        after [expr {$Opt(ref_rate) * 60000}] show_image 1
         # get full set
        get_all_images
    }
 }
 
 proc show_img_file { f } {
     wm title . [file tail $f]
    set fd [open $f r]
    fconfigure $fd -translation binary -encoding binary
    set pic [read $fd]
    close $fd
    catch {image delete wea_img}
    image create photo wea_img -data $pic
    .l configure -image wea_img 
 }
 
 # Cycle thru images previously downloaded
 proc cycle_img {} {
 global Opt
 
    set name $Opt(cur_pic)
    set files   [lsort [glob -directory $Opt(img_path) ${name}*]]
     set cyctime [expr {[clock seconds] - $Opt(cyc_hours) * 3600}]
     
     # Show images from the last cyc_hours
    foreach f $files {
        if { [file mtime $f] > $cyctime } {
            show_img_file $f
            # wait before next image
            set state ok
            after $Opt(cyc_rate) set state tout
            vwait state
        }
    }
    set Opt(cur_idx) 0
 }
 
 # View old images with the back/forward buttons
 proc prev_img { step } {
 global Opt
 
    set name $Opt(cur_pic)
    set files [lsort [glob -directory $Opt(img_path) ${name}*]]
 
    incr Opt(cur_idx) $step
    if {$Opt(cur_idx) >= [llength $files]} {
        set Opt(cur_idx) [expr {[llength $files] - 1}]
    } elseif {$Opt(cur_idx) < 0} {
        set Opt(cur_idx) 0
    }
 
     show_img_file [lindex $files end-$Opt(cur_idx)]
 }
 
 # Save the image
 proc save_img { filename pic } {
 
    # skip if already present
    if {![file exists $filename]} {
        set fd [open $filename w]
        fconfigure $fd -translation binary -encoding binary
        puts $fd $pic
        close $fd
        set filename [dup_remove $filename]
    } 
    return $filename
 }
 
 # Remove dup file (checking previous, return name of file kept)
 proc dup_remove { filename } {
 global Opt
 
    set file_glob [string range [file tail $filename] 0 end-9]
    set files [lsort [glob -directory $Opt(img_path) ${file_glob}* ]]
    
     set prev_file [lindex $files end-1]
     if {$prev_file == ""} {
        return $filename
    }
    set f_size [file size $prev_file] 
    if {$f_size == [file size $filename]} {
        set fd [open $filename r]
        fconfigure $fd -translation binary -encoding binary
        set data1 [read $fd $f_size]
        close $fd
        set fd [open $prev_file r]
        fconfigure $fd -translation binary -encoding binary
        set data2 [read $fd $f_size]
        close $fd
        if {$data1 == $data2} {
            file delete $filename
            return $prev_file
        }
     }
    return $filename
 }
 
 # Use helper to show image on desktop wallpaper
 proc load_background { filename } {
 global Opt
 
    if {$::tcl_platform(platform) == "windows"} {
        exec -- $Opt(iview) [file nativename $filename] /resize=$Opt(screen_size) /resample /aspectratio /sharpen=15 /wall=0 /killmesoftly &
    } elseif {$::tcl_platform(platform) == "unix"} {
        exec -- $Opt(xload) [file nativename $filename] -onroot -colors 32 &
    }
 }
 
 # Remove files older than Opt(keep_days)
 proc cleanup_old_files { } {
 global Opt
 
     # 60 * 60 * 24 = 86400 s/day
     set oldtime [expr {[clock seconds] - $Opt(keep_days) * 86400}]
 
    # scan all files and remove files modified more than keep_days ago
    set files [glob -directory $Opt(img_path) *]
    foreach f $files {
        if { [file mtime $f] < $oldtime } {
            file delete $f
        }
    }
     # tomorrow again
     after 86400000 cleanup_old_files
 }
 
 # Save configuration on exit
 proc write_ini { filename } {
 global Opt
 
     set fd [open $filename w]
     foreach item [lsort [array names Opt]] {
           puts $fd "set Opt($item) \t\"$Opt($item)\""
     }
     close $fd
 }
 
 #######################################################
 # GUI 
 #######################################################
 if { $Opt(use_gui) } {
 package require Tk
 package require Img
 
    image create bitmap play_bm -data "
 #define play_width 12
 #define play_height 13
 static char play_bits = {
   0x00,0x00,0x08,0x00,0x18,0x00,0x38,0x00,0x78,0x00,0xf8,0x00,0xf8,
   0x01,0xf8,0x00,0x78,0x00,0x38,0x00,0x18,0x00,0x08,0x00,0x00,0x00
 }"
 
     frame .b
     pack .b -side top -padx 2 -fill x
 
     image create photo wea_img -width 900 -height 650
     label .l -image wea_img
     pack  .l -side bottom -fill both
  
     foreach i [lsort [array names Url]] {
        set wn [string tolower $i]
        button .b.$wn -text $i -command "set Opt(cur_pic) $i; show_image"
        pack .b.$wn -side left
     }
 
    # Wallpaper
     checkbutton .b.b -text Wall. -variable Opt(back)
     pack .b.b -side right 
 
     # History and Animation
    frame .b.an 
     pack .b.an -side right -padx 2
 
    button .b.an.bk -text < -command {prev_img  1}
    button .b.an.fw -text > -command {prev_img -1}
 
    label .b.an.l -text "Hrs"
     entry .b.an.cyce -width 3 -textvariable Opt(cyc_hours)
     button .b.an.go -image play_bm -command cycle_img
 
    scale .b.an.sc -orient horizontal -width 10 -length 110 -showvalue 0 \
        -from 4 -to 1000 -variable Opt(cyc_rate) -tickinterval 0 
     entry .b.an.cycr -width 4 -textvariable Opt(cyc_rate)
    pack .b.an.bk .b.an.fw -side left
     pack .b.an.l .b.an.cyce .b.an.go .b.an.sc .b.an.cycr -side left
 
     wm protocol . WM_DELETE_WINDOW {write_ini $ini_file; exit}
    wm resizable . 0 0
 }
 
 # Check if the image dir exists
 if {![file isdirectory $Opt(img_path)]} {
    file mkdir $Opt(img_path)
 }
 
 # Start periodic downloads and show image if enabled
 http::config -useragent "MSIE 5.0"
 show_image 1
 
 # Check if old files need to be removed
 after 5000 cleanup_old_files

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References