##
## jpeg-view.tcl
## ---------------------------------------------------------
## 「あなたのTkを多画像フォーマット対応に」PIFE拡張
##  (http://www.geocities.jp/urano343/dir4/tkimgfmt.html)
## (uranoさん作成)を使った Tcl/Tk スクリプトの自分用見本
## ---------------------------------------------------------
load /Apps/usr-local/TkLib/libpife

set img_dname {}

set types {
  { "JPEG"  {.jpg}  }
  { "JPEG"  {.jpeg}  }
  { "All Files"  * }
}

frame .f
pack .f

button .bq -text "Quit" -command { exit }
pack .bq -side right -in .f

button .bo -text "Open" -command { my_open }
pack .bo -side left -in .f

image create photo myjpeg
image create photo myjpegt
button .b -image myjpeg -command { 
  toplevel .dlg
  wm deiconify .dlg
  wm protocol .dlg WM_DELETE_WINDOW { destroy .dlg }
  button .dlg.img -image myjpegt -command { destroy .dlg }
  after 3000 { destroy .dlg }
  pack .dlg.img -in .dlg
}
pack .b

proc my_main { } {
  global types; global img_dname
  set img_fname [tk_getOpenFile -filetype $types -title "Open" -initialdir $img_dname ]

  if { 0 < [string length $img_fname ] } {
    image create photo myjpegt -format myjpeg -file $img_fname
    set jpw [image width myjpegt]
    set jpwscale [expr 120.0 / $jpw ]
    set img_dname [file dirname $img_fname]

    image delete myjpeg; image create photo myjpeg
    imgfmtex read myjpeg $img_fname -format jpeg -xyscale $jpwscale
    ##  -width 88 -height 66
  
    #label .l -text "width: $jpw ($jpwscale)"
    #pack .l
  }
}

proc my_open { } {
  my_main
}
my_main