s_m - July 2007 All website with weather information also provide animations with the changes in the last few hours. This is a simple way to use Tcl/Tk to create your own personal animation and control length or speed. It could also be used to create time-lapse sequences from webcam images. I am using it on Windows, also tested on Linux using the ActiveState distribution. Before you can see any animation you need to let the program collect images for a few hours.
# \
exec tclsh "$0" -- "$@"
#
# sat_pics.tcl - download,show,save,animate weather images
#
# S.Mimmi
# 02-July-2007 - added icons for back/forward button
#
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 display
set Opt(cur_pic) US-curr
# 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
# Init checkbutton to display on desktop background (1=display)
set Opt(back) 0
# Where is irfanView (if running on windows - to change wallpaper)
set Opt(iview) "C:/Graphics/IrfanView/i_view32.exe"
set Opt(screen_size) "(1280,1024)"
# Where is xloadimage (if running on Unix - to change wallpaper)
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
}"
image create bitmap forw_bm -data "
#define forw_width 12
#define forw_height 13
static char forw_bits = {
0x00,0x00,0x04,0x03,0x0c,0x03,0x1c,0x03,0x3c,0x03,0x7c,0x03,0xfc,
0x03,0x7c,0x03,0x3c,0x03,0x1c,0x03,0x0c,0x03,0x04,0x03,0x00,0x00
}"
image create bitmap back_bm -data "
#define back_width 12
#define back_height 13
static char back_bits = {
0x00,0x00,0x0c,0x02,0x0c,0x03,0x8c,0x03,0xcc,0x03,0xec,0x03,0xfc,
0x03,0xec,0x03,0xcc,0x03,0x8c,0x03,0x0c,0x03,0x0c,0x02,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 -bd 1 -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 -image back_bm -command {prev_img 1}
button .b.an.fw -image forw_bm -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 {
.b.an.go configure -state disabled
cycle_img
.b.an.go configure -state normal
}
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_filesCategory Application | Category Science | Category Animation