#!/usr/bin/wish -f

#
#   Main module of tkImg. A simple viewer with tcl/tk
#
#   (C) 1999 Juan J. Martinez Siguenza (reidrac@rocketmail.com)
#   See GPL for distribution and usage details.
#
#   I used TK8.0 (try other previous versions of TK and let me
#   know if it works).
#

# DON'T touch th following - use file preferences
set tkimg(path) "/root/tk/gui/resources"
catch { source /etc/.tkimgrc }

catch { source $tkimg(path)/help.tcl }

set tkimg(ver) "v0.2"
set tkimg(dir) "./"
set tkimg(open) ""
set tkimg(file) ""

set tkimg(width) ""
set tkimg(height) ""
set tkimg(type) ""

set tkimg(load) 0

# Create a menu bar for the app

frame .menubar -relief raised -border 2
pack .menubar -side top -fill x

menubutton .menubar.file -text File -underline 0 -menu .menubar.file.m
menubutton .menubar.image -text Image -underline 0 -menu .menubar.image.m
menubutton .menubar.help -text Help -underline 0 -menu .menubar.help.m

pack .menubar.file .menubar.image -side left
pack .menubar.help -side right

menu .menubar.file.m
.menubar.file.m add command -label "Open" -underline 0 \
-command { set tkimg(load) 0; set tkimg(open) ""; browse }
.menubar.file.m add command -label "Close" -underline 0 \
-command { destroy if exists .i; wm title . "tkImg $tkimg(ver)"
 set tkimg(load) 0 }
.menubar.file.m add separator
.menubar.file.m add command -label "Prefences" -underline 0 \
-command { pref }
.menubar.file.m add separator
.menubar.file.m add command -label "Exit" -underline 1 \
-command exit

menu .menubar.image.m
.menubar.image.m add command -label "Info" -underline 1 \
-command { imginfo }

menu .menubar.help.m
.menubar.help.m add command -label "About" -underline 0 \
-command aboutDlg
.menubar.help.m add separator
.menubar.help.m add command -label "Contents" -underline 0 \
-command help

frame .toolBar -relief raised -border 2
pack .toolBar -side top -fill x

button .toolBar.bopen -image [ image create photo -file\
 $tkimg(path)/open.gif ] -command { set tkimg(load) 0; \
set tkimg(open) ""; browse }
button .toolBar.binfo -image [ image create photo -file\
 $tkimg(path)/info.gif ] -command { imginfo }
pack .toolBar.bopen .toolBar.binfo -side left

wm title . "tkImg $tkimg(ver)"
wm minsize . 240 60

proc aboutDlg {} {

  global tkimg

  destroy if exists .dialogBox

  set about "tkImg $tkimg(ver)\n\nA simple viewer"
  set about "$about using Tcl/Tk.\nPlease report bugs"
  set about "$about and comments to:\n\n"
  set about "$about reidrac@rocketmail.com\n"
  set about "$about See GPL for distribution details.\n"

  toplevel .dialogBox

  frame .dialogBox.f -relief raised -border 2
  pack .dialogBox.f -side top -fill x

  label .dialogBox.f.img -image [ image create photo -file \
$tkimg(path)/logo.gif ]
  pack .dialogBox.f.img -side top

  label .dialogBox.f.aboutText -text $about
  pack .dialogBox.f.aboutText -side top

  frame .dialogBox.f.f2 -relief groove -border 2
  pack .dialogBox.f.f2 -side bottom -fill x

  button .dialogBox.f.f2.ok -text "Ok" -command {\
 destroy .dialogBox }
  pack .dialogBox.f.f2.ok

  wm title .dialogBox "About tkImg $tkimg(ver)"
  wm minsize .dialogBox 300 238
  wm maxsize .dialogBox 300 238
}

proc browse {} {
  global tkimg

  destroy .browseWin if exists
  toplevel .browseWin

  frame .browseWin.f0
  pack .browseWin.f0 -side top -fill x

  scrollbar .browseWin.f0.scroll -command ".browseWin.f0.list yview"
  pack .browseWin.f0.scroll -side right -fill y

  listbox .browseWin.f0.list -yscroll ".browseWin.f0.scroll set" \
-relief sunken -setgrid yes
  pack .browseWin.f0.list -side left -fill both -expand yes

  frame .browseWin.f
  pack .browseWin.f -side bottom -fill x

  button .browseWin.f.open -text Open -command {
foreach file [selection get] {
	set fwpath $tkimg(dir)/$file
	if ![file isdirectory $fwpath] {
		.browseWin.f.entry delete 0 end
		.browseWin.f.entry insert end $file
		if [string compare $fwpath $tkimg(open)]!=1 {
			set tkimg(open) $tkimg(dir)$file
			set tkimg(file) $file
			openimage
			destroy .browseWin
		}
		set tkimg(open) $tkimg(dir)$file
		set tkimg(file) $file
	} else {
		set tkimg(dir) $fwpath
		changedir
	}
  } 
}
  button .browseWin.f.cancel -text Cancel -command \
{ destroy .browseWin }

  entry .browseWin.f.entry

  pack .browseWin.f.entry -expand yes -side left
  pack .browseWin.f.open .browseWin.f.cancel -side left

  foreach file [exec ls -ap $tkimg(dir)] {
	.browseWin.f0.list insert end $file
  }

  .browseWin.f0.list selection set 0

  wm title .browseWin "Image browser"
  wm maxsize .browseWin 20 10
  wm minsize .browseWin 20 10

 bind .browseWin.f0.list <Double-Button-1> {foreach file [selection\
 get] {
	set fwpath $tkimg(dir)/$file
	if [file isdirectory $fwpath] {
		set tkimg(dir) $fwpath
		changedir
	} else {
		.browseWin.f.entry delete 0 end
		.browseWin.f.entry insert end $file
		set tkimg(open) $tkimg(dir)$file
		set tkimg(file) $file
	}
  }
}
}

proc changedir {} {
  global tkimg

  destroy .browseWin.f0.list

  listbox .browseWin.f0.list -yscroll ".browseWin.f0.scroll set" \
-relief sunken -setgrid yes
  pack .browseWin.f0.list -side left -fill both -expand yes

  foreach file [exec ls -ap $tkimg(dir)] {
	.browseWin.f0.list insert end $file
  }

  .browseWin.f0.list selection set 0

  bind .browseWin.f0.list <Double-Button-1> {foreach file [selection\
 get] {
	set fwpath $tkimg(dir)/$file
	if [file isdirectory $fwpath] {
		set tkimg(dir) $fwpath
		changedir
	} else {
		.browseWin.f.entry delete 0 end
		.browseWin.f.entry insert end $file
		set tkimg(open) $tkimg(dir)$file
		set tkimg(file) $file
	}
  }
}
}

proc openimage {} {
  global tkimg

  set tkimg(dir) "./"

  destroy if exists .i

  wm title . "tkImg $tkimg(ver) - '$tkimg(file)'"

  frame .i
  pack .i -fill both -expand yes

  scrollbar .i.sy -command ".i.im yview"
  pack .i.sy -side right  -fill y

  scrollbar .i.sx -orient horiz -command ".i.im xview"
  pack .i.sx -side bottom  -fill x

  if [catch {set nimage [image create photo -file $tkimg(open)]}] {
    error "\nUnknown graphic format or\nunsupported codec.\n\
See help for more details.\n\n"
    destroy .i
    return 0
  }

  set x [ expr [image width $nimage] / 2 ]
  set y [ expr [image height $nimage] /2 ]
  canvas .i.im -scrollregion "-$x -$y $x $y" -relief sunken -border 2
  pack .i.im -expand yes -fill both
  .i.im create image 0 0 -image $nimage

  .i.im configure -xscrollcommand ".i.sx set"
  .i.im configure -yscrollcommand ".i.sy set"

  set tkimg(width) [image width $nimage]
  set tkimg(height) [image width $nimage]
  set tkimg(type) [image type $nimage]

  set tkimg(load) 1
}

proc error { text } {

  destroy if exists .error

  toplevel .error

  frame .error.f0 -relief raised -border 2
  pack .error.f0 -side top -fill both -expand yes

  label .error.f0.mess -text $text
  pack .error.f0.mess

  frame .error.f1 -relief groove -border 2
  pack .error.f1 -side top -fill both -expand yes

  button .error.f1.ok -text Ok -command { destroy .error }
  pack .error.f1.ok

  wm title .error "tkImg Error"
}

proc imginfo {} {
  global tkimg

  destroy if exists .iinfo

  if [string compare $tkimg(load) "0"] {

  set text "$tkimg(file)   \n\n Width: $tkimg(width)\n"
  set text "$text Heigth: $tkimg(height)\n Type: $tkimg(type)\n"

  toplevel .iinfo

  frame .iinfo.f0 -relief raised -border 2
  pack .iinfo.f0 -side top -fill both -expand yes

  label .iinfo.f0.mess -text $text -justify left
  pack .iinfo.f0.mess

  frame .iinfo.f1 -relief groove -border 2
  pack .iinfo.f1 -side top -fill both -expand yes

  button .iinfo.f1.ok -text Ok -command { destroy .iinfo }
  pack .iinfo.f1.ok

  wm title .iinfo "Image Info"

  wm minsize .iinfo 120 134
  wm maxsize .iinfo 120 134
}
}

proc pref {} {
  global tkimg

  destroy if exists .preference

  set text "Res Path:"

  toplevel .preference

  frame .preference.f0 -relief raised -border 2
  pack .preference.f0 -side top -fill both -expand yes

  label .preference.f0.tx -text $text -justify right
  entry .preference.f0.en

  pack .preference.f0.tx .preference.f0.en -fill x -side left\
 -expand yes

  frame .preference.f1 -relief groove -border 2
  pack .preference.f1 -side top -fill both -expand yes

  button .preference.f1.ok -text Ok \
-command {
  set rc "# Path of resources for tkImg\n\nglobal tkimg\n"
  set rc "$rc set tkimg(path)" 
set rc "$rc [.preference.f0.en get]\n"; exec echo "$rc" > /etc/.tkimgrc
destroy .preference }
  pack .preference.f1.ok

  .preference.f0.en insert end $tkimg(path)

  wm title .preference "Preferences"

}
