1#!/bin/sh
2# The next line restarts using wish \
3exec wish $0 ${1+"$@"}
4
5package require msgcat
6::msgcat::mcload [file join [file dirname [info script]] msgs]
7catch {namespace import ::msgcat::mc}
8
9proc mmc string {
10    regsub & $string {} string
11    return $string
12}
13
14proc mml string {
15    return [string first & $string]
16}
17
18#
19# Make the Image format available.
20#
21
22package require Img
23
24#
25# Initialization of some global variables
26#
27
28set tkvPriv(count) 0
29set tkvPriv(currentdir) [pwd]
30set tkvPriv(defaultext) .gif
31
32set tkvPriv(types) [list \
33    [list [mc "Image Files"]	{.bmp}		] \
34    [list [mc "Image Files"]	{.gif}		] \
35    [list [mc "Image Files"]	{.jpeg .jpg}	] \
36    [list [mc "Image Files"]	{.png}		] \
37    [list [mc "Image Files"]	{.tiff .tif}	] \
38    [list [mc "Image Files"]	{.xbm}		] \
39    [list [mc "Image Files"]	{.xpm}		] \
40    [list [mc "Image Files"]	{.ps .eps}		] \
41    [list "BMP [mc Files]"		{.bmp}		] \
42    [list "GIF [mc Files]"		{.gif}		] \
43    [list "JPEG [mc Files]"		{.jpeg .jpg}	] \
44    [list "PNG [mc Files]"		{.png}		] \
45    [list "TIFF [mc Files]"		{.tiff .tif}	] \
46    [list "XBM [mc Files]"		{.xbm}		] \
47    [list "XPM [mc Files]"		{.xpm}		] \
48    [list "Postscript [mc Files]"	{.ps .eps}		] \
49    [list "GIF [mc Files]"		{}			GIFF] \
50    [list "JPEG [mc Files]"		{}			JPEG] \
51    [list "PNG [mc Files]"		{}			PNGF] \
52    [list "TIFF [mc Files]"		{}			TIFF] \
53    [list [mc {All files}]		*] \
54]
55
56proc Menu {base name} {
57    set menu [ConCat $base menu]
58    if {![winfo exists $menu]} {
59	menu $menu
60	$base configure -menu $menu
61    }
62    set accelerator [string toupper [string index $name 0]]
63    set text [mc "&$accelerator[string range $name 1 end]"]
64    set name $menu.$name
65    if {![winfo exists $name]} {
66	menu $name
67	$menu add cascade -label [mmc $text] -menu $name -underline [mml $text]
68    }
69    return $name
70}
71
72#
73# Small proc to concatenate window pathnames
74#
75proc ConCat args {
76    regsub -all {[ 	\.]+} $args . args
77    return $args
78}
79
80#
81#  Create a new image window
82#
83
84proc image_window {{window {}}} {
85    global tkvPriv
86    if {![string compare $window {}]} {
87	set window .image$tkvPriv(count)
88	incr tkvPriv(count)
89    }
90    if {[winfo exists $window]} {
91	catch {eval destroy [winfo children $window]}
92    } else {
93	toplevel $window
94    }
95    wm title $window [mc {Viewer}]
96    set frame [ConCat $window frame]
97    label $frame -relief sunken -bg white -bd 2 -anchor nw
98    set w [Menu $window file]
99    $w configure -tearoff 0
100    set text [mc &Open]
101    $w add command -label [mmc $text] -command [list load_image $window] -underline [mml $text]
102    set text [mc &Save]
103    $w add command -label [mmc $text] -command [list save_image $window] -underline [mml $text]
104    $w add separator
105    set text [mc &Close]
106    $w add command -label [mmc $text] -command [list destroy $window] -underline [mml $text]
107    set text [mc E&xit]
108    $w add command -label [mmc $text] -command [list destroy .] -underline [mml $text]
109
110    set w [Menu $window images]
111    set w [Menu $window help]
112    $w configure -tearoff 0
113    set text [mc &About]
114    $w add command -label [mmc $text] -command About -underline [mml $text]
115
116    catch {wm geometry $window 200x200}
117    pack $frame -side top -expand y -fill both
118    return $frame
119}
120
121proc register_image {w name} {
122    set menu [Menu $w images]
123    set item [file tail [lindex $name 0]]
124    if {[llength $name] > 1} {
125	append item " [lindex $name 1]"
126    }
127    $menu add command -label $item -command \
128	[list show_image $w $name]
129}
130
131proc show_image {window name} {
132    [ConCat $window frame] configure -image $name
133    catch {wm geometry $window {}}
134}
135
136proc load_image window {
137    global tkvPriv
138    set filename [tk_getOpenFile -filetypes $tkvPriv(types) -parent \
139	    $window -initialdir $tkvPriv(currentdir)]
140    if {[string compare $filename {}]} {
141	set imagename [list $filename]
142	image create photo $imagename -file $filename
143	register_image $window $imagename
144	show_image $window $imagename
145	set tkvPriv(currentdir) [file dirname $filename]
146    }
147}
148
149proc save_image window {
150    global tkvPriv
151    set img [[ConCat $window frame] cget -image]
152    set filename [tk_getSaveFile -filetypes $tkvPriv(types) -parent \
153	    $window -initialdir $tkvPriv(currentdir) -defaultextension .gif \
154	    -initialfile [file rootname [lindex $img 0]].gif]
155    if {[string compare $filename {}]} {
156	$img write $filename -format gif
157	set tkvPriv(currentdir) [file dirname $filename]
158    }
159}
160
161proc About {} {
162    tk_dialog .about "[mmc [mc &About]] tkv.tcl" "[mc {Tiny Image viewer}]\n[mc {written by}]\
163	    Jan Nijtmans <nijtmans@users.sourceforge.net>" {} 0 [mc O.K.]
164}
165
166set w [lindex $argv 1]
167if {![string compare $w {}]} {
168    set w .
169}
170set filename [lindex $argv 0]
171
172image_window $w
173if {[string compare $filename {}]} {
174    set imagename [list $filename]
175    image create photo $imagename -file $filename
176    register_image $w $imagename
177    show_image $w $imagename
178}
179