Updated 2016-07-25 16:59:19 by dkf

Keith Vetter 2016-07-22 : This started out small weekend project, as a way to help organize photographs from a recent trip. I'm old fashion, and like to get actual prints and put them into albums.

So I thought I'd write a short little program that lets you drag photos from a gallery of thumbnails and drop them in a replica of a real photo album--the kind with two vertical and one horizontal pocket. You could add more pages, add more photos, delete and rearrange photos, etc.

Well that simple little weekend project grew a bit: as I would be using it I realized it would be nice to have this new feature and that new feature, and so on. For example, I thought it would be useful to be able to add tags the thumbnails such as family or friends, and to rearrange the thumbnails based on the tags. Or for it to produce a list of all the photographs to be printed for the final product.

The result is something I'm kind of proud of--essentially a virtual photo album, that lets you flip the pages and experience what the final album would look like.

Couple of technical notes.

First, it requires ImageMagick to run--I needed to resize images to an arbitrary size and tk is lacking in that area.

Second, I had to implement my own drag-and-drop technology that lets you drag a thumbnail from one window and drop it into another. This was fairly complicated, requiring a new toplevel to hold the dragged item and converting between screen coordinates and window coordinates.

Third, if you want to change the album title or add text to be displayed on each page you must edit the file called _photo_album.cfg. (The page text is for display only.)

Fourth, this photo album works well with my previous program Photo Crop. One section of the manifest lists all the photos that need to be cropped. Plus, this tool will recognize when you have both a cropped and non-cropped version of the same photo.

# photoAlbum.tcl -- Simulates laying out photos in a photo album
# by Keith Vetter 2016-06-19

package require Tk
package require Img
package require tooltip

set P(pixel,inch) 72
set P(album,width,inch) 9
set P(album,height,inch) 11
set P(album,gutter,inch) .5
set P(full,width,inch) [expr {2 * $P(album,width,inch) + $P(album,gutter,inch)}]

set P(thumbs,display,rows) COMPUTED_LATER
set P(thumbs,display,cols) COMPUTED_LATER
set P(thumbs,image,pixels) 200
set P(thumbs,margin,pixels) 25
set P(thumbs,gutter,pixels) 0
set P(thumbs,box,pixels) [expr {$P(thumbs,image,pixels) + 2*$P(thumbs,margin,pixels) + $P(thumbs,gutter,pixels)}]
set P(thumbs,qview,pixels) 600
set P(thumbs,width) COMPUTED_LATER
set P(thumbs,height) COMPUTED_LATER

# Layout coordinates (in inches)
set P(gutter) {9 0 9.5 11}
set P(recto,top) {12.25 .25 18.25 4.25}
set P(recto,message) {9.75 .25 12 4.25}
set P(recto,left) {9.75 4.75 13.75 10.75}
set P(recto,right) {14.25 4.75 18.25 10.75}

set P(verso,top) {.25 .25 6.25 4.25}
set P(verso,message) {6.5 .25 8.75 4.25}
set P(verso,left) {.25 4.75 4.25 10.75}
set P(verso,right) {4.75 4.75 8.75 10.75}

# Note: S(marks) require images with names ::img::XXX, e.g. ::img::Family
set S(marks) {"Best" "Family" "Friends" "Animal" "Trash" "Other" "Underwater"}
set S(marks,accel) {"B" "F" "N" "A" "T" "O" "U"}
set S(noWrite) false
set S(title,font) {Helvetica 24 bold}
set S(text,font) {Helvetica 16 bold}

proc DoDisplay {} {
    global P S

    set left [expr {int([winfo screenwidth .] - $P(width) - 10)}]
    wm geom . +$left+100
    wm resizable . 0 0

    ::ttk::label .title -textvariable S(title) -font $S(title,font) -anchor c
    pack .title -side top -fill x

    ::ttk::frame .bbar
    pack .bbar -side top -fill x
    foreach {key text cmd} {thumbs "Open gallery" ::Gallery::MakeWindow
        manifest "Show manifest" ::Manifest::Show undo "Undo" ::Undo::Undo
        open "Open album" ::Album::Open
        prevpage "Previous page" {ChangePage 1} nextpage "Next page" {ChangePage -1}
        info "About" About} {
        ::ttk::button .bbar.$key -image ::img::$key -compound none -style Toolbutton -command $cmd
        ::tooltip::tooltip .bbar.$key $text
        pack .bbar.$key -side [expr {$key eq "info" ? "right" : "left"}]

    canvas .c -width $P(width) -height $P(height) -bd 0 -highlightthickness 0 -bg white
    pack .c -side top

    foreach {key action} {"t" ::Gallery::MakeWindow "m" ::Manifest::Show
        "Key-Next" {ChangePage -1} "Key-Prior" {ChangePage 1}
        "Key-Right" {ChangePage -1} "Key-Left" {ChangePage 1}
        "Control-z" ::Undo::Undo} {
        bind . "<$key>" $action

    menu .popup -tearoff 0
    menu .popup.marks -tearoff 0
    .popup add command -label Info -command ::Popup::Info -accel I
    .popup add command -label "Quick view" -command ::Popup::QuickView -under 0 -accel Q
    .popup add command -label "External Viewer" -command ::Popup::Viewer -under 9 \
        -state [expr {[CanViewImage] ? "normal" : "disabled"}] -accel V
    .popup add cascade -label "Annotate" -menu .popup.marks
    .popup add separator
    .popup add command -label Delete -command ::Popup::Delete -accel D
    .popup add command -label "Rotate right" -command {::Popup::Rotate right} -accel R
    .popup add command -label "Rotate left" -command {::Popup::Rotate left} -accel L

    foreach mark $S(marks) accel $S(marks,accel) {
        .popup.marks add checkbutton -label $mark -command [list ::Popup::Annotate $mark] \
            -variable ::M(mark,$mark) -accel $accel
    if {[string equal $::tcl_platform(os) "Darwin"]} {
        event add <<MenuMousePress>> <Control-Button-1>
        event add <<MenuMousePress>> <Button-2>
    } else {
        event add <<MenuMousePress>> <Button-3>


proc DrawPage {} {
    global P

    .c delete all
    .c create rect [ToCanvas $P(gutter)] -fill gray50 -width 0

    foreach side {verso recto} {
        foreach pocket {message top left right} {
            set tag "$side,$pocket"
            set itag "img,$tag"

            lassign [ToCanvas $P($side,$pocket)] x0 y0 x1 y1
            .c create rect $x0 $y0 $x1 $y1 -tag [list $side $tag] -fill {} -outline black -width 2 -fill white
            if {$pocket in {message top}} {
                .c create image $x0 $y0 -tag [list image $itag] -anchor nw
            } else {
                .c create image $x0 $y1 -tag [list image $itag] -anchor sw
            .c bind $itag <<MenuMousePress>> [list DoPopup $itag album %X %Y]
        CreateTextBox $side

proc DoPopup {tag who x y} {
    global M S ALBUM

    set M(popup,tag) $tag
    if {[string match "thumb_*" $tag]} {
        scan $M(popup,tag) "thumb_%d_%d" row col
        set M(popup,idx) [::Gallery::Pos2Index $row $col]
    } else {
        lassign [split $tag ","] . side pocket
        set pageNo [expr {$S(current,page) + ($side eq "recto")}]
        set M(popup,idx) [Image2Index $ALBUM($pageNo,$pocket)]

    # Disable Delete and the Rotate entries depending on context
    for {set idx 0} {$idx < [.popup index last]} {incr idx} {
        if {[.popup type $idx] ne "command"} continue
        set txt [.popup entrycget $idx -label]
        if {$txt eq "Delete"} {
            .popup entryconfig $idx -state [expr {$who eq "thumbs" ? "disabled" : "normal"}]
        } elseif {[string match "Rotate *" $txt]} {
            .popup entryconfig $idx -state [expr {$who eq "thumbs" ? "normal" : "disabled"}]
    ::Popup::Annotate -populate

    set focus [focus]
    tk_popup .popup $x $y
    if {[tk windowingsystem] eq "aqua" && $focus ne ""} {
        # Aqua's help window steals focus on display
        after idle [list focus -force $focus]
        focus -force $focus

proc BestSize {} {
    global P

    set width [expr {$P(full,width,inch) * $P(pixel,inch)}]
    set height [expr {$P(album,height,inch) * $P(pixel,inch)}]
    set sw [winfo screenwidth .]
    set sh [winfo screenheight .]

    set scaleW [expr {($sw - 200.) / $width}]
    set scaleH [expr {($sh - 300.) / $height}]
    set scale [expr {min($scaleW, $scaleH)}]

    set P(scale) [expr {int($scale * 10) / 10.}]
    set P(width) [expr {$P(scale) * $width}]
    set P(height) [expr {$P(scale) * $height}]

    set thumbW [expr {($sw / 3) / $P(thumbs,box,pixels)}]
    set thumbH [expr {round(($sh - 300.) / $P(thumbs,box,pixels))}]
    set P(thumbs,display,cols,raw) [expr {max(3, min(5, $thumbW))}]
    set P(thumbs,display,rows,raw) [expr {min(5, $thumbH)}]

proc ToCanvas {xy4} {
    global P
    set xy {}
    foreach pt $xy4 {
        lappend xy [expr {round($P(scale) * $P(pixel,inch) * $pt)}]
    return $xy

namespace eval ::Pocket {}
proc ::Pocket::InsertImage {side pocket iname} {
    if {$iname eq ""} {
        .c itemconfig img,$side,$pocket -image {}
    } else {
        set fname [FullName $iname]
        set tag img,$side,$pocket
        set sizedFname [::Pocket::ResizeImageToFit $pocket $fname]
        image create photo ::album::${side}::$pocket -file $sizedFname
        .c itemconfig $tag -image ::album::${side}::$pocket
proc ::Pocket::ResizeImageToFit {pocket fullName} {
    set cacheName [GetCacheName $pocket $fullName]
    if {[file exists $cacheName]} { return $cacheName }
    lassign [GetImageSize $fullName] iwidth iheight
    lassign [::Pocket::GetSize $pocket] pwidth pheight
    set imageVertical [expr {$iwidth < $iheight}]
    set pocketVertical [expr {$pocket ne "top"}]

    set cmd [list "convert"]
    if {$imageVertical ne $pocketVertical} {
        lappend cmd "-rotate" "-90"
    lappend cmd "-resize" "${pwidth}x${pheight}"
    lappend cmd "--" $fullName
    lappend cmd $cacheName
    MyExec $cmd
    return $cacheName
proc ::Pocket::Highlight {pocket onoff} {
    if {$onoff} {
        .c itemconfig $pocket -outline magenta -width 15
    } else {
        .c itemconfig $pocket -outline black -width 2

proc ::Pocket::XY2Pocket {x y} {
    foreach side {recto verso} {
        foreach pocket {top left right} {
            lassign [.c bbox $side,$pocket] x0 y0 x1 y1
            if {$x >= $x0 && $x <= $x1 && $y >= $y0 && $y <= $y1} {
                return "$side,$pocket"
    return ""
proc ::Pocket::GetSize {pocket} {
    lassign [ToCanvas $::P(verso,$pocket)] x0 y0 x1 y1
    return [list [expr {$x1 - $x0}] [expr {$y1 - $y0}]]

proc RotateImageInPlace {dir fullName} {
    set backupName "[file rootname $fullName]_org[file extension $fullName]"
    if {! [file exists $backupName]} {
        file copy $fullName $backupName
    close [file tempfile tempfileName "photo_album_"]
    file rename -force $fullName $tempfileName
    set degrees [expr {$dir eq "left" ? -90 : 90}]
    set cmd [list "convert" "-rotate" $degrees "--" $tempfileName $fullName]
    MyExec $cmd
    file delete $tempfileName
proc MyExec {cmd} {
    set oldFocus [focus]
    set result [exec {*}$cmd]
    focus $oldFocus
    return $result
proc GetImageSize {fullName} {
    return [exec identify -format "%w %h" -- $fullName]

proc GetCacheName {type iname} {
    if {$type eq "right"} { set type left }
    if {$type eq "qview"} {
        set size $::P(thumbs,qview,pixels)
    } elseif {$type eq "thumb"} {
        set size $::P(thumbs,image,pixels)
    } else {
        set size $::P(scale)
    set fullName "${type}_${size}_[file tail $iname]"
    return [file join $::ALBUM(cache) $fullName]

namespace eval ::Popup {}

proc ::Popup::Info {} {
    global M S ALBUM

    if {! [info exists M(popup,idx)]} return
    set idx $M(popup,idx)
    set fullName [FullName [Index2Image $idx]]
    lassign [GetImageSize $fullName] iwidth iheight

    set tail [file tail $fullName]
    set dateTime [::Popup::GetImageDateTime $fullName]
    set location [::Popup::GetImageLocation $fullName]
    set ratio [expr {max($iwidth,$iheight) / double(min($iwidth,$iheight))}]
    set is4x6 [expr {abs($ratio - 1.5) < .01}]

    set msg "File: $tail\n"
    append msg "Index: [comma [expr {$idx+1}]] / [comma [llength $ALBUM(files)]]\n"
    append msg "Size: [comma $iwidth] x [comma $iheight]\n"
    append msg "Date/Time: $dateTime\n"
    append msg "Location: $location\n"
    append msg "4x6: [expr {$is4x6 ? {yes} : {no}}]\n"

    set marks [join [::Gallery::GetAnnotations $idx] ", "]
    if {$marks eq {}} { set marks "none" }
    append msg "Annotations: [string map {Check {Used in album}} $marks]\n"
    tk_messageBox -message "Image Information" -detail $msg
proc ::Popup::Annotate {how} {
    global M S ALBUM

    if {! [info exists M(popup,idx)]} return
    set iname [Index2Image $M(popup,idx)]
    if {! [info exists ALBUM(mark,$iname)]} {set ALBUM(mark,$iname) {}}
    if {$how eq "-populate"} {
        foreach key $S(marks) { set M(mark,$key) 0 }
        foreach mark $ALBUM(mark,$iname) { set M(mark,$mark) 1 }

    # Ignore $how, use M(mark,*) to determine annotations
    set old $ALBUM(mark,$iname)
    set ALBUM(mark,$iname) {}
    foreach key $S(marks) { if {$M(mark,$key)} { lappend ALBUM(mark,$iname) $key }}
    if {$old eq $ALBUM(mark,$iname)} return

    ::Undo::RegisterAnnotationEvent $iname $old
    focus -force .thumbs.c
proc ::Popup::AnnotateDirect {accelKey idx} {
    global M
    set n [lsearch -exact $::S(marks,accel) $accelKey]
    if {$n == -1} return
    set mark [lindex $::S(marks) $n]

    set M(popup,idx) $idx
    ::Popup::Annotate -populate
    set M(mark,$mark) [expr {! $::M(mark,$mark)}]
    ::Popup::Annotate $mark
proc ::Popup::Delete {} {
    global M S ALBUM
    if {! [info exists M(popup,tag)]} return
    lassign [split $M(popup,tag) ","] . side pocket
    set pageNo [expr {$S(current,page) + ($side eq "recto")}]

    set currentValue [expr {[info exists ALBUM($pageNo,$pocket)] ? $ALBUM($pageNo,$pocket) : ""}]

    ::Undo::RegisterDragAndDropEvent $pageNo $pocket ""
    ::Pocket::InsertImage $side $pocket ""
proc ::Popup::Rotate {dir} {
    global M ALBUM
    if {! [info exists M(popup,idx)]} return
    set idx $M(popup,idx)
    set iname [Index2Image $idx]

    lassign [::Gallery::Index2Pos $idx] row col
    lassign [::Gallery::Pos2XY [expr {$row+.3}] [expr {$col + .3}]] x y

    Busy 1 .thumbs.c $x $y
    RotateImageInPlace $dir [FullName $iname]
    Busy 0 .thumbs.c 0 0

    ::Undo::RegisterRotateEvent $iname
    ClearCache $iname
    ::Gallery::ClearImage $iname
proc ::Popup::QuickView {} {
   global M S ALBUM
    if {! [info exists M(popup,idx)]} return
    ::Gallery::DisplayQView $M(popup,idx)
proc ::Popup::Viewer {} {
    global M S ALBUM
    if {! [info exists M(popup,idx)]} return
    set idx $M(popup,idx)
    ViewImage [FullName [Index2Image $idx]]
proc ::Popup::GetImageDateTime {fullName} {
    set exif [MyExec [list "identify" "-format" {%[EXIF:*]} $fullName]]
    set n [regexp -line {DateTimeOriginal=(.*)$} $exif . dateTime]
    if {! $n} {return ""}
    set ticks [clock scan $dateTime -format "%Y:%m:%d %k:%M:%S"]
    return [clock format $ticks]
proc ::Popup::GetImageLocation {fullName} {
    set exif [MyExec [list "identify" "-format" {%[EXIF:*]} $fullName]]
    if {$exif eq ""} { return "" }
    set n1 [regexp {GPSLatitude=([0-9/]+), *([0-9/]+), *([0-9/]+)} $exif . lat1 lat2 lat3]
    set n2 [regexp {GPSLatitudeRef=(.)} $exif . latRef]
    set n3 [regexp {GPSLongitude=([0-9/]+), *([0-9/]+), *([0-9/]+)} $exif . lon1 lon2 lon3]
    set n4 [regexp {GPSLongitudeRef=(.)} $exif . lonRef]
    if {!$n1 || !$n2 || !$n3 || !$n4} { return "" }

    proc FixNum {ll} {
        lassign [split $ll "/"] num den
        if {$den eq "" || $den eq "1"} { return $num}
        return [expr {$num / double($den)}]
    foreach var {lat1 lat2 lat3 lon1 lon2 lon3} {set $var [FixNum [set $var]]}
    set lat [expr {($lat1 + $lat2 / 60.0 + $lat3 / 3600.0) * ($latRef eq "N" ? 1 : -1)}]
    set lon [expr {($lon1 + $lon2 / 60.0 + $lon3 / 3600.0) * ($lonRef eq "E" ? 1 : -1)}]
    return [format "%.3f %.3f" $lat $lon]
proc comma { num } {
    while {[regsub {^([-+]?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num]} {}
    return $num
# Displaying in album
proc ShowPages {pageNo} {
    WindowTitle $pageNo
    set lo [expr {int($pageNo/2) * 2}]
    set ::S(current,page) $lo
    .c itemconfig image -image {}
    ShowOnePage $lo
    ShowOnePage [expr {$lo + 1}]
proc ShowOnePage {pageNo} {
    global ALBUM
    set side [expr {($pageNo & 1) ? "recto" : "verso"}]
    foreach pocket {top left right} {
        set fullName [FindAlbumImage $pageNo $pocket]
        ::Pocket::InsertImage $side $pocket $fullName
    set text [expr {[info exist ALBUM($pageNo,text)] ? $ALBUM($pageNo,text) : ""}]
    set text [string map {\\n \n} $text]
    .c itemconfig $side,text -text $text
proc ChangePage {dir} {
    global S ALBUM
    set dir [expr {$dir == 0 ? 0 : -$dir/abs($dir)}]
    set newPage [expr {$S(current,page) + 2 * $dir}]
    set newPage [expr {int($newPage/2) * 2}]
    if {$newPage < 0} return
    set highestVerso [expr {int($ALBUM(pages)/2) * 2}]
    if {$newPage > 2 + $highestVerso} return
    lappend ::pages $newPage
    ShowPages $newPage

proc FindAlbumImage {page pocket} {
    global ALBUM
    if {! [info exists ALBUM($page,$pocket)]} { return "" }

    set fullName [FullName $ALBUM($page,$pocket)]
    if {[file exists $fullName]} { return $fullName }
    return ""
proc RemoveCroppedDuplicates {inames} {
    set result {}
    foreach item $inames {
        if {[string first "_org." $item] > -1} continue
        if {[string first "_cropped." $item] == -1} {
            set cropName [CroppedName $item]
            if {$cropName in $inames} continue
        lappend result $item
    return $result
proc CroppedName {iname} {
    set cropName "[file rootname $iname]_cropped[file extension $iname]"
    return $cropName
proc WindowTitle {page} {
    wm title . $::ALBUM(title)
    if {$page <= 1} {
        set ::S(title) "$::ALBUM(title) -- Page 1"
    } else {
        set lo [expr {int($page/2) * 2}]
        set ::S(title) "$::ALBUM(title) -- Page $lo & [expr {$lo+1}]"
    append ::S(title) " of [expr {max(1,$::ALBUM(pages))}]"

namespace eval ::Album {}

proc ::Album::Open {} {
    set newDir [tk_chooseDirectory -mustexist true -initialdir $::ALBUM(dir)]
    if {$newDir eq "" || $newDir eq $::ALBUM(dir)} return

    if {[::Album::GetImages $newDir] eq {}} {
        tk_messageBox -icon error \
            -message "Error: directory must contain the images to put into the album"
    destroy .thumbs
    ::Album::Read $newDir
    ShowPages 1

proc ::Album::Read {dir} {
    global ALBUM

    ::Album::DefaultAlbum $dir
    if {[::Album::ReadAndParse]} {
        return false

    if {$ALBUM(files) eq {}} {
        set msg "Error: cannot create photo album for directory $dir."
        set detail "There are no image files in there."
        tk_messageBox -message $msg -detail $detail -icon error
        if {$::tcl_interactive} { return -level 999 }
    ::Album::Write 1
    return true
proc ::Album::DefaultAlbum {dir} {
    global ALBUM

    unset -nocomplain ALBUM
    set ALBUM(dir) [file normalize $dir]
    set ALBUM(cache) [file join $ALBUM(dir) _photo_album.cache]
    set ALBUM(files) [::Album::GetImages $ALBUM(dir)]
    if {$ALBUM(files) ne {}} { file mkdir $ALBUM(cache) }
    set shortDir [file join [file tail [file dirname $ALBUM(dir)]] [file tail $ALBUM(dir)]]
    set ALBUM(title) "Photo Album for $shortDir"
    set ALBUM(pages) 0
    set ALBUM(sortLast) "Name"
proc ::Album::GetImages {dir} {
    return [lsort -dictionary [RemoveCroppedDuplicates \
                                             [glob -nocomplain -tail -directory $dir \
                                                  *.jpg *.png *.gif]]]
proc ::Album::Write {{force 0}} {
    global ALBUM

    if {$::S(noWrite) && ! $force} return
    set cfgFile [FullName "_photo_album.cfg"]
    set fout [open $cfgFile w]

    puts $fout [format "%-10s %s" title $ALBUM(title)]
    if {[array names ALBUM *,text] eq {}} {
        set ALBUM(1,text) "# you can actually have text on each page"
    foreach key [lsort -dictionary [array names ALBUM {[0-9]*,*}]] {
        if {$ALBUM($key) ne ""} {
            puts $fout [format "%-10s %s" $key $ALBUM($key)]
    foreach key [lsort -dictionary [array names ALBUM mark,*]] {
        if {$ALBUM($key) eq {}} continue
        puts $fout "$key $ALBUM($key)"

    close $fout
proc ::Album::ReadAndParse {} {
    global ALBUM
    set cfgFile [FullName "_photo_album.cfg"]
    if {! [file exists $cfgFile]} { return false }

    set fin [open $cfgFile r]
    set lines [split [string trim [read $fin]] \n]
    close $fin
    array unset ALBUM {[0-9]*,*}

    foreach line $lines {
        set line [string trim $line]
        if {[string match "#*" $line]} continue
        set n [regexp {^ *([^ ]+) +(.*)$} $line . name value]
        if {! $n} { error "mal-formed config line: $line" }
        if {[string match "#*" $value]} continue

        set ALBUM($name) $value
        if {[string first "," $name] > -1} {
            lassign [split $name ","] pageNo pocket
            if {[string is integer -strict $pageNo]} {
                if {$pageNo > $ALBUM(pages)} { set ALBUM(pages) $pageNo }
    return true

proc ::Album::CheckForMissingOrCropped {} {
    global ALBUM

    set needUpdate 0
    set missing {}
    for {set pageNo 0} {$pageNo <= $ALBUM(pages)} {incr pageNo} {
        foreach key [array names ALBUM $pageNo,*] {
            if {[string match "*,text" $key]} continue
            set iname $ALBUM($key)
            if {$iname in $ALBUM(files)} continue
            set cropName [CroppedName $iname]
            if {$cropName in $ALBUM(files)} {
                set ALBUM($key) $cropName
                set needUpdate 1
            } else {
                lappend missing $iname
                set ALBUM($key) ""
                set needUpdate 1
    if {$missing ne {}} {
        tk_messageBox -icon error -title "Missing images" \
            -message "Cannot find the following images for the album" \
            -detail [join $missing \n]
    if {$needUpdate} {

proc Image2Index {iname} {
    set tail [file tail $iname]
    set idx [lsearch -exact $::ALBUM(files) $tail]
    if {$idx == -1} { error "cannot find $iname in ALBUM(files)" }
    return $idx
proc Index2Image {idx} {
    return [lindex $::ALBUM(files) $idx]
proc IncrIndex {idx incr} {
    return [expr {($idx + $incr) % [llength $::ALBUM(files)]}]
proc ImageInAlbum {iname} {
    global ALBUM
    set tail [file tail $iname]
    foreach key [array name ALBUM {[0-9]*,*}] {
        if {$ALBUM($key) eq $tail} { return true }
    return false
proc FullName {fname} {
    if {$fname eq ""} { return "" }
    return [file join $::ALBUM(dir) $fname]

proc ClearCache {iname} {
    set glob "*[file tail $iname]"
    set staleFiles [glob -nocomplain -directory $::ALBUM(cache) $glob]
    file delete -- {*}$staleFiles

# Thumbnail gallery
namespace eval ::Gallery {}

proc ::Gallery::MakeWindow {} {
    global S P ALBUM
    if {[winfo exists .thumbs]} {
        raise .thumbs

    set P(thumbs,display,cols) $P(thumbs,display,cols,raw)
    set S(thumb,row,index) 0
    set S(thumb,total,rows) [expr {int(ceil([llength $ALBUM(files)] / double($P(thumbs,display,cols))))}]
    set P(thumbs,display,rows) [expr {min($P(thumbs,display,rows,raw), 1 + $S(thumb,total,rows))}]
    set P(thumbs,width) [expr {$P(thumbs,box,pixels) * $P(thumbs,display,cols)}]
    set P(thumbs,height) [expr {$P(thumbs,box,pixels) * $P(thumbs,display,rows)}]

    destroy .thumbs
    toplevel .thumbs
    wm title .thumbs "Gallery for '$ALBUM(title)'"
    wm resizable .thumbs 0 0
    wm geom .thumbs +10+10

    pack [::ttk::frame .thumbs.top -padding {.1i 0}] -side top -fill x
    pack [::ttk::scrollbar .thumbs.sb -orient v] -side right -fill y ;# NB. no -command
    pack [canvas .thumbs.c -width $P(thumbs,width) -height $P(thumbs,height) \
              -bd 0 -highlightthickness 0 -bg white]

    pack [::ttk::label .thumbs.top.count -textvariable S(thumb,count)] -side left
    tk_optionMenu .thumbs.top.sort ALBUM(sortCriteria) "Name" "In album" {*}$S(marks)
    pack .thumbs.top.sort -side right
    pack [::ttk::label .thumbs.top.lbl -text "Sort by:"] -side right
    set w [.thumbs.top.sort cget -menu]
    for {set i 0} {$i < [$w index last]} {incr i} {
        $w entryconfig $i -command [list ::Gallery::SortBy [$w entrycget $i -value]]

    for {set row 0} {$row < $P(thumbs,display,rows)} {incr row} {
        for {set col 0} {$col < $P(thumbs,display,cols)} {incr col} {
            set tag "thumb_${row}_${col}"
            set idx [::Gallery::Pos2Index $row $col]

            set xy [::Gallery::Pos2XY $row $col]

            .thumbs.c create image $xy -anchor nw -tag [list image $tag]
            .thumbs.c bind $tag <1> [list ::Gallery::Click down %x %y $row $col]
            .thumbs.c bind $tag <B1-Motion> [list ::Gallery::Click move %x %y $row $col]
            .thumbs.c bind $tag <ButtonRelease-1> [list ::Gallery::Click up %x %y $row $col]
            .thumbs.c bind $tag <<MenuMousePress>> [list DoPopup $tag thumbs %X %Y]

    bind .thumbs <Key> [list ::Gallery::KeyPress %K]

    if {"x11" eq [tk windowingsystem]} {
        bind .thumbs.c <Button-4> {::Gallery::Scroller move 1}
        bind .thumbs.c <Button-5> {::Gallery::Scroller move -1}
    } else {
        bind .thumbs.c <MouseWheel> {::Gallery::Scroller move %D}
    foreach {key action} {"m" ::Manifest::Show
        "Key-Next" {::Gallery::Scroller move -1} "Key-Down" {::Gallery::Scroller move -1}
        "Key-space" {::Gallery::Scroller move -1}
        "Key-Prior" {::Gallery::Scroller move 1} "Key-Up" {::Gallery::Scroller move 1}
        "Shift-Key-space" {::Gallery::Scroller move 1}
        "Control-z" ::Undo::Undo} {
        bind .thumbs "<$key>" $action


proc ::Gallery::ClearImage {iname} {
    set idx [Image2Index $iname]
    foreach prefix {thumb qview} {
        set img ::${prefix}::$idx
        if {$img in [image names]} {
            image delete $img
proc ::Gallery::ClearAllImages {} {
    # We link thumbnail to index into ALBUM(files), so if that changes we
    # must delete all the images
    foreach prefix {thumb qview} {
        foreach img [info commands ::${prefix}::*] {
            image delete $img

proc ::Gallery::RedrawAll {} {
    global S P ALBUM

    if {! [winfo exists .thumbs.c]} return
    .thumbs.c itemconfig image -image {}
    .thumbs.c delete checks

    for {set row 0} {$row < $P(thumbs,display,rows)} {incr row} {
        for {set col 0} {$col < $P(thumbs,display,cols)} {incr col} {
            set tag "thumb_${row}_${col}"
            set idx [::Gallery::Pos2Index $row $col]

            set fname [FullName [Index2Image $idx]]
            if {$fname eq {}} {
                .thumbs.c itemconfig $tag -image {}

            set thumbImg ::thumb::$idx

            if {$thumbImg ni [image names]} {
                lassign [::Gallery::MakeThumbnail $fname] thumbName
                image create photo $thumbImg -file $thumbName
                ::ShadowBorder::MakeShadowPhoto $thumbImg $thumbImg
                .thumbs.c itemconfig $tag -image $thumbImg
            } else {
                .thumbs.c itemconfig $tag -image $thumbImg

            set qviewImg ::qview::$idx
            if {$qviewImg ni [image names]} {
                lassign [::Gallery::MakeQViewImage $fname] qviewName
                # image create photo $qviewImg -file $qviewName
                # ::ShadowBorder::MakeShadowPhoto $qviewImg $qviewImg
            # NB. requires custom version of tooltip
            # ::tooltip::tooltip .thumbs.c -items $tag $qviewImg

            ::Gallery::ShowAnnotations $row $col

    set firstVisibleRow $S(thumb,row,index)
    set lastVisibleRow [expr {$S(thumb,row,index) + $P(thumbs,display,rows)}]
    set lo [expr {double($firstVisibleRow) / $S(thumb,total,rows)}]
    set hi [expr {double($lastVisibleRow) / $S(thumb,total,rows)}]
    .thumbs.sb set $lo $hi

    set len [llength $ALBUM(files)]
    set S(thumb,count) " $len image[expr {$len == 1 ? {} : {s}}]"

proc ::Gallery::ShowAnnotations {row col} {
    set marks [::Gallery::GetAnnotations [::Gallery::Pos2Index $row $col]]
    set tag "thumb_${row}_${col}"
    lassign [.thumbs.c bbox $tag] x0 y0 x1 y1
    if {$x0 eq ""} return
    set x [expr {$x1 - $::P(thumbs,margin,pixels)}]
    set y [expr {$y0 + $::P(thumbs,margin,pixels)}]
    foreach mark $marks {
        set id [.thumbs.c create image $x $y -anchor ne -tag checks \
                    -image ::img::$mark]
        incr y [image height ::img::$mark]
        incr y -2

        if {$mark eq "Check"} { set mark "In album" }
        ::tooltip::tooltip .thumbs.c -items $id $mark
proc ::Gallery::GetAnnotations {idx} {
    set iname [Index2Image $idx]

    set marks {}
    if {[ImageInAlbum $iname]} { lappend marks "Check" }
    if {[info exists ::ALBUM(mark,$iname)]} {
        foreach mark $::ALBUM(mark,$iname) {
            lappend marks $mark
    return $marks

proc ::Gallery::Scroller {how value args} {
    global S P ALBUM

    if {$how eq "move"} {
        if {$value > 0} {
            if {$S(thumb,row,index) > 0} {
                incr S(thumb,row,index) -1
        } elseif {$value < 0} {
            if {$S(thumb,row,index) + $P(thumbs,display,rows) < $S(thumb,total,rows)} {
                incr S(thumb,row,index)
proc ::Gallery::Pos2Index {row col} {
    return [expr {($::S(thumb,row,index) + $row) * $::P(thumbs,display,cols) + $col}]
proc ::Gallery::Index2Pos {idx} {
    set row [expr {$idx / $::P(thumbs,display,cols) - $::S(thumb,row,index)}]
    set col [expr {$idx % $::P(thumbs,display,cols)}]
    return [list $row $col]
proc ::Gallery::Pos2XY {row col} {
    global P

    set y [expr {$P(thumbs,gutter,pixels) / 2 + $P(thumbs,box,pixels) * $row}]
    set x [expr {$P(thumbs,gutter,pixels) / 2 + $P(thumbs,box,pixels) * $col}]
    return [list $x $y]

proc ::Gallery::Click {how x y row col} {
    global M S P

    set tag "thumb_${row}_$col"
    # Use window pointer position to track drag and drop outside the containing window
    lassign [winfo pointerxy .thumbs] px py

    if {$how eq "down"} {
        lassign [.thumbs.c coords $tag] x0 y0
        set dx [expr {$x - $x0}]
        set dy [expr {$y - $y0}]
        set M(left) [expr {int($px - $dx + 5)}]
        set M(top) [expr {int($py - $dy + 5)}]
        set M(px) $px
        set M(py) $py
        set M(pocket) ""

        destroy .d_and_d
        toplevel .d_and_d

        wm withdraw .d_and_d
        wm overrideredirect .d_and_d 1
        set thumbImg [.thumbs.c itemcget $tag -image]
        pack [label .d_and_d.l -image $thumbImg -anchor nw -bd 2 -relief solid -bg red]
        wm geom .d_and_d +$M(left)+$M(top)
        wm deiconify .d_and_d
        raise .d_and_d
    if {$how eq "move"} {
        if {! [winfo exists .d_and_d]} return
        raise .
        raise .d_and_d
        set dx [expr {$px - $M(px)}]
        set dy [expr {$py - $M(py)}]
        set M(px) $px
        set M(py) $py
        incr M(left) $dx
        incr M(top) $dy

        wm geom .d_and_d +$M(left)+$M(top)
        lassign [::Gallery::Pointer2Canvas .c $px $py] cx cy
        set pocket [::Pocket::XY2Pocket $cx $cy]
        if {$pocket ne $M(pocket)} {
            ::Pocket::Highlight $M(pocket) 0
            set M(pocket) $pocket
            ::Pocket::Highlight $M(pocket) 1
    if {$how eq "up"} {
        ::Pocket::Highlight $M(pocket) 0
        destroy .d_and_d
        if {$M(pocket) ne ""} {
            DragAndDrop $M(pocket) $row $col
proc ::Gallery::Pointer2Canvas {canvas px py} {
    set x [expr {$px - [winfo rootx $canvas]}]
    set y [expr {$py - [winfo rooty $canvas]}]
    return [list $x $y]
proc ::Gallery::KeyPress {K} {
    set K [string toupper $K]
    if {$K ni $::S(marks,accel)} return

    lassign [winfo pointerxy .thumbs] px py
    lassign [::Gallery::Pointer2Canvas .thumbs.c $px $py] cx cy
    lassign [::Gallery::XY2Thumbnail $cx $cy] isFound row col
    if {! $isFound} return
    set idx [::Gallery::Pos2Index $row $col]
    ::Popup::AnnotateDirect $K $idx

proc ::Gallery::XY2Thumbnail {x y} {
    foreach id [.thumbs.c find overlapping $x $y $x $y] {
        set tags [.thumbs.c itemcget $id -tags]
        if {"image" in $tags} {
            set tag [lsearch -inline -glob $tags "thumb_*"]
            set n [scan $tag "thumb_%d_%d" row col]
            if {$n != 2} { error "cannot parse $tag for thumb_##_##" }
            return [list true $row $col]
    return false

proc ::Gallery::SortBy {criteria} {
    global ALBUM

    set last $ALBUM(sortLast)
    set ALBUM(sortLast) $criteria

    if {$criteria eq $last} {
            set ALBUM(files) [lreverse $ALBUM(files)]
    } elseif {$criteria eq "Name"} {
        set ALBUM(files) [lsort -dictionary $ALBUM(files)]
    } else {
        if {$criteria eq "In album"} {set criteria "Check"}
        set matching {}
        set nonMatching {}
        for {set idx 0} {$idx < [llength $ALBUM(files)]} {incr idx} {
        set iname [Index2Image $idx]
            set annotations [::Gallery::GetAnnotations $idx]
            if {$criteria in $annotations} {
                lappend matching $iname
            } else {
                lappend nonMatching $iname
        set ALBUM(files) [concat $matching $nonMatching]
    set ::S(thumb,row,index) 0
proc ::Gallery::MakeThumbnail {fname {inBackground 0}} {
    set thumbName [GetCacheName thumb $fname]
    if {[file exists $thumbName]} { return [list $thumbName 0] }

    set size $::P(thumbs,image,pixels)
    set cmd [list "convert" "-thumbnail" "${size}x$size" "--" $fname $thumbName]
    if {$inBackground} { lappend $cmd "&" }
    MyExec $cmd
    return [list $thumbName 1]
proc ::Gallery::MakeQViewImage {fname} {
    set qviewName [GetCacheName qview $fname]
    if {[file exists $qviewName]} { return [list $qviewName 0] }

    set size $::P(thumbs,qview,pixels)
    set cmd [list "convert" "-thumbnail" "${size}x$size" "--" $fname $qviewName]
    MyExec $cmd
    return [list $qviewName 1]

set S(after,delay) 1000
proc ::Gallery::BackgroundThumbnails {files} {
    while {1} {
        if {$files eq {}} return
        set files [lassign $files iname]
        set iname [FullName $iname]
        lassign [::Gallery::MakeThumbnail $iname 1] . didConvert
        if {$didConvert} {lappend ::BG $iname}
        if {$didConvert} break
    after $::S(after,delay) ::Gallery::BackgroundThumbnails [list $files]

proc ::Gallery::DisplayQView {idx} {
    set ::Gallery::qviewIndex $idx

    set qviewImg ::qview::$idx
    if {$qviewImg ni [image names]} {
        set fname [FullName [Index2Image $idx]]
        lassign [::Gallery::MakeQViewImage $fname] qviewName
        image create photo $qviewImg -file $qviewName
        ::ShadowBorder::MakeShadowPhoto $qviewImg $qviewImg
    ::Gallery::ShowQViewImage $qviewImg
proc ::Gallery::NextQView {dir} {
    set idx [IncrIndex $::Gallery::qviewIndex $dir]
    ::Gallery::DisplayQView $idx
proc ::Gallery::ShowQViewImage {img} {
    if {! [winfo exists .quick]} {
        toplevel .quick
        pack [frame .quick.f] -fill both -expand 1
        #wm attribute .quick -topmost 1
        wm transient .quick .thumbs
        label .quick.l -image $img
        button .quick.prev -image ::img::previmage -command {::Gallery::NextQView -1} -width 40 -height 64
        button .quick.next -image ::img::nextimage -command {::Gallery::NextQView 1} -width 40 -height 64
        ::tooltip::tooltip .quick.prev "Previous quick view"
        ::tooltip::tooltip .quick.next "Next quick view"
        pack .quick.prev .quick.l .quick.next -side left -in .quick.f

        foreach {key action} {
            "Key-Next" {::Gallery::NextQView 1}
            "Key-Prior" {::Gallery::NextQView -1}
            "Key-Right" {::Gallery::NextQView 1}
            "Key-Left" {::Gallery::NextQView -1}} {
            bind .quick "<$key>" $action
    } else {
        raise .quick
        .quick.l config -image $img

proc Busy {onoff w x y} {
    $w delete busy
    if {! $onoff} return

    set id [$w create text $x $y -tag busy -fill red -anchor nw -text " Please wait... "]
    foreach xy {x0 y0 x1 y1} value [$w bbox $id] delta {-2 -2 2 2} {
        set $xy [expr {$value + $delta}]
    $w create rect $x0 $y0 $x1 $y1 -tag busy -fill yellow -outline black -width 2
    $w raise $id

# Drag and drop
proc DragAndDrop {slot row col} {
    global ALBUM S

    set idx [::Gallery::Pos2Index $row $col]
    lassign [split $slot ","] side pocket
    set iname [Index2Image $idx]

    set pageNo [expr {$S(current,page) + ($side eq "verso" ? 0 : 1)}]
    ::Undo::RegisterDragAndDropEvent $pageNo $pocket $iname
    ::Pocket::InsertImage $side $pocket $iname

# Undo
namespace eval ::Undo {}

proc ::Undo::Reset {} {
    set ::S(undo) {}
    catch {.bbar.undo config -state disabled}
proc ::Undo::RegisterDragAndDropEvent {pageNo pocket newIname} {
    global S ALBUM
    set oldIname [expr {[info exists ALBUM($pageNo,$pocket)] ? $ALBUM($pageNo,$pocket) : ""}]
    lappend ::S(undo) [list drop $pageNo $pocket $oldIname]
    set ALBUM($pageNo,$pocket) [file tail $newIname]
    set ALBUM(pages) [expr {max($ALBUM(pages), $pageNo)}]
    .bbar.undo config -state normal
proc ::Undo::RegisterRotateEvent {iname} {
    lappend ::S(undo) [list rotate $iname]
    .bbar.undo config -state normal
proc ::Undo::RegisterAnnotationEvent {iname oldMarks} {
    lappend ::S(undo) [list annotation $iname $oldMarks]
    .bbar.undo config -state normal

proc ::Undo::Undo {} {
    global S ALBUM
    if {$S(undo) eq {}} return
    set event [lindex $S(undo) end]
    set S(undo) [lrange $S(undo) 0 end-1]

    set type [lindex $event 0]
    if {$type eq "drop"} {
        ::Undo::UndoDragAndDrop $event
    } elseif {$type eq "rotate"} {
        ::Undo::UndoRotate $event
    } elseif {$type eq "annotation"} {
        ::Undo::UndoAnnotation $event

    if {$S(undo) eq {}} {
        .bbar.undo config -state disabled
proc ::Undo::UndoRotate {event} {
    lassign $event . iname dir
    set fname [FullName $iname]

    # We undo by copying back the original
    set backupName "[file rootname $fname]_org[file extension $fname]"
    if {! [file exists $backupName]} {
        tk_messageBox -icon error -message "Error: cannot undo rotation, cannot locate original image"
    file copy -force $backupName $fname
    ClearCache $fname
    ::Gallery::ClearImage $iname
proc ::Undo::UndoDragAndDrop {event} {
    global ALBUM
    lassign $event action pageNo pocket oldValue
    set currentValue [expr {[info exists ALBUM($pageNo,$pocket)] ? $ALBUM($pageNo,$pocket) : ""}]

    set ALBUM($pageNo,$pocket) $oldValue
    if {$oldValue eq ""} { unset ALBUM($pageNo,$pocket) }
    set side [expr {($pageNo & 1) ? "recto" : "verso"}]
    ::Pocket::InsertImage $side $pocket $oldValue

proc ::Undo::UndoAnnotation {event} {
    lassign $event . iname oldMarks
    set ::ALBUM(mark,$iname) $oldMarks
proc CanViewImage {} {
    global S
    if {[info exists S(viewer)]} {
        return [expr {$S(viewer) ne ""}]

    foreach cmd {iview open gnome-open} {
        if {$cmd eq "open" && $::tcl_platform(os) ne "Darwin"} continue
        set S(viewer) [auto_execok $cmd]
        if {$S(viewer) ne ""} { return true }
    return false
proc ViewImage {fname} {
    global S
    if {$S(viewer) eq ""} return
    MyExec [list $S(viewer) $fname &]
proc About {{isNewAlbum false}} {
    set msg "Photo Album\nby Keith Vetter\nMay 2016"
    set detail ""
    if {$isNewAlbum} {
        append detail "\nCreated an empty photo album '$::ALBUM(title)'\n\n"
    append detail "This tool lets you design a photo album from pictures in "
    append detail "a directory. It simulates the look of physical photo album "
    append detail "with two vertical pockets and one horizontal pocket for pictures "
    append detail "(plus a smaller pocket for a description).\n\n"
    append detail "You populate the photo album by dragging "
    append detail "thumbnails of the desired pictures and dropping them on "
    append detail "the simulacrum of a photo album. As you add more pictures "
    append detail "you can see how the finished album will look. "
    append detail "If you change your mind, you can delete a picture or replace one with another.\n\n"
    append detail "When you're satisfied with the layout, you can get a manifest "
    append detail "listing all the pictures used in the album and on which page. "
    append detail "It will also lists those images which still need to be cropped to "
    append detail "a 4x6 size ratio (see http://wiki.tcl.tk/PhotoCrop)."

    tk_messageBox -parent . -message $msg -detail $detail
    focus .

namespace eval ::Manifest {}

proc ::Manifest::Show {} {
    global ALBUM

    destroy .manifest
    toplevel .manifest
    wm title .manifest "Manifest for $ALBUM(title)"

    set manifest [string trim [::Manifest::Create]]
    set lines [llength [split $manifest "\n"]]
    set height [expr {min(30, $lines)}]

    ::ttk::scrollbar .manifest.sb_y -command {.manifest.t yview} -orient vertical
    text .manifest.t -height $height -width 80 -yscroll {.manifest.sb_y set} -wrap word

    grid .manifest.t .manifest.sb_y -sticky news
    grid [::ttk::frame .manifest.f] - -sticky ew
    grid rowconfigure .manifest 0 -weight 1
    grid columnconfigure .manifest 0 -weight 1

    ::ttk::button .manifest.f.save -text Save -command ::Manifest::Write
    ::ttk::button .manifest.f.close -text Close -command [list destroy .manifest]
    pack .manifest.f.save .manifest.f.close -pady .25i -expand 1 -side left

    .manifest.t insert end $manifest
    .manifest.t config -state disabled

proc ::Manifest::Write {} {
    set manifest [::Manifest::Create]
    set manifestFile [FullName "Photo_album.manifest"]
    set fout [open $manifestFile "w"]
    puts $fout $manifest
    close $fout
    tk_messageBox -message "Write Photo_album.manifest" -detail $manifestFile
    focus .
proc ::Manifest::Create {} {
    global ALBUM

    set manifest "Manifest for $ALBUM(title)\n\n"

    append manifest "Album directory: $ALBUM(dir)\n"
    append manifest "Pages: $ALBUM(pages)\n\n"
    set unCropped {}
    set allImages {}

    for {set pageNo 0} {$pageNo <= $ALBUM(pages)} {incr pageNo} {
        set onThisPage ""
        foreach pocket {top left right} {
            if {! [info exists ALBUM($pageNo,$pocket)]} continue
            set fname [FullName $ALBUM($pageNo,$pocket)]
            if {! [file exists $fname]} continue

            lassign [GetImageSize $fname] iwidth iheight
            set ratio [expr {max($iwidth,$iheight) / double(min($iwidth,$iheight))}]
            set is4x6 [expr {abs($ratio - 1.5) < .01}]
            if {! $is4x6} {
                lappend unCropped $ALBUM($pageNo,$pocket)
                set 4x6Marker " *"
            } else { set 4x6Marker "" }

            append onThisPage "  $pocket: $ALBUM($pageNo,$pocket)$4x6Marker\n"
            lappend allImages $ALBUM($pageNo,$pocket)
        if {$onThisPage ne ""} {
            append manifest "Page $pageNo\n"
            append manifest $onThisPage
    append manifest "\n"
    if {$unCropped ne {}} {
        set uniq [lsort -dictionary -unique $unCropped]
        append manifest "Uncropped images ([llength $uniq]):\n"
        foreach fname $uniq {
            append manifest "  $fname\n"
        append manifest "\n"
    append manifest "All images ([llength $allImages]):\n"
    unset -nocomplain cnts
    foreach fname $allImages {incr cnts($fname)}
    foreach fname [lsort -dictionary -unique $allImages] {
        if {$cnts($fname) > 1} {
            append manifest "  ($cnts($fname)) $fname\n"
        } else {
            append manifest "  $fname\n"
    append manifest "\n"

    unset -nocomplain MARKS
    foreach key [lsort -dictionary [array names ALBUM mark,*]] {
        set iname [lindex [split $key ","] 1]
        foreach mark $ALBUM($key) {
            lappend MARKS($mark) $iname
    foreach mark $::S(marks) {
        if {[info exists MARKS($mark)]} {
            append manifest "Images marked '$mark':\n"
            foreach iname [lsort -dictionary -unique $MARKS($mark)] {
                append manifest "  $iname\n"
            append manifest "\n"
    append manifest [::Manifest::CopyScript $allImages]
    return $manifest
proc ::Manifest::CopyScript {allImages} {
    if {$allImages eq {}} {
        return ""

    set script "\n# bash script to copy images used in the album to ./toBuy\n"
    append script "mkdir -p toBuy\n"
    append script "rm toBuy/\[1-9]*.jpg\n\n"
    set longest 0
    foreach iname $allImages { set longest [expr {min(45,max($longest,[string length $iname]))}] }
    set fmt "cp %-${longest}s   %s\n"

    set idx 0
    foreach iname $allImages {
        incr idx
        set dst [file join toBuy "${idx}_$iname"]
        append script [format $fmt $iname $dst]
    return $script

# ::ShadowBorder::MakeShadowPhoto -- creates an image with a shadow border
# see http://wiki.tcl.tk/ShadowPhoto
namespace eval ::ShadowBorder {}

proc ::ShadowBorder::MakeShadowPhoto {imgSrc imgDst} {
    set w [image width $imgSrc]
    set h [image height $imgSrc]

    set w1 [expr {$w + 25}]
    set w2 [expr {$w + 50}]
    set h1 [expr {$h + 25}]
    set h2 [expr {$h + 50}]

    set imgTmp [image create photo -width $w2 -height $h2]
    $imgTmp copy ::img::border::TL
    $imgTmp copy ::img::border::T -to 25 0 $w1 25
    $imgTmp copy ::img::border::TR -to $w1 0
    $imgTmp copy ::img::border::L -to 0 25 25 $h1
    $imgTmp copy ::img::border::R -to $w1 25 $w2 $h1
    $imgTmp copy ::img::border::BL -to 0 $h1
    $imgTmp copy ::img::border::B -to 25 $h1 $w1 $h2
    $imgTmp copy ::img::border::BR -to $w1 $h1
    $imgTmp copy $imgSrc -to 25 25

    if {$imgDst in [image names]} { image delete $imgDst }
    image create photo $imgDst -width $w2 -height $h2
    $imgDst copy $imgTmp
    image delete $imgTmp

    return $imgDst

# ::ShadowBorder::_MakeBorderImages -- makes 8 images which forming the shadow
# gradient for the four sides and four corners.
proc ::ShadowBorder::_MakeBorderImages {} {
    if {[info commands ::img::border::T] ne ""} return

    set gradient {\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#8d8d8d \#999999
        \#a6a6a6 \#b2b2b2 \#bebebe \#c8c8c8 \#d0d0d0 \#dadada \#e2e2e2 \#e8e8e8
        \#eeeeee \#f2f2f2 \#f7f7f7 \#fcfcfc \#fdfdfd \#fdfdfd \#ffffff \#ffffff
        \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff
        \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff}

    image create photo ::img::border::T -width 1 -height 25
    image create photo ::img::border::B -width 1 -height 25
    image create photo ::img::border::L -width 25 -height 1
    image create photo ::img::border::R -width 25 -height 1
    image create photo ::img::border::TR -width 25 -height 25
    image create photo ::img::border::TL -width 25 -height 25
    image create photo ::img::border::BR -width 25 -height 25
    image create photo ::img::border::BL -width 25 -height 25

    for {set x 0} {$x < 25} {incr x} {
        ::img::border::B put [lindex $gradient $x] -to 0 $x
        ::img::border::R put [lindex $gradient $x] -to $x 0

        for {set y 0} {$y < 25} {incr y} {
            set idx [expr {$x<5&& $y<5 ? 0 : round(hypot($x,$y))}]
            ::img::border::BR put [lindex $gradient $idx] -to $x $y
    ::img::border::TL copy ::img::border::BR -subsample -1 -1
    ::img::border::TR copy ::img::border::BR -subsample 1 -1
    ::img::border::BL copy ::img::border::BR -subsample -1 1

    ::img::border::L copy ::img::border::R -subsample -1 1
    ::img::border::T copy ::img::border::B -subsample 1 -1

# Text boxes
proc CreateTextBox {side} {
    lassign [.c bbox $side,message] x0 y0 x1 y1
    set w [expr {$x1 - $x0 - 5}]

    set tag $side,text
    .c create text $x0 $y0 -tag $tag -width $w -anchor nw -font $::S(text,font)
    .c move $tag 3 2


# Thumbnails and quick view generation
namespace eval ::Indexer {
    variable fileList {}
    variable done ""
    variable status ""
proc ::Indexer::DoDisplay {} {

    destroy .indexer
    ::ttk::frame .indexer
    ::ttk::label .indexer.title -text "Indexing pictures in\n$::ALBUM(title)" \
        -font $::S(title,font) -anchor c -justify c
    ::ttk::label .indexer.title2 -textvariable ::Indexer::status -font $::S(text,font) -anchor c
    ::ttk::scrollbar .indexer.sb -command {.indexer.lb yview}
    listbox .indexer.lb -listvariable ::Indexer::fileList -yscrollcommand {.indexer.sb set} \
        -width 50 -height 5

    ::ttk::button .indexer.cancel -text "Cancel" -command {set ::Indexer::done cancelled}

    pack .indexer.title -side top
    pack .indexer.title2 -side top
    pack .indexer.cancel -side bottom -pady .2i
    pack .indexer.sb -side right -fill y
    pack .indexer.lb -side left -fill both -expand 1

    place .indexer -relx .5 -rely .3 -anchor c
proc ::Indexer::WhoNeedsIndexing {} {
    set ::Indexer::fileList {}
    for {set idx 0} {$idx < [llength $::ALBUM(files)]} {incr idx} {
        set iname [Index2Image $idx]
        set thumbName [GetCacheName thumb $iname]
        set qviewName [GetCacheName qview $iname]
        if {! [file exists $thumbName] || ! [file exists $qviewName]} {
            lappend ::Indexer::fileList " $iname"
proc ::Indexer::IndexAll {} {
    if {$::Indexer::fileList eq {}} { destroy .indexer ; return }

    set ::Indexer::done ""
    after idle [list ::Indexer::IndexOne 0]
    tkwait variable ::Indexer::done
proc ::Indexer::IndexOne {idx} {
    variable fileList
    variable done
    variable status

    if {$done ne ""} return

    while {$idx < [llength $fileList]} {
        set iname [string trim [lindex $fileList $idx] " \u2713"]
        lassign [::Gallery::MakeThumbnail [FullName $iname]] . didThumb
        lassign [::Gallery::MakeQViewImage [FullName $iname]] . didQView

        lset fileList $idx "\u2713 $iname"
        incr idx
        if {$didThumb || $didQView} break
    set status "[expr {$idx+1}] of [llength $fileList]"
    if {$idx >= [llength $fileList]} {
        set ::Indexer::done done
    .indexer.lb see [expr {$idx + 1}]
    after 100 [list ::Indexer::IndexOne $idx]
proc ::Indexer::Done {} {
    destroy .indexer.done
    set txt "Indexing $::Indexer::done"
    label .indexer.done -text $txt -font $::S(title,font) \
        -bd 2 -relief solid -padx .25i -pady .25i
    place .indexer.done -relx .5 -rely .5 -anchor c
    after 2000 [list destroy .indexer]

    if {[catch {set alpha [wm attributes .indexer -alpha]}]} {
        after 2000 [list destroy .indexer]
    } else {
        wm attributes .indexer -alpha .99
        for {set i 0} {1} {incr i} {
            set when [expr {2000 + $i * 50}]
            if {$alpha <= 0} {
                after $when [list destroy .indexer]
            after $when [list wm attributes .indexer -alpha $alpha]
            set alpha [expr {$alpha - .2}]

# See http://plainicon.com/
image create photo ::img::manifest -data {
image create photo ::img::thumbs -data {
image create photo ::img::undo -data {
image create photo ::img::nextpage -data {
image create photo ::img::prevpage -data {
image create photo ::img::info -data {
image create photo ::img::open -data {
image create photo ::img::nextimage -data {
image create photo ::img::previmage
::img::previmage copy ::img::nextimage -subsample -1 1

# Icons for thumbnail markings: http://www.iconsdownload.net
# Names must match S(marks)
image create photo ::img::Check -data {
image create photo ::img::Animal -data {
image create photo ::img::Family -data {
image create photo ::img::Friends -data {
image create photo ::img::Best -data {
image create photo ::img::Trash -data {
image create photo ::img::Other -data {
image create photo ::img::Underwater -data {

if {[auto_execok convert] eq "" || [auto_execok identify] eq ""} {
    wm withdraw .
    tk_messageBox -icon error -message "ERROR: Photo Album require Image Magick to run"
    exit 1

if {$argv eq {}} { set argv [pwd] }
set dir [lindex $argv 0]

set isNewAlbum [::Album::Read $dir]

if {$isNewAlbum} {
    About $isNewAlbum
ShowPages 1