#########1#########2#########3#########4#########5#########6#########7#####
# photoalbum.tcl
# ------------------------
# Written by: William J Giddings
# 1.00 - 24th November, 2005
# 1.01 - 2006-01-22 HaJo Gurt
#########1#########2#########3#########4#########5#########6#########7#####
# Description:
# -----------
# Create HTML based photoalbum using jpeg files contained within
# the present working directory.
#
# Procedures:
# -----------
# CDD:photoalbum create linked HTML stylesheet
# scaleimage resize pictures
# photoalbum file building proc
# page1 Create individual picture page, with prev/next-links
#
# Use:
# ----
# Simply copy photoalbum.tcl into a directory containing the appropriate jpegs.
# Adjust 'photoalbum'-statement at end of script, then run the script.
# It will create am index file, thumbnails and preview pages for all jpegs.
#
# Future Modifications:
# -------------
# Add some FTP code to auto-update remote server.
#
# Require:
# --------
# package Img
#
#########1#########2#########3#########4#########5#########6#########7#####
#---------------
# Create linked CSS
#---------------
proc CSS:photoalbum {} {
set fp [open photoAlbum.css "w"]
puts $fp "
H1 \{
text-align:center;
color: navy;
font-family: \"Lucida\" \"Arial\";
font-size: 18pt;
font-weight: bold;
\}
H2 \{
text-align:center;
color: red;
font-family: \"Arial\";
font-size: 14pt;
font-weight: normal;
\}
H3 \{
text-align:center;
font-family: \"Arial\";
font-size: 8pt;
font-weight: normal;
font-style: italic;
\}
F1 \{
text-align:center;
font-family: \"Arial\";
font-size: 8pt;
font-weight: normal;
font-style: italic;
\}
"
close $fp
}
#---------------
# create thumbnails
#---------------
# ref: http://wiki.tcl.tk/8448
proc scaleImage {im xfactor {yfactor 0}} {
set mode -subsample
if {abs($xfactor) < 1} {
set xfactor [expr round(1./$xfactor)]
} elseif {$xfactor>=0 && $yfactor>=0} {
set mode -zoom
}
if {$yfactor == 0} {set yfactor $xfactor}
set t [image create photo]
$t copy $im
$im blank
$im copy $t -shrink $mode $xfactor $yfactor
image delete $t
}
#---------------
# get todays's date
#---------------
proc date {} {
set secs [clock seconds]
#set date [clock format $secs -format %D]
set date [clock format $secs -format %Y-%m-%d]
return $date
}
proc page1 {prev i next index title description comments} {
#: Create individual picture page
set fp [open [pwd]/$i.html "w"]
# write page header
puts $fp "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
puts $fp "<html lang=\"en-gb\">"
puts $fp "<head>"
puts $fp "<meta content=\"text/html; charset=UTF-8\""
puts $fp "http-equiv=\"content-type\">"
puts $fp "<title>PhotoAlbum: $title - $i</title>"
puts $fp "<meta content=\"William J Giddings\" name=\"author\">"
puts $fp "<meta content=\"$description\" name=\"description\">"
puts $fp "<Link Rel=stylesheet Type=\"text/css\" href=\"photoAlbum.css\">"
puts $fp "</head>"
puts $fp "<body>"
# page heading block
#puts $fp "<H1>PHOTOALBUM</H1>"
puts $fp "<H1>$title</H1>"
puts $fp "<H2>$comments</H2>"
#puts $fp "<hr style=\"width: 100%; height: 2px;\">"
puts $fp "<hr style=\"height: 2px;\">"
# fullsize
puts $fp "<div style=\"text-align: center;\">"
puts $fp "<a href=\"$index#$i\">"
puts $fp "<img title=\"Click to see picture index.\" style=\"\" alt=\"$i\""
puts $fp "src=\"file:$i\"></a><br>"
puts $fp "<H3>$i</H3><br>"
#puts $fp "$i<br>"
if {$prev!=""} { puts $fp "<a href=\"$prev.html\">prev</a> | " }
if {$next!=""} { puts $fp "<a href=\"$next.html\">next</a>" }
puts $fp "<br>"
# page footer
puts $fp "</div>"
puts $fp "</body></html>"
close $fp
}
#---------------
# create photoalbum
#
# args:
# ----
# index name of album front page
# description info to store in header of html-page
# title shown at top of each page
# comments placed as sub-title on each page
# height maximum height for each thumbnail
# cols number of columns in the index page
#---------------
proc photoalbum { {index index.html} {title PhotoAlbum} {description description} {comments comments} {height 100} {cols 4} } {
package require Img
set files [glob -nocomplain *.jpg]
# delete any old thumbnails and pages
foreach i $files {
if {[string range $i 0 1] == "t_" } {
file delete -force $i
file delete -force $i.html
}
}
set files [glob -nocomplain *.jpg]
# create individual picture page
set prev1 ""
set prev2 ""
foreach i $files {
puts "$i"; update
#page1 $prev $i $next $index $title $description $comments
if {$prev1!=""} { page1 $prev2 $prev1 $i $index $title $description $comments }
set prev2 $prev1
set prev1 $i
}
page1 $prev2 $prev1 "" $index $title $description $comments
# create album master page
puts "$index"; update
set fp [open [pwd]/$index "w"]
puts $fp "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
puts $fp "<html lang=\"en-gb\">"
puts $fp "<head>"
puts $fp "<meta content=\"text/html; charset=UTF-8\""
puts $fp "http-equiv=\"content-type\">"
puts $fp "<title>PhotoAlbum: $title</title>"
puts $fp "<meta content=\"William J Giddings\" name=\"author\">"
puts $fp "<meta content=\"$description\" name=\"description\">"
puts $fp "<Link Rel=stylesheet Type=\"text/css\" href=\"photoAlbum.css\">"
puts $fp "</head>"
puts $fp "<body>"
# page heading block
#puts $fp "<H1>PHOTOALBUM</H1>"
puts $fp "<H1>$title</H1>"
puts $fp "<H2>$comments</H2>"
#puts $fp "<hr style=\"width: 100%; height: 2px;\">"
puts $fp "<hr style=\"height: 2px;\">"
# create containing table
#set cols 4
#set row [expr [llength $files] / 4]
set row [expr [llength $files] / $cols]
puts $fp "<div style=\"text-align: center;\">"
puts $fp "<table style=\"text-align: left; margin-left: auto; margin-right: auto; width: 800px;\" border=\"0\" cellpadding=\"0\" cellspacing=\"0\">"
puts $fp "<tbody>"
puts $fp "<tr>"
set col 0
# create thumbnails
foreach i $files {
puts "$i"; update
# delete any old thumbnails
if {[string range $i 0 1] == "t_" } {
bell
file delete -force $i
continue
}
# create thumbnails, all equal height
image create photo tmp -file $i
set w [image width tmp]
set h [image height tmp]
set c [expr $height.0/$h]
scaleImage tmp $c
tmp write t_$i -format jpeg
# thumbnails, in a new table-cell
puts $fp "<td> <td style=\"text-align: center;\">"
puts $fp "<a name=\"$i\"></a>"
puts $fp "<a href=\"$i.html\">"
puts $fp "<img title=\"Click to see larger picture.\" style=\"border: 2px solid\" alt=\"$i\""
puts $fp "src=\"file:t_$i\"></a><br>"
puts $fp "<H3>$i</H3>"
puts $fp "</td>"
incr col
if {$col>=$cols} {
puts $fp "</tr> <tr>"
set col 0
}
}
# terminate the table
puts $fp "</tr> </tbody> </table>"
# page footer
#puts $fp "<hr style=\"width: 100%; height: 2px;\">"
puts $fp "<hr style=\"height: 2px;\">"
# calculate date
puts $fp "<F1>Generated by PhotoAlbum 1.01 [date]</F1>"
puts $fp "</div> </body> </html>"
close $fp
}
#---------------
# create the album
#---------------
catch {console show}
update
CSS:photoalbum
#photoalbum
photoalbum index.html "Holidays 2005" "MyHolidays2005" "Lots of fun" 100 5
exitMHo: If you want to create a pdf-photo album for printing automatically, take a look at Matthias Hoffmann - PhotoPrinter.
Jeremy Miller: Why not add support for other image formats tcl and IMG support such as GIF and PNG?WJG That's a good idea. At the time I just needed something to handle the jpegs that come from our digital camera.HJG 2006-01-22 v1.01 - Fixed: date-format (now 4-digit), alt-tags (had been empty), Title, description and cols (settings had been ignored). Added: prev/next - links, console to monitor the progress. Now, it would be nice to also have individual comments for the pictures.
