[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].
----
############################################
# photoalbum.tcl
# ------------------------
# Written by: William J Giddings
# 1.00 - 24th November, 2005
# 1.01 - 2006-01-22
############################################
# 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
#
# Use:
# ----
# Simply copy photoalbum.tcl into a directory containing the appropriate jpegs.
# 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
#
############################################
#---------------
# 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 ""
puts $fp ""
puts $fp "
"
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 cell
puts $fp "
"
close $fp
}
#---------------
# create the album
#---------------
catch {console show}
update
CSS:photoalbum
#photoalbum
photoalbum index.html "Holidays 2005" "MyHolidays2005" "Lots of fun" 100 5
exit
----
[MHo]: 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: Title and description, date-format, cols, alt-tags, prev/next - links, console as progress-indicator.
Now, it would be nice to also have individual comments for pictures...
----
[Category Application] - [Category Graphics]