2 package require tk 8.4.9
3 package require jpeg 0.2
4 proc make_image {filename desiredSize {width 0} {height 0}} {
6 foreach {width height} [::jpeg::dimensions $filename] break
8 if {$width > $height} {
14 while {$dim>$scale*$desiredSize} {
17 set f [open "|djpeg -fast -scale 1/$scale $filename"]
18 fconfigure $f -translation binary
21 return [image create photo -data $data]
24 proc get_data {filename var} {
26 catch {array set data [jpeg::formatExif [::jpeg::getExif $filename]]}
27 set data(Comment) [join [encoding convertfrom [::jpeg::getComments $filename]] "\n"]
28 foreach {data(Width) data(Height)} [::jpeg::dimensions $filename] break
31 proc rotate {filename angle} {
32 if {[lsearch {90 180 270} $angle]==-1} {
33 return -code error "Invalid rotation angle - should be multiple of 90"
35 exec exiftran -[string range $angle 0 0] -i $filename 2>/dev/null
38 proc set_comment {filename comment} {
40 ::jpeg::replaceComment $filename [encoding convertto $comment]
43 proc getname {index} {
45 return [lindex $filelist $index]
48 proc clearExecBit {filename} {
49 if {[file executable $filename]} {
50 file attributes $filename -permissions -x
55 proc set_file {index} {
56 global filecount filename exifdata filelist
57 if {[info exists filename]} {
60 set buttonSize [expr [option get . imageSize ImageSize]/2]
61 set filename [getname $index]
62 clearExecBit $filename
63 if {[regexp -nocase {img_(\d+)\.jpg} $filename => number]} {
64 set audio snd_${number}.wav
65 if {![file exists $audio]} {
66 set audio [string toupper $audio]
67 if {![file exists $audio]} {
72 if {[info exists audio]} {
73 puts "Found audiofile $audio"
75 .info.sound configure -state normal -command [list exec play $audio]
77 .info.sound configure -state disabled
80 .preview.prev configure -state disabled -image {}
82 .preview.prev configure -state normal\
83 -image [make_image [lindex $filelist [expr $index-1]] $buttonSize]
85 if {$index == $filecount-1} {
86 .preview.next configure -state disabled -image {}
88 .preview.next configure -state normal\
89 -image [make_image [lindex $filelist [expr $index+1]] $buttonSize]
91 .info.filename configure -text "$filename ([expr $index+1]/$filecount)"
92 array set exifdata [::jpeg::formatExif [::jpeg::getExif $filename]]
93 if {[info exists exifdata(DateTime)]} {
94 set tm $exifdata(DateTime)
98 .info.exif configure -state normal
99 .info.exif delete 0.0 end
100 foreach {key value} [array get exifdata] {
101 if {$key == "MakerNote"} break
102 if {$key == "UserComment"} {
103 set value [string trim $value "\0"]
105 .info.exif insert end $key key "\t: $value\n" {}
107 .info.datetime configure -text "Date: $tm"
108 foreach {width height} [jpeg::dimensions $filename] break
109 show_image $filename $width $height
110 .info.comment delete 0.0 end
111 .info.comment insert 0.0 [encoding convertfrom [join [jpeg::getComments $filename] "\n"]]
112 .info.comment edit reset
113 .info.comment edit modified n
116 proc delete_file {index} {
117 global filename filelist filecount
118 if {[tk_messageBox -message "Really delete file $filename" -type yesno -title\
119 Confirm -icon warning] != "yes"} {
123 file delete $filename
124 .info.comment edit reset
125 .info.comment edit modified n
127 if {$index == $filecount-1} {
129 set filelist [lrange $filelist 0 [expr $index-1]]
133 set filelist [lreplace $filelist $index $index]
139 proc rotateGUI {filename angle} {
141 rotate $filename $angle
145 proc show_image {filename {width 0} {height 0}} {
148 foreach {width height} [jpeg::dimensions $filename] break
150 set img [make_image $filename [option get . imageSize ImageSize] $width $height]
151 .preview.l configure -image $img
152 foreach img [image names] {
153 if { ![string match ::tk::* $img]&& ![image inuse $img]} {
157 .info.size configure -text "Size: ${width}x$height"
160 proc save_file_info {} {
162 if {![.info.comment edit modified]} {
165 set_comment $filename [string trim [.info.comment get 0.0 end] "\n"]
169 # Interface construction
171 option add *Text.Font -rfx-courier-medium-r-normal--12-120-75-75-m-70-iso10646-1
172 option add *Font -rfx-times-bold-r-normal--12-120-75-75-p-67-iso10646-1 widgetDefault
173 image create bitmap speaker -data {
174 #define speaker_width 24
175 #define speaker_height 24
176 static unsigned char speaker_bits[] = {
177 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x10, 0x00,
178 0x00, 0x24, 0x00, 0x00, 0x49, 0x00, 0x80, 0x51, 0x00, 0xc0, 0x91, 0x00,
179 0xe7, 0xa5, 0x00, 0xf7, 0xa5, 0x00, 0xff, 0x29, 0x01, 0xff, 0x49, 0x01,
180 0xff, 0x49, 0x01, 0xff, 0x29, 0x01, 0xf7, 0xa9, 0x00, 0xe7, 0xa5, 0x00,
181 0xc0, 0x95, 0x00, 0x80, 0x51, 0x00, 0x00, 0x49, 0x00, 0x00, 0x24, 0x00,
182 0x00, 0x10, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
186 label .info.filename -width 32 -anchor w
187 button .info.rotateleft -text "90\u00b0" -command {rotateGUI [getname $current] 90}
188 button .info.rotateright -text "270\u00b0" -command {rotateGUI [getname $current] 270}
189 button .info.upsidedown -text "180\u00b0" -command {rotateGUI [getname $current] 180}
190 button .info.delete -text "Delete" -command {delete_file $current}
191 label .info.size -text "Size:" -anchor w
192 label .info.datetime -text "Date:" -anchor w
193 text .info.exif -height 20 -width 40 -state disabled -yscrollcommand ".info.yexif set" -tabs {3c}
194 text .info.comment -width 40 -height 5 -undo y -wrap word -yscrollcommand ".info.ycomment set"
195 scrollbar .info.yexif -orient vert -command ".info.exif yview"
196 scrollbar .info.ycomment -orient vert -command ".info.comment yview"
197 button .info.sound -state disabled -image speaker
198 frame .preview -width 200 -height 200
199 button .preview.next -text ">>" -command {set_file [incr current]}
200 button .preview.prev -text "<<" -command {set_file [incr current -1]} -state disabled
205 grid .info.filename - - - - - -sticky news
206 grid .info.rotateleft .info.upsidedown .info.rotateright .info.sound .info.delete -
207 grid .info.size - - - -sticky news
208 grid .info.datetime - - - -sticky news
209 grid .info.exif - - - - .info.yexif -sticky news
210 grid .info.comment - - - - .info.ycomment -sticky news
211 grid rowconfigure .info 5 -weight 1
212 grid columnconfigure .info 4 -weight 1
214 grid .preview.prev .preview.next -sticky news
215 grid .preview.l - -sticky news
216 grid rowconfigure .preview 1 -weight 1
217 grid columnconfigure .preview 0 -weight 1
218 grid columnconfigure .preview 1 -weight 1
219 grid .info .preview -sticky news
221 wm protocol . WM_DELETE_WINDOW {save_file_info;destroy .}
223 bind .info.comment <Next> {.preview.next invoke}
224 bind .info.comment <Prior> {.preview.prev invoke}
225 bind .info.comment <Control-q> {eval [wm protocol . WM_DELETE_WINDOW]}
226 option add [winfo class .].imageSize 400 widgetDefault
228 if {[llength $argv]>1} {
229 puts stderr "Usage $argv0 [image-file]"
231 set filelist [lsort -dictionary [concat [glob -nocomplain *.jpg] [glob -nocomplain *.JPG]]]
233 set filecount [llength $filelist]
235 puts stderr "No image files in the current directory!"
238 if {[llength $argv]} {
239 set current [lsearch $filelist [lindex $argv 0]]
240 if {$current == -1} {
241 puts stderr "File $argv not found in the current dir\n"