WJG 24/11/05. Do you get annoyed with all those fiddly bits of crappy software that are intended to make albums? Sometimes it takes longer to work out the foibles of the application than sitting down and writing something quick n simple in Tcl. This can be uploaded using more tcl magick Simple ftp uploader.
MHo: If you want to create a pdf-photo album for printing automatically, take a look at Matthias Hoffmann - PhotoPrinter.
KPV: For a photo album as an application, take look at Photo Album.
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.
JM 2018-11-23 I had to remove 'file:' for the src attribute as follows to make it work when in a web server:
puts $fp "src=\"t_$i\"></a><br>"
unless I was doing something wrong, since my images appeared broken.
KPV 2018-11-26: Nice program. I added some tweaks to this program. Most notably, you can now specify title, index, etc on the command line, so you can now type: photoalbum.tcl -title "My Trip" -subtitle "Jan 2020". Also added command line help, a link to the index page on every image page and formatted nicely the generated html.
JM 2018-11-26: Thanks. I use this in combination with MajaMaja, this new version, with a minor tweak (a new option in the command line), will allow me to choose which of the pictures will be taken as the custom icon for the folder.
#!/bin/sh
# Restart with tcl \
exec tclsh $0 ${1+"$@"}
#########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.02 - 2018-11-26 Keith Vetter -- command line options
#########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
# createThumbnail creates thumbnail for given image
# scaleimage resize pictures
# photoalbum file building proc
# page1 Create individual picture page, with prev/next-links
#
# Use:
# ----
# o Simply copy photoalbum.tcl into a directory containing the appropriate jpegs.
# o Run this program with appropriate -title, -description, etc. options.
# o It will create an index file, thumbnails and preview pages for all jpegs.
# o Open the index file in a browser and you'll see your photo album.
# e.g. tclsh photoalbum.tcl -title "My Trip" -subtitle "Jan 2019"
#
# Future Modifications:
# -------------
# Add some FTP code to auto-update remote server.
#
# Require:
# --------
# package Img
#
#########1#########2#########3#########4#########5#########6#########7#####
package require Img
wm withdraw .
#---------------
# Create linked CSS
#---------------
proc CSS:photoalbum {} {
puts "creating photoAlbum.css"
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
#---------------
proc createThumbnail {ifile height} {
set thumbFile t_$ifile
image create photo tmp -file $ifile
set h [image height tmp]
set c [expr $height.0/$h]
scaleImage tmp $c
tmp write $thumbFile -format jpeg
image delete tmp
return $thumbFile
}
# ref: https://wiki.tcl-lang.org/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
set pre [image height $im]
$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 %Y-%m-%d]
return $date
}
proc page1 {prev i next index title description comments} {
#: Create individual picture page
set fp [open $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>$title</H1>"
puts $fp " <H2>$comments</H2>"
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>"
if {$prev ne ""} { puts $fp " <a href='$prev.html'>prev</a> | " }
puts $fp " <a href='index.html'>index</a>"
if {$next ne ""} { puts $fp " | <a href='$next.html'>next</a>" }
puts $fp " <br>"
# page footer
puts $fp " </div>"
puts $fp " </body>\n</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 title description comments height cols} {
puts "Creating photo album"
puts " index: $index"
puts " title: $title"
puts " description: $description"
puts " comments: $comments"
puts " height: $height"
puts " columns: $cols"
CSS:photoalbum
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 "creating page for $i"; update
if {$prev1 ne ""} { 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 "creating $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>$title</H1>"
puts $fp " <H2>$comments</H2>"
puts $fp " <hr style='height: 2px;'>"
# create containing table
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 "creating thumbnail for $i"; update
# delete any old thumbnails
if {[string range $i 0 1] == "t_" } {
bell
file delete -force $i
continue
}
# create thumbnails, all equal height
set thumbFile [createThumbnail $i $height]
# thumbnails, in a new table-cell
puts $fp " <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='$thumbFile'></a><br>"
puts $fp " <H3>$i</H3>"
puts $fp " </td>"
incr col
if {$col >= $cols} {
puts $fp " </tr>"
puts $fp " <tr>"
set col 0
}
}
# terminate the table
puts $fp " </tr>"
puts $fp " </tbody>"
puts $fp " </table>"
# page footer
puts $fp " <hr style='height: 2px;'>"
# calculate date
puts $fp " <F1>Generated by PhotoAlbum 1.01 [date]</F1>"
puts $fp " </div>\n </body>\n</html>"
close $fp
puts "\nPhotoAlbum created in $index"
}
proc ParseArgs {} {
global E argv
if {"-help" in $argv || "--help" in $argv} { Usage "" }
foreach {key value} $argv {
if {! [dict exists $E $key]} {
Usage "Error: unknown option '$key'\n\n"
}
dict set E $key $value
}
}
proc Usage {emsg} {
set argv0 [file tail $::argv0]
set usage "$argv0: options...\n"
append usage " ?-index index.html? # HTML file for the photoAlbum\n"
append usage " ?-title album_title? # Title on every page\n"
append usage " ?-subtitle subtitle? # Sub-title on every page\n"
append usage " ?-description description? # Description in html header\n"
append usage " ?-height thumbnail_height? # Height of thumbnail\n"
append usage " ?-columns columns? # How many thumbnails in a row"
puts stderr $emsg$usage
exit
}
# All command line options in correct order with default values
set E [dict create -index index.html \
-title "My PhotoAlbum Title" \
-description "My PhotoAlbum Description" \
-subtitle "My PhotoAlumb Subtitle" \
-height 100 \
-columns 5]
#---------------
# create the album
#---------------
ParseArgs
photoalbum {*}[dict values $E]
exit