Updated 2011-07-12 02:39:39 by RLE

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 "<!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>PHOTOALBUM</H1>"
     puts $fp "<H1>$title</H1>"
     puts $fp "<H2>$comments</H2>"
    #puts $fp "<hr style=\"width: 100%; height: 2px;\">"
     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>"
    #puts $fp "$i<br>"
     if {$prev!=""} { puts $fp "<a href=\"$prev.html\">prev</a> | " }
     if {$next!=""} { puts $fp "<a href=\"$next.html\">next</a>" }
     puts $fp "<br>"

     # page footer
     puts $fp "</div>"
     puts $fp "</body></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 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
    set prev1 ""
    set prev2 ""
    foreach i $files {
      puts "$i"; update
     #page1 $prev $i $next  $index $title $description $comments
      if {$prev1!=""} { 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 "$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>PHOTOALBUM</H1>"
    puts $fp "<H1>$title</H1>"
    puts $fp "<H2>$comments</H2>"
   #puts $fp "<hr style=\"width: 100%; height: 2px;\">"
    puts $fp "<hr style=\"height: 2px;\">"

    # create containing table
   #set cols 4
   #set row [expr [llength $files] / 4]
    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 "$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 "<td> <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=\"file:t_$i\"></a><br>"
      puts $fp "<H3>$i</H3>"
      puts $fp "</td>"

      incr col
      if {$col>=$cols} {
        puts $fp "</tr> <tr>"
        set col 0
      }
    }

    # terminate the table
    puts $fp "</tr> </tbody> </table>"

    # page footer
   #puts $fp "<hr style=\"width: 100%; height: 2px;\">"
    puts $fp "<hr style=\"height: 2px;\">"

    # calculate date
    puts $fp "<F1>Generated by PhotoAlbum 1.01 [date]</F1>"
    puts $fp "</div> </body> </html>"

    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: 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.