Version 10 of PhotoAlbum -A Web Gallery Creation Tool

Updated 2006-01-19 14:56:03

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 [L1 ].


 ############################################
 # 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       placed 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 "<!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>"
    puts $fp "<meta content=\"William J Giddings\" name=\"author\">"
    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 "<H2>$comments</H2>"
    puts $fp "<hr style=\"width: 100%; 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=\"\""
    puts $fp "src=\"file:$i\"></a><br>"
    puts $fp "<H3>$i</H3><br>" 

    # page footer
    puts $fp "</div>"
    puts $fp "</body></html>"

    close $fp

  }

  # create album master page
  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>$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 "<H2>$comments</H2>"
  puts $fp "<hr style=\"width: 100%; height: 2px;\">"


  # create containing table
  set cols 4
  set row [expr [llength $files] / 4]

  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 {

    # 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 "<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=\"\""
    puts $fp "src=\"file:t_$i\"></a><br>"
    puts $fp "<H3>$i,</H3>"
    puts $fp "</td>"

    incr col
    if {$col>=4} {
      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;\">"
  # calculate date

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

  close $fp

 }

 #---------------
 # create the album
 #---------------
 CSS:photoalbum
 photoalbum
 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.


Category Application - Category Graphics