PhotoAlbum -A Web Gallery Creation Tool

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 "      &nbsp;| <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