--- /dev/null
+#!/usr/bin/perl
+use constant THUMBSIZE => 150;
+use constant COLUMNS=>5;
+use constant THUMBDIR=>".thumbs";
+use constant INLINESIZE=> 600;
+use constant INLINEDIR=>".inline";
+use Image::Info qw(image_info dim);
+use Cwd;
+use Getopt::Std;
+
+=head1 NAME
+
+imagedir - generates HTML index for directory of pictures.
+
+=head1 SINOPSIS
+
+imagedir [-f] [B<-n>] [B<-l>] [B<-t> I<title>]
+
+=head1 DESCRIPTION
+
+Generates two hidden subdirs under current directory - B<.thumbs> and
+B<.inlines> with smaller copies of the images and generates
+B<index.html> with small (fit in the square 150x150) copies of the
+images as table.
+
+Each image is a link to generated HTML page with bigger (fit into
+600x600) copy of the image and (unless supressed) link to full sized
+image. If image contain JPEG or GIF comment, comment is inserted into
+HTML.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-f>
+
+ Don't use filenames as headers of individual picture page
+
+=item B<-l>
+
+Supress link to fullsized images
+
+=item B<-n>
+
+If specified, all links in B<index.html> would have target="_blank"
+attribute.
+
+=item B<-t> I<string>
+
+Title. If none given, directory name is used.
+
+=back
+
+=cut
+
+use vars qw($opt_t $opt_n $opt_l $opt_f);
+getopts("t:lnf");
+
+my $dir = $opt_t || (split ("/",cwd()))[-1];
+mkdir THUMBDIR if (! -d THUMBDIR);
+mkdir INLINEDIR if (! -d INLINEDIR);
+my $i=0;
+open OUT,">index.html";
+print OUT "<HTML><HEAD><TITLE>$dir</TITLE>\n<BODY>\n<H1>$dir</H1>\n"
+."<p align=\"center\"><A HREF=\"..\">back</A></p>".
+ "<TABLE CELLSPACING=10 CELLPADDING=0 BORDER=0>\n";
+my @piclist=(<*.jpg>,<*.gif>,<*.png>) ;
+print STDERR "@piclist\n";
+my ($prev,$next);
+for ($j=0;$j<=$#piclist;$j++) {
+ $_ = $piclist[$j];
+ $prev = $piclist[$j-1] if $j>0;
+ if ($j<$#piclist) {
+ $next = $piclist[$j+1];
+ } else {
+ $next = undef;
+ }
+ print STDERR "$j:$_";
+ my $info = image_info($_);
+ my $thumbname=rescale($_,THUMBDIR,THUMBSIZE,$info);
+ my $inlinename=rescale($_,INLINEDIR,INLINESIZE,$info);
+ my $comment = make_comment_html($info);
+ my ($w,$h) = dim(image_info(THUMBDIR."/$_"));
+ print OUT "<tr>\n" if ($i % COLUMNS == 0);
+ print OUT "<td valign=top align=center><a href=\"$_.html\"",($opt_n?"
+ target=\"_blank\"":""),"><img border=0 width=$w height=$h src=\"$thumbname\"></a><br>$comment</td>\n";
+ print OUT "</tr>\n" if (++$i % COLUMNS == 0);
+ print STDERR " html...";
+ make_html($_,$info,$comment,$inlinename);
+ print STDERR "\b\b\b done";
+ print STDERR "\n";
+
+}
+print OUT "</tr>\n" unless ($i % COLUMNS == 0);
+print OUT "</table></body></html>\n";
+close OUT;
+
+sub rescale {
+ my ($name,$out_dir,$maxsize,$info) = @_;
+ my ($w,$h) = dim($info);
+ if ($w<$maxsize && $h<$maxsize) {
+ #picture is small enough to be used without rescaling
+ return $name;
+ }
+ my $result = "$out_dir/$name";
+ if ( ! -f $result || -M $name < -M $result) {
+ print STDERR " $out_dir...";
+
+ system "convert", "-geometry", $maxsize."x".$maxsize,$_,$result;
+ print STDERR "\b\b\b ";
+ }
+ return $result;
+}
+
+sub make_comment_html {
+ my $info = shift;
+my $comment =
+
+ ref($info->{"Comment"})?join("\n",@{$info->{"Comment"}}):$info->{"Comment"};
+ $comment =~s/\&/&/;
+ $comment =~s/"/"/;
+ $comment =~s/>/>/;
+ $comment =~s/</</;
+ return $comment;
+}
+
+sub make_html {
+ my $imgfile = shift;
+ my $info = shift;
+ my $comment = shift;
+ my $inline = shift;
+ open HTML, ">$imgfile.html";
+ my ($w,$h) = dim($info);
+ my ($w1,$h1) = dim(image_info(INLINEDIR."/".$imgfile));
+ print HTML "<html><head><title>$dir:$imgfile</title></head><body>
+<h2>$dir</h2>",($opt_f?"":"<h1>$imgfile</h1>"),(defined($info->{'DateTime'})?"<p
+class=\"timestamp\">Time: $info->{'DateTime'}</p>":""),"<p>$comment</p>",
+"<img src=\"".$inline."\" width=$w1 height=$h1>",
+"<br clear=all><hr>
+
+<hr>
+<table width=100%><tr><td align=left>
+",($prev?"<a href=\"$prev.html\"><<</a>":" "),
+"</td><td align=center><a href=\".\">Up</A></td><td align=right>\n",
+,($next?"<a href=\"$next.html\">>></a>":" "),
+"</td></tr></table>\n",
+($opt_l?"":"<a href=\"$imgfile\">$imgfile ($w x $h)</a>"),"
+</body></html>
+";
+close HTML;
+}
+
+sub fix_html {
+ my $imgfile = shift;
+ unlink "$imgfile.html";
+ make_html($imgfile);
+}
--- /dev/null
+#!/usr/bin/wish
+package require tk 8.4.9
+package require jpeg 0.2
+proc make_image {filename desiredSize {width 0} {height 0}} {
+ if {$width == 0} {
+ foreach {width height} [::jpeg::dimensions $filename] break
+ }
+ if {$width > $height} {
+ set dim $width
+ } else {
+ set dim $height
+ }
+ set scale 1
+ while {$dim>$scale*$desiredSize} {
+ incr scale
+ }
+ set f [open "|djpeg -fast -scale 1/$scale $filename"]
+ fconfigure $f -translation binary
+ set data [read $f]
+ close $f
+ return [image create photo -data $data]
+}
+
+proc get_data {filename var} {
+ upvar $var data
+ catch {array set data [jpeg::formatExif [::jpeg::getExif $filename]]}
+ set data(Comment) [join [encoding convertfrom [::jpeg::getComments $filename]] "\n"]
+ foreach {data(Width) data(Height)} [::jpeg::dimensions $filename] break
+}
+
+proc rotate {filename angle} {
+ if {[lsearch {90 180 270} $angle]==-1} {
+ return -code error "Invalid rotation angle - should be multiple of 90"
+ }
+ exec exiftran -[string range $angle 0 0] -i $filename 2>/dev/null
+}
+
+proc set_comment {filename comment} {
+ puts $filename
+ ::jpeg::replaceComment $filename [encoding convertto $comment]
+}
+
+proc getname {index} {
+ global filelist
+ return [lindex $filelist $index]
+}
+
+proc clearExecBit {filename} {
+ if {[file executable $filename]} {
+ file attributes $filename -permissions -x
+ }
+
+}
+
+proc set_file {index} {
+ global filecount filename exifdata filelist
+ if {[info exists filename]} {
+ save_file_info
+ }
+ set buttonSize [expr [option get . imageSize ImageSize]/2]
+ set filename [getname $index]
+ clearExecBit $filename
+ if {[regexp -nocase {img_(\d+)\.jpg} $filename => number]} {
+ set audio snd_${number}.wav
+ if {![file exists $audio]} {
+ set audio [string toupper $audio]
+ if {![file exists $audio]} {
+ unset audio
+ }
+ }
+ }
+ if {[info exists audio]} {
+ puts "Found audiofile $audio"
+ clearExecBit $audio
+ .info.sound configure -state normal -command [list exec play $audio]
+ } else {
+ .info.sound configure -state disabled
+ }
+ if {$index == 0} {
+ .preview.prev configure -state disabled -image {}
+ } else {
+ .preview.prev configure -state normal\
+ -image [make_image [lindex $filelist [expr $index-1]] $buttonSize]
+ }
+ if {$index == $filecount-1} {
+ .preview.next configure -state disabled -image {}
+ } else {
+ .preview.next configure -state normal\
+ -image [make_image [lindex $filelist [expr $index+1]] $buttonSize]
+ }
+ .info.filename configure -text "$filename ([expr $index+1]/$filecount)"
+ array set exifdata [::jpeg::formatExif [::jpeg::getExif $filename]]
+ if {[info exists exifdata(DateTime)]} {
+ set tm $exifdata(DateTime)
+ } else {
+ set tm "unknown"
+ }
+ .info.exif configure -state normal
+ .info.exif delete 0.0 end
+ foreach {key value} [array get exifdata] {
+ if {$key == "MakerNote"} break
+ if {$key == "UserComment"} {
+ set value [string trim $value "\0"]
+ }
+ .info.exif insert end $key key "\t: $value\n" {}
+ }
+ .info.datetime configure -text "Date: $tm"
+ foreach {width height} [jpeg::dimensions $filename] break
+ show_image $filename $width $height
+ .info.comment delete 0.0 end
+ .info.comment insert 0.0 [encoding convertfrom [join [jpeg::getComments $filename] "\n"]]
+ .info.comment edit reset
+ .info.comment edit modified n
+}
+
+proc delete_file {index} {
+ global filename filelist filecount
+ if {[tk_messageBox -message "Really delete file $filename" -type yesno -title\
+ Confirm -icon warning] != "yes"} {
+ return
+ }
+
+ file delete $filename
+ if {$index == $filecount-1} {
+ global current
+ set filelist [lrange $filelist 0 [expr $index-1]]
+ incr current -1
+ set index $current
+ } else {
+ set filelist [lreplace $filelist $index $index]
+ }
+ incr filecount -1
+ set_file $index
+}
+
+proc rotateGUI {filename angle} {
+ global exifdata
+ rotate $filename $angle
+ show_image $filename
+}
+
+proc show_image {filename {width 0} {height 0}} {
+ global exifdata
+ if {$width == 0} {
+ foreach {width height} [jpeg::dimensions $filename] break
+ }
+ set img [make_image $filename [option get . imageSize ImageSize] $width $height]
+ .preview.l configure -image $img
+ foreach img [image names] {
+ if { ![string match ::tk::* $img]&& ![image inuse $img]} {
+ image delete $img
+ }
+ }
+ .info.size configure -text "Size: ${width}x$height"
+}
+
+proc save_file_info {} {
+ global filename
+ if {![.info.comment edit modified]} {
+ return
+ }
+ set_comment $filename [string trim [.info.comment get 0.0 end] "\n"]
+}
+
+#
+# Interface construction
+#
+option add *Text.Font -rfx-courier-medium-r-normal--12-120-75-75-m-70-iso10646-1
+option add *Font -rfx-times-bold-r-normal--12-120-75-75-p-67-iso10646-1 widgetDefault
+image create bitmap speaker -data {
+#define speaker_width 24
+#define speaker_height 24
+static unsigned char speaker_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x10, 0x00,
+ 0x00, 0x24, 0x00, 0x00, 0x49, 0x00, 0x80, 0x51, 0x00, 0xc0, 0x91, 0x00,
+ 0xe7, 0xa5, 0x00, 0xf7, 0xa5, 0x00, 0xff, 0x29, 0x01, 0xff, 0x49, 0x01,
+ 0xff, 0x49, 0x01, 0xff, 0x29, 0x01, 0xf7, 0xa9, 0x00, 0xe7, 0xa5, 0x00,
+ 0xc0, 0x95, 0x00, 0x80, 0x51, 0x00, 0x00, 0x49, 0x00, 0x00, 0x24, 0x00,
+ 0x00, 0x10, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ };
+}
+frame .info
+label .info.filename -width 32 -anchor w
+button .info.rotateleft -text "90\u00b0" -command {rotateGUI [getname $current] 90}
+button .info.rotateright -text "270\u00b0" -command {rotateGUI [getname $current] 270}
+button .info.upsidedown -text "180\u00b0" -command {rotateGUI [getname $current] 180}
+button .info.delete -text "Delete" -command {delete_file $current}
+label .info.size -text "Size:" -anchor w
+label .info.datetime -text "Date:" -anchor w
+text .info.exif -height 20 -width 40 -state disabled -yscrollcommand ".info.yexif set" -tabs {3c}
+text .info.comment -width 40 -height 5 -undo y -wrap word -yscrollcommand ".info.ycomment set"
+scrollbar .info.yexif -orient vert -command ".info.exif yview"
+scrollbar .info.ycomment -orient vert -command ".info.comment yview"
+button .info.sound -state disabled -image speaker
+frame .preview -width 200 -height 200
+button .preview.next -text ">>" -command {set_file [incr current]}
+button .preview.prev -text "<<" -command {set_file [incr current -1]} -state disabled
+
+label .preview.l
+
+
+grid .info.filename - - - - - -sticky news
+grid .info.rotateleft .info.upsidedown .info.rotateright .info.sound .info.delete -
+grid .info.size - - - -sticky news
+grid .info.datetime - - - -sticky news
+grid .info.exif - - - - .info.yexif -sticky news
+grid .info.comment - - - - .info.ycomment -sticky news
+grid rowconfigure .info 5 -weight 1
+grid columnconfigure .info 4 -weight 1
+
+grid .preview.prev .preview.next -sticky news
+grid .preview.l - -sticky news
+grid rowconfigure .preview 1 -weight 1
+grid columnconfigure .preview 0 -weight 1
+grid columnconfigure .preview 1 -weight 1
+grid .info .preview -sticky news
+
+wm protocol . WM_DELETE_WINDOW {save_file_info;destroy .}
+focus .info.comment
+bind .info.comment <Next> {.preview.next invoke}
+bind .info.comment <Prior> {.preview.prev invoke}
+bind .info.comment <Control-q> {eval [wm protocol . WM_DELETE_WINDOW]}
+option add [winfo class .].imageSize 400 widgetDefault
+
+if {[llength $argv]>1} {
+ puts stderr "Usage $argv0 [image-file]"
+}
+set filelist [lsort -dictionary [concat [glob -nocomplain *.jpg] [glob -nocomplain *.JPG]]]
+
+set filecount [llength $filelist]
+if {!$filecount} {
+ puts stderr "No image files in the current directory!"
+ exit 1
+}
+if {[llength $argv]} {
+ set current [lsearch $filelist [lindex $argv 0]]
+ if {$current == -1} {
+ puts stderr "File $argv not found in the current dir\n"
+ exit 1
+ }
+} else {
+ set current 0
+}
+set_file $current