imgview as eTcl plugin

Richard Suchenwirth 2006-02-10 - Here is a little image viewer, mildly twoken to run well in Sepp (using eTcl on PocketPC). It allows to view images at various zoom/subsample factors, as well as step through the current directory (with the "<" and ">" buttons).

WikiDbImage imgview.jpg

Care was taken that the script can both be tested stand-alone on a desktop, with the Img package, while on the little thing it uses the Pixane library.

 if [catch {package require pixane}] {
   package require Img
   interp alias {} mkphoto {} image create photo -file
 } else {
   interp alias {} mkphoto {} piximg
 namespace eval imgview { 
    variable factor 1.0
    variable types {*.gif *.jpg *.png *.xbm *.xpm}

 proc openImg {w {fn ""}} {
    variable files; variable types
    variable im1; variable dir
    if {$fn eq ""} {
        set fn [tk_getOpenFile -filetypes [list [list "All files" $types]]]
        if {$fn ne ""} {
           set dir [file dirname $fn]
           set files [lsort [eval glob -dir [list $dir] -nocomplain $types]]
    if {$fn ne ""} {
        wm title $w [file tail $fn]
        catch {image delete $im1}
        set im1 [mkphoto $fn]
        scale $w.c
        list [file size $fn] bytes, [image width $im1]x[image height $im1]
 proc scale {w {n 1}} {
        variable im1; variable im2; variable 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} {
        variable files; variable dir
        if ![info exists files] {
           set files [lsort [eval glob -nocomplain -dir [list $dir] $types]]
        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

#------ exported proc

 proc imgview {{filename ""}} {
   set w .iv 
   if ![winfo exists $w] {
      toplevel $w
      wm geometry $w 240x268
      frame  $w.f
      button $ -text ... -command "imgview::openImg $w.c"
      button $w.f.+ -text +      -command "imgview::scale $w.c 2"
      label  $w.f.f -textvar imgview::factor -width 5 -bg white
      button $w.f.- -text " - "  -command "imgview::scale $w.c 0.5"
      button $w.f.< -text <      -command "imgview::step $w 0"
      button $w.f.> -text >      -command "imgview::step $w 1"
      label  $ -textvar info
      eval pack [winfo children $w.f] -side left -fill y

      canvas $w.c -xscrollcommand "$w.x set" -yscrollcommand "$w.y set"
      scrollbar $w.x -ori hori -command "$w.c xview"
      scrollbar $w.y -ori vert -command "$w.c yview"

      grid $w.f -    -sticky ew
      grid $w.c $w.y -sticky news
      grid $w.x      -sticky ew
      grid rowconfig    $w 1 -weight 1
      grid columnconfig $w 0 -weight 1

      bind $w <Up>   "imgview::scale $w.c 2"
      bind $w <Down> "imgview::scale $w.c 0.5"
   imgview::openImg $w $filename
   wm deiconify $w; focus -force $w
 if {[file tail [info script]] eq [file tail $argv0]} {
   wm withdraw .
   bind all <Escape> {exec wish $argv0 &; exit}

Category Development - Category Graphics