[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

    ::tooltip::clear
    ::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 }
        return
    }

    # 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
    ::Gallery::RedrawAll
    ::Album::Write
    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 ""
    ::Gallery::RedrawAll
}
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
    ::Gallery::RedrawAll
}
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
        update
    }
    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"
        return
    }
    ::Gallery::ClearAllImages
    destroy .thumbs
    ::Album::Read $newDir
    ShowPages 1
    ::Indexer::IndexAll
    ::Gallery::MakeWindow
}

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

    ::Undo::Reset
    ::Album::DefaultAlbum $dir
    if {[::Album::ReadAndParse]} {
        ::Album::CheckForMissingOrCropped
        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 }
        exit
    }
    ::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} {
        ::Album::Write
    }
}

################################################################
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
        ::Gallery::RedrawAll
        return
    }

    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
    }

    ::Gallery::RedrawAll
}


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 {}
                continue
            }

            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
                update
            } 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
                ::Gallery::RedrawAll
            }
        } elseif {$value < 0} {
            if {$S(thumb,row,index) + $P(thumbs,display,rows) < $S(thumb,total,rows)} {
                incr S(thumb,row,index)
                ::Gallery::RedrawAll
            }
        }
    }
}
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
        return
    }
    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
        }
        return
    }
    if {$how eq "up"} {
        ::Pocket::Highlight $M(pocket) 0
        destroy .d_and_d
        if {$M(pocket) ne ""} {
            DragAndDrop $M(pocket) $row $col
        }
        return
    }
}
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]
    }
    ::Album::Write
    set ::S(thumb,row,index) 0
    ::Gallery::ClearAllImages
    ::Gallery::RedrawAll
}
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
    update
}


################################################################
#
# 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
    ::Gallery::RedrawAll
}

################################################################
#
# 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
    ::Album::Write
}
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"
        return
    }
    file copy -force $backupName $fname
    ClearCache $fname
    ::Gallery::ClearImage $iname
    ::Gallery::RedrawAll
}
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

    ::Gallery::RedrawAll
    ::Album::Write
}
proc ::Undo::UndoAnnotation {event} {
    lassign $event . iname oldMarks
    set ::ALBUM(mark,$iname) $oldMarks
    ::Gallery::RedrawAll
}
################################################################
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} {
    ::ShadowBorder::_MakeBorderImages
    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

    return
}

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

    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 {} {
    ::Indexer::WhoNeedsIndexing
    if {$::Indexer::fileList eq {}} { destroy .indexer ; return }
    ::Indexer::DoDisplay
    update

    set ::Indexer::done ""
    after idle [list ::Indexer::IndexOne 0]
    tkwait variable ::Indexer::done
    ::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
        return
    }
    .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]
    return

    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]
                break
            }
            after $when [list wm attributes .indexer -alpha $alpha]
            set alpha [expr {$alpha - .2}]
        }
    }
}




# See http://plainicon.com/
image create photo ::img::manifest -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAABb0lEQVRYheXXsStFYRjH8Q8ZJOmuFhlMBg
    wWJbNk8G8oMvoDTJRBYuGPUKKsRiEZTAYZXJMkycZwDvfKdd733ve63fjW2+mp9/ec33ne5zydw3+no469
    45iJ3HuI01QDq+iriocxFWngGFdV8ROWI7WflPHWpFX+6SadARMPmMjXWh3m16p0D0Ubi47gw3V/fu1FKd
    LAI55/yPOFrsiE8oTPwV11EmughCHc5WtIuBrXsko0TFmlfLOyZlrJ433hxputkecbsRW4xS7O8vgI9xGa
    JAqdNytPbAVGsIgD7GEBowHNJi4j89ekJT0QOwdS3oLCOVBES3ogNIo/SDmCQmKb8AkXKk9yk8chTRJt9R
    oOyD5GznGCaQwGNIcSh1FbjeJLzMsqAFuyoRTSJNFWPTCFDexgWzZmJwOaJdm3YSGxBvowpjLNBvM4pEmi
    rSbhrxE6gm7MJd6jG6+NCFvyX1BUgXX0NOK8Bi9NyvMHeQe4aac35w1N9QAAAABJRU5ErkJggg==}
image create photo ::img::thumbs -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAA6ElEQVRYhe2VMQ6CQBBFXywtjUeh4kCewc
    SSYG9hYSg4CDW1ByAcgpoCi4G4EHCJw7LN/mSqZfPe7gwA2ycCMqAG2r7ewMkBa5QjkAPdpBog3gNe+oKD
    x5OD9NwbHGTgpgLXlXs3Gcx6RqBYsS9G3g512hmBFjhb4E3/nBOBDrhY4IOoOtWCQNVLmDdhwjukfeq8Fg
    TMdhTIYDaTtWwLgadF4FdFWniqgOdaeKKAl8jn2ws8dw1/IINZ8f0d18jAqXtugydagAaeBniAB3iAB/g/
    OVjW78DNpcCQuVtwenKbxO5wU2JX+Ac2hgXUUMkWNAAAAABJRU5ErkJggg==}
image create photo ::img::undo -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAABGklEQVRYhe3VvytGURzH8ZcnGWQyGJ4kSQ
    aDZPBHmGQwGSSzyVP+AZPBX2CUwWgy+wNsSgZRKHqSDBJ6DPe5deN6nnN/bM67vnVPnXM/784593uJRCL/
    nYGS6xqYwTRG8YlHXOC+rMxUwJxFHOAJnT/qCruYKCpw3g3IYxInPULz6h37GAkVuMZzjsQyXgqGZ+sSs6
    ECnR8S6/jqE3CHPSxJ7sU45rGGI7yhjYVQgVRiGx89gl+xhaE+723iEA9duSCBfnUjcFszbOC0DoG25PMr
    wyZWqwqslAxP2akicFYxnKQ/zKWDRsHFxzUI3Eo65y9CdiCvT5RhrKxAXRLDVQTqkMg9+iICtR3HYOa5pc
    CPo0uzqkAkEol8A6tbq0l7zHtVAAAAAElFTkSuQmCC}
image create photo ::img::nextpage -data {
    R0lGODlhIAAgAPEDAAAAAMDAwICAgAAAACH5BAUAAAMALAAAAAAgACAAQAKCnI+pywz9gAgL2IuzFnE2pY
    WW95Xm+RgXIrQSdQ6RmlqyTMb6zutp9er9QKrcQYTEHI2HgPMJdV5agVUwNrNptUxT9AvticfkcikpGUey
    2e75ZrXhYFh4TYZxO+wrfJWJFjin0FJoaJjRskRn8jPilHCFgqJXQclocqhpiGnm+VlWAAA7}
image create photo ::img::prevpage -data {
    R0lGODlhIAAgAPEDAAAAAMDAwICAgAAAACH5BAUAAAMALAAAAAAgACAAQAKAnI+pyxMCRmSzoRcBBLz7/y
    UYSFbWiZ6YwCLdYaqQJE2ckaX6zvfL2IjJbMEdBlZKvi6zzmMDCEinVOmvecvmhI2ql+oLi8dkH7TUO2a2
    OeOstt66Qza5DhO4wbO0O1YJKPI2wPLBcoiIqHB0AYQzl8LFwHgieZWIeVi2ydl5UgAAOw==}
image create photo ::img::info -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAB4ElEQVRYheWXsUscQRSHv1v28R7WcqTJEY
    KFiII2wUKIRdpAiE2KgDYpIkQrG8Fa9DguEEgaQa3CpU0RyJ9gmUJCIApGRIKFpNBZV9Ri9+A8uMOdPTfF
    /WBh5rHzft/Ozr6ZhX5XCUDUAuAJ8KAg32NgJ47cVUnUysBXoALsAVf3bB4Aj4ED4HlJ1BrAJTAbR+7yns
    0BELUQ2AZCRO1c1IaKMG6DGBK18wAw4NQjwbSo/U6vaQ+GU8BCj4FN1YEPLe0JnyR5AM6Ahy1tLwU5AN4A
    o8BI2vaS1wykn24ZWE1DZVE7iSP3txAAYAmYIykokBSwrTSeSXlewUYcubE4cmPAhm+SPAAvRK2eY3wugE
    3gM/D6vwDEkdsFvuQ19wYQtUlgsS08JWoLhQAAMyTbdzXtfwN+AWtFAQD8AL6L2jjwD2j4JPGtA3+AV8Cz
    tvhu5kyidi1qg54g3hK1QVG7DoAjkppetEaBo5BkIW2K2jvgZ5cBh3HkXLMjapAcrXzW0TDJVl4NgffARQ
    rS6VA6AKwA6y3mNWAecB3GdNNx6vfxTneL2idRW26ai1pN1PZFreJhfkuZpq/lyV8CT+PIHRQJEPTaHLLV
    gbcka6Vn5pBtBnpufmeJ2iNRK+q3rc90A9iKayTqe99XAAAAAElFTkSuQmCC}
image create photo ::img::open -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAACHElEQVR42u3XTUgVURjG8Xf6Iij6WNSiTU
    iLFm0qgoiSFn3sQiiUoMCwWhRRQhDlJpRSIqhFlJuyXIQoERFBuCqpKBKLdoEbaRERklgZopT9H+a9NEyj
    3ns517u5L/zweObeO885Z+YwE1lcu3EJm7HQ/q8pfEMPzuO7BarIT/4UC/L8zmtU43eoAG+wtcDvHcDDUA
    EmLHvaZyotxf0izvcLby2xhAowFWIkBdQPnMa9cgVQ/cFOvEwG+IBjnrBUtRbdWGHxEh5OBtDtdWUORv8Y
    +zR6VCcDnMPVOQjwCDV4hR2VAJUAlQDlCHAHDeUMoDqIOuwvZYAtGiFWWby9v8MzTPrxxRgvRYDtuIFNGc
    c+owmduY7QAepx22Z/umrHydABNPLnqZP/xDjmY2Xq82dxLWQArXF62o+iA+vxMXVsDFWhAuiC68/onymA
    qlEBJn3aLqKlyACNuO5tTfsZb7/AIJZb/CCrOpWYqQcK8B4b8RWX/QfyrQ7/24oL3h62+NabrnI7oaov8n
    /0iD2viJEvs/ge19NUm/eNYJu3v2AUi1DlfTexy9tPIm/U+g+sKzCA1n4Ae9GbcXy2a6AlSnVorfJ9QzIf
    fe69YghrCgigJ+MNkYWrI7ib6tP19QlL7d+050ob1vGQAVS3cCKPz+n9cg/GQgdQaYdrxpKMY5p2LYluW2
    1EVooAKt2Ghyzenldb/C6onbLLUtfCXz4DlGzydueYAAAAAElFTkSuQmCC}
image create photo ::img::nextimage -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAQAAADZc7J/AAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6Jg
    AAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAAmJLR0QA/4ePzL8AAAAHdElNRQfgBxMPLxew
    j2/UAAACeUlEQVRIx6WVTUhUURTHf/fNmzHTzD6GRPIjB6pFEuXGwBZCJIZCMBCBlGGLCrLVRPSh46YIjE
    A3tTNbmKskghZFZFFQ0JeSVAoqNeRoilAizNh4WsyzYd67bxzo/Vf3/s/5n4977n1K+L/P1G8v8UbG+WSt
    8tnJXsqVzljZM4jxWQYY5JfDtIQgNQRURoEFumSQny7peiijhTrldRN4IV2MrVKzQS0XKFIagVfSznRWja
    slRJmyCTyXjizdAXZzSxVaGVm13ySK2NBAhWMviY/0ShywjjFGp3yxxVjHRYJEOcY3bQ69BKRBWRmMyFNH
    DA9+oIh2SrQ5LHAnVUI/UyRsmCXEEMvsp5NCB5sgwQeeCRgQ54k2xiyXGAb2EGKj1uIxfzDgpcyzrMUIp5
    kEjtCGV8MPEREDxlw6LQhTtDEBHOIMOZocZzHgvUv8JAZpYQKTs7SibNwUUQwQbYtS+MpVZjA5yWEHJxhx
    YhlKWBmbCJBLHXk2BkwfXlZ7VBrZAczRzW8HZ0I+yxmcc2kiDEQ4xzsbl4MXEyozZtDEeSDOZV477PxswY
    R9JFycvTRyDZjnCg81fDFbMWG7KpdxrcABwgBc5762zCo2KQNMmjEcnTeop4cSFrnBbRY1Z+PjBEbyMh0k
    4BggP634gLt0u4xYPdsUWGp9UiB5aSiQ4zIq/bbdFKpkWARZedLiNMsDR427mHZ9oXsIJv8TKxV9l6DkZI
    n10iH/ZjHVlDGpEV9WCMucTkCYk7BsEDMjKqVP0m5D+tHEuCfV4nHBWjkqQ7KU5qF0Y/xIBnjLDD+s9RqK
    KKWaU1Qou63S34MlJiUl4KOYUjYrj8byL5AmGwIJZMc9AAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDE2LTA3LT
    E5VDE1OjQ3OjIzLTA3OjAw8g23QwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAxNi0wNy0xOVQxNTo0NzoyMy0w
    NzowMINQD/8AAAAASUVORK5CYII=}
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 {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAX1JREFUOI2tky
    2uAkEQhL/ZbAICFG5vACfgAFg84QAgkFwChcJikGgSBA4LAonAo8CQLAlhqSdgh/0Zfl5CJSN2pru6urrX
    AOIBH0C6f3sAYRgCYOIwL/Us6f4U3wJcLhd4xKtcLiuGJUnCT6YaY57kANPplPl8/lQXR8RZKcmWJivJBW
    PMs04WQRDYUilBk8mE6/VqGYrFYq68bbhWqwnQarVSEoDbDKfObwOdVuTY3nXd7XZpNBqpO2VxOBwEqN1u
    p5vJTSEzqlTp0WgEQLPZBOB0OuXkaDweC1CpVBKgfr+f89Fq3Gw2AuT7fk7zS40ue34/mW9h3ZH09YmiiP
    V6TRRF9i4J4RjiK8xms9hVAdput0mn9S/CVqtlE4Mg0PF4zI7uO8L9fq9KpWKTOp1OLsZJuFgs7EO9Xtdu
    t7NLBcjzPC2XS2dRJ+HtdtNwOFShUEj5BKharep8Pr/s4mPLYRiq1+vJ8zwNBoO3liQJ7R7qw3Z/QvzH/n
    yx/wA9Vzt+ahTfrwAAAABJRU5ErkJggg==}
image create photo ::img::Animal -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAWxJREFUOI29k7
    HOKVEUhb8tEhGFZp5AIhKJ8A4imknEA5jCG6i0XoN4CgodpU4rGoVEpZiKCMW6BeaaMX7j5s9d1WTvddY6
    6+w9Bog7UgCtVgtJGCDp1rQHLS2JyWSCPXohXkgJwMxIpVJhkWeko0fN7HbccRwGg8HfjiR5nqf7pwBZ1N
    rM4q8UReDzjGazyXq95ng8xucB2O/3nM9nyuUyvV4vrJrUOvYxYslJiWlu3h+tX1K/wwvR8zxc1/2Z2G63
    yWazzGYzut3uC1kP7HY7ARoOh+p0OkGde+BoQYBWq1Wono5IJw/zDr8/maQIsnya4ieYGZAg8+l04nK5fC
    Ue/H/P2Gw28n1f+XxepVJJ/X5fgJbL5Qs3MtJ4wWKxqHq9Lt/3NRqNtFgsNJ/P5bquAF2v1+8Et9utarVa
    aJkymYzG4/G/3XA6ncpxHBUKBTUaDVUqFeVyOVWrVR0Oh7eCwdr8tyl/LcwvL/Yf949rQErZxW0AAAAASU
    VORK5CYII=}
image create photo ::img::Family -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAqZJREFUOI2tVD
    1LK1EQPbNczDVg1i9itUL2iWKhorXiDxB2QbAWRSy1iLV2BgtF7QTBKgQstbKy1FIUIkIkiiBYCUGjkI3n
    FXFvsjx98cE7sMXcmXvOzJ2ZFQDEJywAyOVyEBEIAJI1p4RhCiJo1RoolUoM/czlcmwEANBxHF5dXZEkLy
    8vKY1aRpMkFhcXQRLxeLx2WqlUCBGSpOM4BEBLKQVLBGJZmJ6erkWSZLlcZqVSCZUZSf07iAhUaKysrKCt
    rQ1ra2sAgMfHR2xsbGBiYsJc4MvLCyFCiHBmZoZbW1ssFouECI+PjxmWR5L0fZ+xWIwkOTAwQJJcXl5mPp
    +v5/jXBMM8fxqoPrWbVm2Fxvz8fMR5e3uLdDptbAsAgiBAKpXC6empcaTTaZRKpchluq7L7u5u07dCocCR
    kRFChGdnZ/XnOTo6IkQ4NTXFzc1NJpNJ+r5PiPDt7a3WbAA4Pz/H2OgotNY4PDzEzc2NkdNa16VJMpPJsF
    gscnJyks/Pz4bxj6H4+PiAZVkIggBKKVSrVZCEUqo++M2f+x8681OYxpAESby/v2Nvbw/5fN6cffWVy+WI
    3Qh+1k2SvLu74+vrKwuFAr/D09MTh4aGuLu727jP9f6FhPv7+4QIOzs7KSLs7+9ntVqNkC0sLBAijMfjhA
    hd12UQBIbQlHxycoLV1VW0ag3btkMVjI+P4+HhAQcHB5idnQVJ+J6HRCIBoDae2Wz265KXlpbMxkKEWmve
    398zmUwSItze3jbL6nkeIcKLi4tIyVYj887ODnzPQ2Z9HbGWFlxfX6O3txeDg4OwEwnMzc2Z2FQqBQBQSj
    VSIEIIALZto729HT09PeYP2NHRgeHhYVhWLdxxHPT19eGX66Krqyty38xhs+VvBhGJEv4v/AbE0d1CK1hV
    vAAAAABJRU5ErkJggg==}
image create photo ::img::Friends -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAATNJREFUOI2tk7
    HNgzAQhb9DSHQULJAlGMJdZsgWdKTMDFCwQkoqtjEjkPL+4o8d2xCCojzJsu7u+fx8vhNAeSIjgDdUFXG0
    LAr7UNd1AOR5zuVyefEdC4idPo+Lru5OAxnA/X6PnKKqKiKx8//0Om9EEiF3xvV6pWkabrcbAMYYxnHEGB
    NnFBHcvoWohCHJydktxqbOo8Q8TP82m8hLo4gwDAMiQt/3fnfIAKZpom1bTqcTbdtireXxeGCt/awxLVm2
    RdpC1AHho9IGeMZVwz1cznf46t//zFFEI6eqzPNMXdfUdc08zx9td26VMMWyLJRlufKXZcmyLLsqfVWrqt
    J3tltFUUS/ktq+hulQ7Q3ZHjd68vl8Zs8+wokUwnqqU5Vb6sJzhxvxKFYKv070VPjzxv4D/C7b293NwLMA
    AAAASUVORK5CYII=}
image create photo ::img::Best -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAWtJREFUOI2tkj
    GugkAQhr/dkGhhQ4KJd/AG9lYeQCruoZUVidELYMkdrEzUws64nZ2dHYm9MYZ9xQN1YUHfi38Fwz/fzDAj
    AE0mCXC9XtFaIwCt9e9HkducPCLzJMNnkADO5zNhGJqQVznFVCHEM300GpWZrVbr6S6WFkLYWyrKqPOoIS
    Wz2YzNZmOfJ9fhcKDX67Hf70tk/arT6aTn87kRA7T1Z1j7/NToZLXrabapq2QY1+s1YRgipT3fmHA4HOqi
    yOZ4BKbTqd7tdlopVTIaNe73O9vtFs/z6nscj8c0m01ut1t5cj48iu9v5lM5+cO7Nt9JCAFYzjZXmqYEQU
    AQBKRpWnqvUiVQSkkcx7TbbRqNBovFgk6nQxzHlRdTCwRIkgTP85hMJlwuF1zXJUmSupR6YBRF+L6PUgql
    FL7vE0VRLfCxZdtSVqsVx+ORwWAAwHK5pNvt0u/3y6BsKbXAv+jtlv8N5suH/QMpe+ZfvAITCwAAAABJRU
    5ErkJggg==}
image create photo ::img::Trash -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAiJJREFUOI2tUz
    Fr8lAUPTdoq4NulVZcslh0ce/UQSgt7g4uguJfcPYvtHXqIIhdXLoILiUupUORQilkjVDQDoUMDtFAcjrU
    vDatpeHjO/BI3svJOe/ed54AIDbQAGBnZwfkxxoXiwVJUgKaRhIiAm02m8H3/Q8eSVqWxQACgIZhAABWqx
    VOT08hX72UJ0mQRCaTUb5a8LVer6NarQIAYsFiPp/H7u4ulPXd3R11XWer1WLgwe8YjUah+a9EEaGI0HEc
    RVQbAgDXdQEAjuMAABKJxGc5wcvNzQ0sy8J4PEYqlYLv+9C0T52tzdiGyERtU40aw+EwNA+6+6PqdDpN27
    b/bk+326WIsFKphIih9pyfnyObzQIAyuUy1ut1aJ/qz9fXV5JkMpmkrushRdkQwxVu+hfETkQ+U/Hy8gLH
    cbC3t4d2u42DgwOYpolisRi2HgwGvLy8ZKPRoO/7JMlarRa2jtLwyMSoUG38fmrBMAwDIgIRgWmav/K+gt
    iS8a9YLpfs9/s8Pj7m1dXVVk6g86fgxcUF4/E4M5mMuki5XI5nZ2f0PC+64HQ6ZSKRUNf29vZWCTabzX/f
    YYC3tzfGYjEl+vT0FE3w+vo6RAzmJycnPDw8JEkeHR2xUChEE7y/v+dkMqFt25xOp3x8fGSv16OI8OHhgS
    Q5n8+paRo7nc4PQZVDbo7e8zw8Pz+rCJRKJdi2Ddd1sb+//2v+ROTjif8c7HdjU8NBxfiKuAAAAABJRU5E
    rkJggg==}
image create photo ::img::Other -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAWpJREFUOI2tlK
    GuwlAQRM/CDZBgyh/gEVgcCQJQSD4Kh6rkMzAkQMCB5wNwIEg9yTxBb/Pa3sLLC2Oabmfnzt2d1ACRogaQ
    JAmSMEDS66N5Ws1Xary+kz6lwWCg0+kk3yRJSpJEHvb7rOxMSUii3W5nekjSfr/PWgHhX+bzeVa0zGIKM8
    tbr4KZvS7hMRqNGA6H3G43zKzUoCIAxXGcN1kkHg4HFWtAeBhBn38luvTs92rFW282G5rNJtPpNNiQM/14
    PNTv9zWbzXL1nOJ2uyWKIsbjMdfrtVpRkuI4VqPRKI2nRJxMJsEFlIiALpdLqeYCPsIj4tub+Ssyi5+2+A
    k+vrUqwm63wzmHmeGco16vY2a0Wi3O5/Nb8VKcJSmKIgFar9e53QLqdrtVq1OlYBHL5VJmJkCr1er/gs/n
    U51OR4COx2Mlz+uUclPE/X5nsVgA0Ov1PtGrZ+jhfxkEkhxymOVQX4rN14P9Ax1sKGnJY+6aAAAAAElFTk
    SuQmCC}
image create photo ::img::Underwater -data {
    iVBORw0KGgoAAAANSUhEUgAAABQAAAAUCAYAAAH6ji2bAAAABGdBTUEAAYagMeiWXwAAAXJJREFUOI21k7
    GqwkAQRc+KgiCksFFsLQQ7P8HSXxDt8kPRz7AWQ2r7FCmsLBWxEURQwTiv0OzLxo0Gnu/Cwk5mdubO3IkC
    hCdKpFAGEHk4VRKmQ8qGKzHSkOQEQSCO44hOYpTJPlVKwWKxkHQKQAx2y+XyEZ0trZTKp5QNLCU9DodDNp
    sN/X6f1WrFbDZjMpkQRdFvP1lSSikZj8fieZ40m83HN0COxyPr9Tq3dK/XwzoMK8+igYZgudmSrougBBBF
    EdPplPl8ThiGDAYDttsto9HIqPaiV71e13ff9wWQsq3M9XolCAJ833+fsdvtiojIbrfTYihAwjDMbaLdbu
    M4TvGl+L4yRaGn84nmJyilAF6Vvlwuhn0+n3N9WVuT4/lPY5GoyEm/1QzjOH7bUqPRoFarWX33+13fCy/3
    fr/H8zwOhwMiQhzHnE4nKpWKMX/rytogIriui+u6dDodWq0Wt9uNarVqxOm1+TeV/4qvL/YPdVjl/2tjzW
    0AAAAASUVORK5CYII=}

################################################################

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]

BestSize
DoDisplay
DrawPage
update
set isNewAlbum [::Album::Read $dir]

if {$isNewAlbum} {
    About $isNewAlbum
}
::Indexer::IndexAll
ShowPages 1
::Gallery::MakeWindow
return

======


----

<<categories>>Enter Category Here