Version 11 of 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

        set currentImg [expr {($currentImg + ($fwd ? 1 : -1)) % $filecount}]

        openImg $w [lindex $files $currentImg]
 }

For the pocket edition, see imgview as eTcl plugin

Arts and crafts of Tcl-Tk programming | Category Application | Category Whizzlet | Category File