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 if {$index == $filecount-1} {
126 set filelist [lrange $filelist 0 [expr $index-1]]
130 set filelist [lreplace $filelist $index $index]
136 proc rotateGUI {filename angle} {
138 rotate $filename $angle
142 proc show_image {filename {width 0} {height 0}} {
145 foreach {width height} [jpeg::dimensions $filename] break
147 set img [make_image $filename [option get . imageSize ImageSize] $width $height]
148 .preview.l configure -image $img
149 foreach img [image names] {
150 if { ![string match ::tk::* $img]&& ![image inuse $img]} {
154 .info.size configure -text "Size: ${width}x$height"
157 proc save_file_info {} {
159 if {![.info.comment edit modified]} {
162 set_comment $filename [string trim [.info.comment get 0.0 end] "\n"]
166 # Interface construction
168 option add *Text.Font -rfx-courier-medium-r-normal--12-120-75-75-m-70-iso10646-1
169 option add *Font -rfx-times-bold-r-normal--12-120-75-75-p-67-iso10646-1 widgetDefault
170 image create bitmap speaker -data {
171 #define speaker_width 24
172 #define speaker_height 24
173 static unsigned char speaker_bits[] = {
174 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x10, 0x00,
175 0x00, 0x24, 0x00, 0x00, 0x49, 0x00, 0x80, 0x51, 0x00, 0xc0, 0x91, 0x00,
176 0xe7, 0xa5, 0x00, 0xf7, 0xa5, 0x00, 0xff, 0x29, 0x01, 0xff, 0x49, 0x01,
177 0xff, 0x49, 0x01, 0xff, 0x29, 0x01, 0xf7, 0xa9, 0x00, 0xe7, 0xa5, 0x00,
178 0xc0, 0x95, 0x00, 0x80, 0x51, 0x00, 0x00, 0x49, 0x00, 0x00, 0x24, 0x00,
179 0x00, 0x10, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
183 label .info.filename -width 32 -anchor w
184 button .info.rotateleft -text "90\u00b0" -command {rotateGUI [getname $current] 90}
185 button .info.rotateright -text "270\u00b0" -command {rotateGUI [getname $current] 270}
186 button .info.upsidedown -text "180\u00b0" -command {rotateGUI [getname $current] 180}
187 button .info.delete -text "Delete" -command {delete_file $current}
188 label .info.size -text "Size:" -anchor w
189 label .info.datetime -text "Date:" -anchor w
190 text .info.exif -height 20 -width 40 -state disabled -yscrollcommand ".info.yexif set" -tabs {3c}
191 text .info.comment -width 40 -height 5 -undo y -wrap word -yscrollcommand ".info.ycomment set"
192 scrollbar .info.yexif -orient vert -command ".info.exif yview"
193 scrollbar .info.ycomment -orient vert -command ".info.comment yview"
194 button .info.sound -state disabled -image speaker
195 frame .preview -width 200 -height 200
196 button .preview.next -text ">>" -command {set_file [incr current]}
197 button .preview.prev -text "<<" -command {set_file [incr current -1]} -state disabled
202 grid .info.filename - - - - - -sticky news
203 grid .info.rotateleft .info.upsidedown .info.rotateright .info.sound .info.delete -
204 grid .info.size - - - -sticky news
205 grid .info.datetime - - - -sticky news
206 grid .info.exif - - - - .info.yexif -sticky news
207 grid .info.comment - - - - .info.ycomment -sticky news
208 grid rowconfigure .info 5 -weight 1
209 grid columnconfigure .info 4 -weight 1
211 grid .preview.prev .preview.next -sticky news
212 grid .preview.l - -sticky news
213 grid rowconfigure .preview 1 -weight 1
214 grid columnconfigure .preview 0 -weight 1
215 grid columnconfigure .preview 1 -weight 1
216 grid .info .preview -sticky news
218 wm protocol . WM_DELETE_WINDOW {save_file_info;destroy .}
220 bind .info.comment <Next> {.preview.next invoke}
221 bind .info.comment <Prior> {.preview.prev invoke}
222 bind .info.comment <Control-q> {eval [wm protocol . WM_DELETE_WINDOW]}
223 option add [winfo class .].imageSize 400 widgetDefault
225 if {[llength $argv]>1} {
226 puts stderr "Usage $argv0 [image-file]"
228 set filelist [lsort -dictionary [concat [glob -nocomplain *.jpg] [glob -nocomplain *.JPG]]]
230 set filecount [llength $filelist]
232 puts stderr "No image files in the current directory!"
235 if {[llength $argv]} {
236 set current [lsearch $filelist [lindex $argv 0]]
237 if {$current == -1} {
238 puts stderr "File $argv not found in the current dir\n"