[WJG] 24/11/05. Do you get annoyed with all those fiddly bits of crappy software that are intentded 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. ############################################ # photoalbum.tcl # ------------------------ # Written by: William J Giddings # 24th November, 2005 ############################################ # Description: # ----------- # Create HTML based photoalbum using jpeg files contained within # the present working directory. # # Proceedures: # ----------- # 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 remote update 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] return $date } #--------------- # create photoalbum # # args: # ---- # index name of album front page # title show in each page # description some info stored in file header # comments places 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 foreach i $files { set fp [open [pwd]/$i.html "w"] # write page header puts $fp "" puts $fp "" puts $fp "" puts $fp "" puts $fp "PhotoAlbum" puts $fp "" puts $fp "" puts $fp "" puts $fp "" # page heading block puts $fp "

PHOTOALBUM

" puts $fp "

$comments

" puts $fp "
" # fullsize puts $fp "
" puts $fp "" puts $fp "\"\""
" puts $fp "

$i


" # page footer puts $fp "
" puts $fp "" close $fp } # create album master page set fp [open [pwd]/$index "w"] puts $fp "" puts $fp "" puts $fp "" puts $fp "" puts $fp "$title" puts $fp "" puts $fp "" puts $fp "" puts $fp "" puts $fp "" # page heading block puts $fp "

PHOTOALBUM

" puts $fp "

$comments

" puts $fp "
" # create containing table set cols 4 set row [expr [llength $files] / 4] puts $fp "
" puts $fp "" puts $fp "" puts $fp "" set col 0 # create thumbnails foreach i $files { # 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 cel puts $fp "" incr col if {$col>=4} { puts $fp "" set col 0 } } # terminate the table puts $fp "
" puts $fp "" puts $fp "" puts $fp "\"\""
" puts $fp "

$i,

" puts $fp "
" # page footer puts $fp "
" # calculate date puts $fp "Generated by PhotoAlbum 1.0 [date]" puts $fp "
" close $fp } #--------------- # create the album #--------------- CSS:photoalbum photoalbum exit