A little image viewer
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...
escargo 15 Apr 2003 - This a charming application, but (you knew there was going to be a but) the label for the button to zoom out (the minus sign) is really, really small in the font used on my Windows XP (ActiveTcl) 8.4.1 installation (and the jpg file as well). Is there an easy change that would make the zoom in, zoom out more clear to the users?
I also suggest factoring out the lsort [glob ...] so that it will always produce the same result in two different places.
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}Chris L (11/08/2004) Just discovered this whilst investigating something else... Anyway, as it stands, if you change direction as you cycle through the images, the first movement in the new direction doesn't happen. In the extreme case, you can click left, right, left, right and never go anywhere. I changed 'step', and added a current position and file count to fix it:-
set currentImg 0
set filecount [llength $files]
proc step {w fwd} {
global files currentImg filecount
global files currentImg filecount
set currentImg [expr {($currentImg + ($fwd ? 1 : -1)) % $filecount}]
set currentImg [expr {($currentImg + ($fwd ? 1 : -1)) % $filecount}]
openImg $w [lindex $files $currentImg]
}For the pocket edition, see imgview as eTcl plugin
HoMi-(2008-12-01) Sorry Chris, but your "solution" produces an "Division by zero" error any time the proc 'step' is called. The reason therefore is that it determines the length of the list of files at startup time of the script and at this time the list length is always null.
But btw. there is no need to implement an image counter or anything else. Richards original step proc was the right way. This proc has only one little error, that is that this proc determines the first element of the files list before it makes the list rotation. By changing the last line of the original proc from
openImg $w $first
to
openImg $w [lindex $files 0]
the proc works always correct in any cycle direction.
mwilhelmy 2012-08-17
Based on the code above, I wrote uiv , a small image viewer.