Photo Album
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 https://wiki.tcl-lang.org/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 https://wiki.tcl-lang.org/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