#!/bin/sh
# The next line restarts using wish8.1 \
exec wish8.1 $0 ${1+"$@"}

#
# Make the Image format available.
#

package require Img

#
# Initialization of some global variables
#

set tkvPriv(count) 0
set tkvPriv(currentdir) [pwd]
set tkvPriv(defaultext) .gif

set tkvPriv(types) {
    {"Image Files"	{.bmp}		}
    {"Image Files"	{.gif}		}
    {"Image Files"	{.jpeg .jpg}	}
    {"Image Files"	{.png}		}
    {"Image Files"	{.tiff .tif}	}
    {"Image Files"	{.xbm}		}
    {"Image Files"	{.xpm}		}
    {"Image Files"	{.ps .eps}		}
    {"BMP Files"		{.bmp}		}
    {"GIF Files"		{.gif}		}
    {"JPEG Files"		{.jpeg .jpg}	}
    {"PNG Files"		{.png}		}
    {"TIFF Files"		{.tiff .tif}	}
    {"XBM Files"		{.xbm}		}
    {"XPM Files"		{.xpm}		}
    {"Postscript Files"	{.ps .eps}		}
    {"GIF Files"		{}			GIFF}
    {"JPEG Files"		{}			JPEG}
    {"PNG Files"		{}			PNGF}
    {"TIFF Files"		{}			TIFF}
    {"All files"		*}
}

proc Menu {base name} {
    set menu [ConCat $base menu]
    if {![winfo exists $menu]} {
	menu $menu
	$base configure -menu $menu
    }
    set accelerator [string toupper [string index $name 0]]
    set text $accelerator[string range $name 1 end]
    set name $menu.$name
    if {![winfo exists $name]} {
	menu $name
	$menu add cascade -label $text -menu $name -underline 0
    }
    return $name
}

#
# Small proc to concatenate window pathnames
#
proc ConCat args {
    regsub -all {[ 	\.]+} $args . args
    return $args
}

#
#  Create a new image window
#

proc image_window {{window {}}} {
    global tkvPriv
    if {![string compare $window {}]} {
	set window .image$tkvPriv(count)
	incr tkvPriv(count)
    }
    if {[winfo exists $window]} {
	catch {eval destroy [winfo children $window]}
    } else {
	toplevel $window
    }
    set frame [ConCat $window frame]
    label $frame -relief sunken -bg white -bd 2 -anchor nw
    set w [Menu $window file]
    $w configure -tearoff 0
    $w add command -label Open -command [list load_image $window] -underline 0
    $w add command -label Save -command [list save_image $window] -underline 0
    $w add separator
    $w add command -label Close -command [list destroy $window] -underline 0
    $w add command -label Exit -command [list destroy .] -underline 0

    set w [Menu $window images]
    set w [Menu $window help]
    $w configure -tearoff 0
    $w add command -label About -command About -underline 0

    catch {wm geometry $window 200x200}
    pack $frame -side top -expand y -fill both
    return $frame
}

proc register_image {w name} {
    set menu [Menu $w images]
    set item [file tail [lindex $name 0]]
    if {[llength $name] > 1} {
	append item " [lindex $name 1]"
    }
    $menu add command -label $item -command \
	[list show_image $w $name]
}

proc show_image {window name} {
    [ConCat $window frame] configure -image $name
    catch {wm geometry $window {}}
}

proc load_image window {
    global tkvPriv
    set filename [tk_getOpenFile -filetypes $tkvPriv(types) -parent \
	    $window -initialdir $tkvPriv(currentdir)]
    if {[string compare $filename {}]} {
	set imagename [list $filename]
	image create photo $imagename -file $filename
	register_image $window $imagename
	show_image $window $imagename
	set tkvPriv(currentdir) [file dirname $filename]
    }
}

proc save_image window {
    global tkvPriv
    set img [[ConCat $window frame] cget -image]
    set filename [tk_getSaveFile -filetypes $tkvPriv(types) -parent \
	    $window -initialdir $tkvPriv(currentdir) -defaultextension .gif \
	    -initialfile [file rootname [lindex $img 0]].gif]
    if {[string compare $filename {}]} {
	$img write $filename -format gif
	set tkvPriv(currentdir) [file dirname $filename]
    }
}

proc About {} {
    tk_dialog .about "tkv.tcl" "tkv.tcl: Tiny Image viewer
written by Jan Nijtmans <Jan.Nijtmans@wxs.nl>" \
{} 0 O.K.
}

set w [lindex $argv 1]
if {![string compare $w {}]} {
    set w .
}
set filename [lindex $argv 0]

image_window $w
if {[string compare $filename {}]} {
    set imagename [list $filename]
    image create photo $imagename -file $filename
    register_image $w $imagename
    show_image $w $imagename
}
