[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\">
" ====== 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 "" puts $fp "" puts $fp " " puts $fp " " puts $fp " PhotoAlbum: $title - $i" puts $fp " " puts $fp " " puts $fp " " puts $fp " " puts $fp " " # page heading block puts $fp "

$title

" puts $fp "

$comments

" puts $fp "
" # fullsize puts $fp "
" puts $fp " " puts $fp " $i
" puts $fp "

$i


" if {$prev ne ""} { puts $fp " prev | " } puts $fp " index" if {$next ne ""} { puts $fp "  | next" } puts $fp "
" # page footer puts $fp "
" puts $fp " \n" 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 "" puts $fp "" puts $fp " " puts $fp " " puts $fp " PhotoAlbum: $title" puts $fp " " puts $fp " " puts $fp " " puts $fp " " puts $fp " " # page heading block puts $fp "

$title

" puts $fp "

$comments

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

$i

" puts $fp "
" # page footer puts $fp "
" # calculate date puts $fp " Generated by PhotoAlbum 1.01 [date]" puts $fp "
\n \n" 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 ====== <> Application | Graphics | Multimedia | CMS