[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].
----
======
#########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 ""
puts $fp ""
puts $fp ""
puts $fp "PhotoAlbum: $title - $i "
puts $fp "PHOTOALBUM "
puts $fp "$title "
puts $fp "$comments "
#puts $fp ""
puts $fp "
"
puts $fp " "
puts $fp "
$i "
#puts $fp "$i
"
if {$prev!=""} { puts $fp "
prev | " }
if {$next!=""} { puts $fp "
next " }
puts $fp "
"
# page footer
puts $fp "
PhotoAlbum: $title "
puts $fp "PHOTOALBUM "
puts $fp "$title "
puts $fp "$comments "
#puts $fp ""
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 table-cell
puts $fp " "
puts $fp ""
puts $fp " $i "
puts $fp " "
incr col
if {$col>=$cols} {
puts $fp " "
set col 0
}
}
# terminate the table
puts $fp "
"
# page footer
#puts $fp "
"
puts $fp "
"
# calculate date
puts $fp "
Generated by PhotoAlbum 1.01 [date] "
puts $fp "
> Application | Graphics | Multimedia | CMS