Version 3 of A little image viewer
Updated 2003-04-15 13:53:33
Richard Suchenwirth 2002-09-09 - The evening before a business trip I was told that we'd need to take a viewer for TIFF images with us. A quick search showed that the available ones were not portable, at least not on a floppy, so I decided to roll my own, using the TIFF functionality of Img. Though fitting on a page of code, this cutie has some conveniences: you can scale up or down in powers of two, and either select a file via menu or step through all image files in the current directory. And incidentally: due to the transparent implementation, it can as well handle GIF/PPM/JPEG/PNG/BMP/XBM/XPM images, provided you have the required libs at hand...
package require Img
set factor 1.0
set files [lsort [glob -nocomplain *.tbg *.tif *.gif *.jpg *.png *.xbm *.xpm]]
proc openImg {w {fn ""}} {
global im1
if {$fn == ""} {
set fn [tk_getOpenFile -filetypes {{"TBG file" .tbg} {"All files" .*}}]
if {$fn !=""} {
cd [file dirname $fn]
set ::files [lsort [glob -nocomplain *.tbg *.tif *.gif *.jpg *.png *.xbm *.xpm]]
}
}
if {$fn != ""} {
wm title . "$fn - tbgview"
catch {image delete $im1}
set im1 [image create photo -file $fn]
scale $w
list [file size $fn] bytes, [image width $im1]x[image height $im1]
}
}
proc scale {w {n 1}} {
global im1 im2 factor
set factor [expr {$factor*$n}]
$w delete img
catch {image delete $im2}
set im2 [image create photo]
if {$factor>=1} {
set f [expr int($factor)]
$im2 copy $im1 -zoom $f $f
} else {
set f [expr round(1./$factor)]
$im2 copy $im1 -subsample $f $f
}
$w create image 1 1 -image $im2 -anchor nw -tag img
$w config -scrollregion [$w bbox all]
}
proc step {w fwd} {
global files
if $fwd {
set first [lindex $files 0]
set files [concat [lrange $files 1 end] [list $first]]
} else {
set first [lindex $files end]
set files [concat [list $first] [lrange $files 0 end-1]]
}
openImg $w $first
}
frame .f
button .f.open -text ... -command {set info [openImg .c]}
button .f.+ -text + -command {scale .c 2}
label .f.f -textvar factor -width 5 -bg white
button .f.- -text - -command {scale .c 0.5}
button .f.< -text < -command {set info [step .c 0]}
button .f.> -text > -command {set info [step .c 1]}
label .f.info -textvar info
eval pack [winfo children .f] -side left -fill y
canvas .c -xscrollcommand ".x set" -yscrollcommand ".y set"
scrollbar .x -ori hori -command ".c xview"
scrollbar .y -ori vert -command ".c yview"
grid .f - -sticky ew
grid .c .y -sticky news
grid .x -sticky ew
grid rowconfig . 1 -weight 1
grid columnconfig . 0 -weight 1
bind . <Escape> {exec wish $argv0 &; exit}
bind . ? {console show}