# ibisa - Image-Based Identification/Search for Archaeology
# Copyright (C) 2008, 2009 Anthony Beurive'

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

package require Tcl 8.5

namespace eval ::ibisa {

    variable acronym "IBISA"
    variable acronymMeans "Image-Based Identification / Search for Archaeology"
    variable copyright "Copyright (C) 2008, 2009 Anthony Beurive'"
    variable version:number "1.2"
    variable version "1.2"

    # Set by ::ibisa::init.
    variable appDir
    variable tclDir
    variable libDir
    variable octaveDir
    variable imgDir
}

proc ::ibisa::getv {varName} {
    return [subst \${::ibisa::$varName}]
}

proc ::ibisa::setv {varName value} {
    set ::ibisa::$varName $value
}

proc ::ibisa::init {} {
    puts "Welcome to [getv acronym] v[getv version]"
    puts [getv acronymMeans]
    puts [getv copyright]

    set dict [info frame 0]
    set file [dict get $dict file]
    variable appDir [file dirname [file dirname $file]]
    variable tclDir [file join $appDir tcl]
    variable libDir [file join $appDir lib]
    variable octaveDir [file join $appDir octave]
    variable imgDir [file join $appDir images]
}

# Fire at once.
::ibisa::init
package provide ibisa ${::ibisa::version:number}

# Proceed with the rest.
package require Tk
package require task
package require chrono
package require map
source [file join $::ibisa::tclDir "misc.tcl"]

namespace eval ::ibisa {
    # Set by ::ibisa::init:script:run.
    variable homeDir
    variable dbDir
    variable appDB:file
    variable appDB
    variable appDB:version $version
    variable appDB:variables
    variable imgDBDir
    variable imgDB:file
    variable imgDB
    variable collection:name
    variable collection:format

    variable init:script ""
    variable init:script:errors {}
    variable first:time 0
    variable exit:called 0

    # Main widget names.
    variable about .ibisa:about
    variable toplevel .ibisa
    variable menu .ibisa.menu
    variable canvas .ibisa.canvas

    # Array of preferences.  Set by ::ibisa::init:script:run.
    ::map::array:variable options

    # Array of GUI event data.
    ::map::array:variable events
    variable event:counter 0

    # Cache of photo data, as retrieved from the image database.
    ::map::array:variable photo:info
}

proc ::ibisa::start {} {
    tk appname $::ibisa::acronym
    ttk::setTheme classic
    wm withdraw .
    init:script:run
    about:destroy
    toplevel:show
}

proc ::ibisa::exit {} {
    if [getv exit:called] return
    setv exit:called 1

    variable canvas
    if [winfo exists $canvas] {
        status:bar:message "Quitting..."
    }

    puts "Quitting..."
    catch {
        update
        exit:iworkers
        exit:databases
        toplevel:destroy
    }
    ::exit
}


# Init script.

proc ::ibisa::init:script:clear {} {
    variable init:script ""
}

proc ::ibisa::init:script:append {script} {
    uplevel [subst -nocommands {
        variable init:script
        foreach line [split {$script} "\n"] {
            set line [string trim \$line]
            if {\$line == ""} continue
            append init:script \$line "\n"
        }
    }]
}

proc ::ibisa::splash:view:trace {args} {
    set file [options:get splash:view:file]
    set value [options:get splash:view]
    if $value {
        # Touch file.
        close [open $file w+]
    } elseif [file exists $file] {
        file delete $file
    }
}

proc ::ibisa::init:script:run {} {
    variable options
    trace add variable options(splash:view) \
        write "::ibisa::splash:view:trace"

    init:script:build
    variable init:script:task
    set init:script:task [::task::new [getv init:script]]
    ${init:script:task} run ::ibisa::init:script:report
    unset init:script:task
}

proc ::ibisa::init:script:build {} {
    init:script:clear
    init:script:append {
        ::chrono::trigger
        puts "Running init script... "
        flush stdout
    }

    init:script:append {
        # Setting up files...
        setv homeDir [getHomeDirectory]
        setv dbDir [file join [getv homeDir] ".ibisa"]
        if ![file exists [getv dbDir]] { setv first:time 1 }
        init:dir dbDir [getv dbDir]

        # Check if the splash screen should be displayed, ASAP.
        set splash:view:file [file join [getv dbDir] ".view_splash"]
        options:set splash:view:file ${splash:view:file}
        if [getv first:time] { close [open ${splash:view:file} w+] }
        options:set splash:view [file exists ${splash:view:file}]

        if [options:get splash:view] {
            about:show
            [getv about].message \
                configure -text \
                "Running init script..."
            ::chrono::sleep 1
        }

        setv appDB:file [file join [getv dbDir] "ibisa.options"]
        setv imgDBDir [file join [getv dbDir] "ibisa" "images"]
        setv imgDB:file [file join [getv dbDir] "ibisa" "collection"]
    }

    init:script:append {
        # Loading packages... libibisa
        package require libibisa
        # Loading packages... database
        package require database
        # Loading packages... image
        package require image
        # Loading packages... octave
        package require octave
        # Loading packages... color
        package require color
        # Loading packages... icanvas
        package require icanvas
        # Loading packages... iworker
        package require iworker

        # Initialiazing options... geometry
        set screenwidth [winfo screenwidth .]
        set screenheight [winfo screenheight .]
        set width [expr min(800, $screenwidth)]
        set height [expr min(500, $screenheight)]
        set rootx [expr ($screenwidth - $width) / 2]
        set rooty [expr ($screenheight - $height) / 2]
        options:set toplevel:geometry ${width}x${height}+${rootx}+${rooty}
        options:set space 5

        # Initialiazing options... colors
        set bg #fff8e8
        set bg2 [::color::darker $bg 0.05]
        set bg3 [::color::darker $bg 0.1]

        options:set background $bg
        tk_setPalette [options:get background]

        # Initialiazing options...
        source [file join [getv tclDir] "help.tcl"]
        options:set menu:view 1
        options:set help:frame:view 1
        options:set help:frame:coords {1 1 320 150}
        options:set help:frame:anchor {anchor help:frame -from se -to se -x -5 -y -5}
        options:set help:frame:fill white
        options:set help:frame:outline #663
        options:set help:frame:outline:width 1

        options:set toolbar:view 1
        options:set toolbar:coords {1 1 32 32}
        options:set toolbar:fill $bg2
        options:set toolbar:outline $bg2
        options:set toolbar:outline:width 1

        options:set status:bar:view 1
        options:set status:bar:coords {1 1 24 24}
        options:set status:bar:fill $bg2
        options:set status:bar:outline $bg3
        options:set status:bar:outline:width 1

        options:set work:area:photo:margin 10
        options:set photo:outline:eraser:width 20
        options:set photo:tools:view 0

        options:set import:directory [getv homeDir]

        # Initialiazing events...
        events:set help:frame:frozen 0
        events:set last:help:tag ""
        events:set last:x:y {0 0}
        events:set photo:search:pattern "all"

        # Initialiazing Octave...
        ::octave::init [getv octaveDir]
    }

    init:script:append {
        # Setting up databases...
        setv appDB:variables {
            ::ibisa::appDB:version
            ::ibisa::imgDBDir
            ::ibisa::imgDB:file
            ::ibisa::options
        }

        init:databases
    }

    init:script:append {
        # Setting up iworkers...
        init:iworkers
    }

    init:script:append {
        # Preparing fonts...
    }
    for {set i 4} {$i <= 32} {incr i} {
        set name ::font::$i
        set nameb ${name}b
        init:script:append "
            createFont $name -family fixed -size -$i
            createFont $nameb -family fixed -size -$i -weight bold
        "
    }

    init:script:append {
        options:set work:area:photo:mode zoom
        puts [format "Running init script... done. \[%.2fs]" [::chrono::trigger]]
    }
}

proc ::ibisa::init:script:report {task percent status {message ""}} {
    variable about

    switch $status {
        start {
            if ![winfo exists $about] return
            $about.message configure -text "Running init script..."
            ::chrono::sleep
        }
        comment {
            if ![winfo exists $about] return
            set message [string trim [string range $message 1 end]]
            $about.message configure -text $message
            ::chrono::sleep
        }
        step {
            if ![winfo exists $about] return
            set width [winfo width $about.scale]
            set length [expr $width * $percent]
            $about.scale configure -sliderlength $length
            ::chrono::sleep
        }
        end {
            if ![winfo exists $about] return
            set width [winfo width $about.scale]
            $about.scale configure -sliderlength $width
            $about.message configure -text ""
            ::chrono::sleep
            if ![winfo exists $about] return
            $about.scale configure -sliderlength 0
        }
        error {
            variable init:script:errors
            lappend init:script:errors $message

            # Exit now anyway.
            if ![winfo exists $about] exit
            $about.scale configure -background red
            $about.message configure \
                -text [string trim $message] \
                -foreground red

            bind $about <ButtonPress> {
                ::ibisa::exit
            }

            vwait $about
        }
        default {
            puts "warning: unknown task status '$status':\
                    $task $percent $status $message"
        }
    }
}

proc ::ibisa::init:dir {var dir} {
    if ![file exists $dir] { file mkdir $dir }
    if ![file exists $dir] { error "directory does not exist: $dir" }
    if ![file isdirectory $dir] { error "not a directory: $dir" }
    if ![file readable $dir] { error "directory is not readable: $dir" }
    if ![file writable $dir] { error "directory is not writable: $dir" }
    setv $var $dir
}

proc ::ibisa::init:databases {} {
    foreach db {appDB imgDB} {
        init:database $db
    }
}

proc ::ibisa::init:database {db} {
    set file [getv $db:file]
    set init ![file exists $file]
    setv $db [::database::new $file]
    if $init init:$db
    read:$db
}

proc ::ibisa::exit:databases {} {
    foreach db {appDB imgDB} {
        exit:database $db
    }
}

proc ::ibisa::exit:database {db} {
    if ![info exists ::ibisa::$db] continue
    save:$db
    [getv $db]::delete
}

# At creation time, saves the default values of variables.
proc ::ibisa::init:appDB {} {
    save:appDB
}

# Reads variable values from application database.
proc ::ibisa::read:appDB {} {
    variable appDB
    foreach var [getv appDB:variables] {
        if [array exists $var] {
            # Variable is an array.
            foreach {key val} [array get $var] {
                foreach record [$appDB map:get $var $key] {
                    lassign $record var key val
                    set "$var\($key\)" $val
                    break
                }
            }
            continue
        }

        # Variable is not an array.
        foreach record [$appDB map:get $var] {
            lassign $record var val
            set $var $val
            break
        }
    }

    init:dir imgDBDir [getv imgDBDir]

    # Check version compatibility.
    set then [getv appDB:version]
    set now [getv version]
    if {$then < $now} {
        # No compatibility issues so far.  Can update to new version.
        setv appDB:version [getv version]
    }
}

# Saves current variable values in application database.
proc ::ibisa::save:appDB {} {
    variable appDB
    foreach var [getv appDB:variables] {
        if [array exists $var] {
            # Variable is an array.
            foreach {key val} [array get $var] {
                $appDB map:set [list $var $key] $val
            }
            continue
        }

        # Variable is not an array.
        $appDB map:set $var [subst $\{$var\}]
    }
}

proc ::ibisa::init:imgDB {} {
    variable imgDB
    # Store version information.
    $imgDB map:set ::ibisa::version $::ibisa::version
}

proc ::ibisa::read:imgDB {} {
    setv collection:format [collection:format [getv imgDB:file]]
    setv collection:name [collection:name [getv imgDB:file]]
    if {[getv collection:format] == "1.0"} {
        event collection:convert:from:1.0
    }
}

proc ::ibisa::save:imgDB {} {
}


# iworkers.

proc ::ibisa::init:iworkers {} {
    events:set iworker [::iworker::new]
}

proc ::ibisa::exit:iworkers {} {
    foreach iworker [::iworker::names] {
        $iworker delete
    }
}


# About frame (and splash screen).

proc ::ibisa::about:show {{copyright ""}} {
    variable about
    if [winfo exists $about] {
        raise [winfo toplevel $about]
        return
    }

    about:build $copyright
    about:bind
    wm overrideredirect $about 1
    centerToplevel $about [getv toplevel]
}

proc ::ibisa::about:build {{copyright ""}} {
    variable about
    toplevel $about -border 0 -background #222

    set ibis256 ::img::ibis256
    image create photo $ibis256 -file [file join [getv imgDir] ibis256.gif]
    label $about.image -image $ibis256
    $about.image configure -background #222 -border 0
    pack $about.image

    foreach i {10 20 14 12} {
        set name ::font::$i
        set nameb ${name}b
        createFont $name -family fixed -size -$i
        createFont $nameb -family fixed -size -$i -weight bold
    }

    frame $about.space
    $about.space configure -background #222
    pack $about.space -pady 10

    label $about.acronym -text "[getv acronym]"
    $about.acronym configure -font ::font::20b
    $about.acronym configure -background #222 -foreground white
    pack $about.acronym

    label $about.text -text "[getv acronymMeans]"
    $about.text configure -wraplength [expr 0.9 * [image width $ibis256]]
    $about.text configure -font ::font::14
    $about.text configure -background #222 -foreground white
    pack $about.text

    label $about.version -text "v[getv version]"
    $about.version configure -font ::font::12
    $about.version configure -background #222 -foreground white
    pack $about.version

    label $about.message
    $about.message configure -wraplength [expr [image width $ibis256] - 4]
    $about.message configure -justify left -anchor w
    $about.message configure -font ::font::10
    $about.message configure -background #222 -foreground #AAA
    pack $about.message -anchor w -expand 1 -fill x -padx 2

    scale $about.scale -orient horizontal \
        -relief flat -sliderrelief flat -state disabled \
        -showvalue 0 -borderwidth 0 -takefocus 0 \
        -background #222 -troughcolor #222 \
        -activebackground #222 -highlightbackground #222 \
        -sliderlength 0 -width 4
    pack $about.scale -expand 1 -fill x -padx 2 -pady 2

    if {$copyright != ""} {
        label $about.copyright -text "[getv copyright]"
        $about.copyright configure -wraplength [expr 0.9 * [image width $ibis256]]
        $about.copyright configure -font ::font::10
        $about.copyright configure -background #222 -foreground #888
        pack $about.copyright -anchor s
    }
}

proc ::ibisa::about:destroy {} {
    variable about
    if [winfo exists $about] {
        destroy $about
    }

    # Raise main frame.
    variable toplevel
    if [winfo exists $toplevel] {
        wm deiconify $toplevel
        raise $toplevel
    }
}

proc ::ibisa::about:bind {} {
    variable about

    bind $about <ButtonPress> {
        ::ibisa::about:destroy
        break
    }

    bind $about.scale <Configure> {
        after 0 {
            %W configure -sliderlength 0
            %W configure -background #666
        }
    }
}


# Toplevel.

proc ::ibisa::toplevel:show {} {
    variable toplevel
    if [winfo exists $toplevel] {
        raise [winfo toplevel $toplevel]
        return
    }

    toplevel:build
    toplevel:bind

    if [getv first:time] {
        centerToplevel $toplevel
        fixGeometry $toplevel
    } else {
        initGeometry $toplevel [options:get toplevel:geometry]
        fixGeometry $toplevel
    }

    if [options:get menu:view] {
        toplevel:menu:build
        $toplevel configure -menu [getv menu]
    }

    canvas:bind
    toplevel:set:traces
}

proc ::ibisa::reload:code {} {
    operation:cancel
    toplevel:unbind
    canvas:unbind
    events:unset work:area:view:stacks
    events:unset photo:outlines
    #work:area:photo:history:reset

    source [file join [getv tclDir] ibisa.tcl]
    source [file join [getv tclDir] database.tcl]
    source [file join [getv tclDir] help.tcl]
    source [file join [getv tclDir] image.tcl]
    source [file join [getv tclDir] icanvas.tcl]
    source [file join [getv tclDir] octave.tcl]

    after 100 {
        ::ibisa::toplevel:bind
        ::ibisa::canvas:bind
        ::ibisa::operation:end
        ::ibisa::canvas:button:toggles:reset
        ::ibisa::toolbar:build:default:buttons
        ::ibisa::status:bar:message "Code reloaded!"
    }
}

proc ::ibisa::toplevel:build {} {
    variable toplevel
    scan [options:get toplevel:geometry] "%dx%d" width height

    toplevel $toplevel -width $width -height $height
    wm title $toplevel [getv acronym]

    variable imgDir
    ::image::load [file join $imgDir ibis32.png] ::image::ibis32
    wm iconphoto $toplevel ::image::ibis32

    toplevel:build:canvas $width $height
}

proc ::ibisa::toplevel:menu:build {} {
    variable menu

    proc menu {name args} {
        eval ::menu $name \
            -tearoff 0 -relief groove -borderwidth 1 \
            -activeborderwidth 0 -font ::font::12 \
            $args
    }

    menu $menu
    $menu configure -relief flat

    # Collection.

    menu $menu.collection
    $menu add cascade \
        -label "Collection" \
        -underline 0 \
        -menu $menu.collection

    $menu.collection add command \
        -label "New..." \
        -underline 0 \
        -accelerator "Ctrl+n" \
        -command {::ibisa::collection:open 1}

    $menu.collection add command \
        -label "Open..." \
        -underline 0 \
        -accelerator "Ctrl+o" \
        -command {::ibisa::collection:open 0}

    $menu.collection add command \
        -label "Rename..." \
        -underline 0 \
        -command ::ibisa::collection:rename

    $menu.collection add separator

    $menu.collection add command \
        -label "Import New Photos..." \
        -underline 0 \
        -accelerator "Ctrl+i" \
        -command ::ibisa::collection:import

    $menu.collection add command \
        -label "Clear Collection!" \
        -underline 0 \
        -command ::ibisa::collection:clear

    $menu.collection add command \
        -label "Clear 'visited' Flags" \
        -underline 1 \
        -command ::ibisa::collection:clear:visited:flags

    $menu.collection add separator

    $menu.collection add command \
        -label "Quit" \
        -underline 0 \
        -accelerator "Ctrl+q" \
        -command ::ibisa::exit

    # View.

    menu $menu.view
    $menu add cascade \
        -label "View" \
        -underline 0 \
        -menu $menu.view

    $menu.view add radiobutton \
        -label "Zoom Mode" \
        -underline 0 \
        -accelerator "z" \
        -variable ::ibisa::options(work:area:photo:mode) \
        -value "zoom"

    $menu.view add radiobutton \
        -label "Outline Mode" \
        -underline 2 \
        -accelerator "s" \
        -variable ::ibisa::options(work:area:photo:mode) \
        -value "outline"

    $menu.view add radiobutton \
        -label "Eraser Mode" \
        -underline 0 \
        -accelerator "e" \
        -variable ::ibisa::options(work:area:photo:mode) \
        -value "eraser"

    $menu.view add radiobutton \
        -label "Tag Mode" \
        -underline 0 \
        -accelerator "t" \
        -variable ::ibisa::options(work:area:photo:mode) \
        -value "tags"

    $menu.view add separator

    $menu.view add checkbutton \
        -label "Splash Screen" \
        -underline 1 \
        -variable ::ibisa::options(splash:view) \
        -onvalue 1 -offvalue 0

    $menu.view add checkbutton \
        -label "Help Frame" \
        -underline 0 \
        -accelerator "F1" \
        -variable ::ibisa::options(help:frame:view) \
        -onvalue 1 -offvalue 0

    $menu.view add checkbutton \
        -label "Toolbar" \
        -underline 0 \
        -accelerator "F5" \
        -variable ::ibisa::options(toolbar:view) \
        -onvalue 1 -offvalue 0

    $menu.view add checkbutton \
        -label "Status Bar" \
        -underline 0 \
        -accelerator "F6" \
        -variable ::ibisa::options(status:bar:view) \
        -onvalue 1 -offvalue 0

    $menu.view add checkbutton \
        -label "Menu" \
        -underline 0 \
        -accelerator "F7" \
        -variable ::ibisa::options(menu:view) \
        -onvalue 1 -offvalue 0

    $menu.view add checkbutton \
        -label "Photo Tools" \
        -underline 0 \
        -accelerator "F8" \
        -variable ::ibisa::options(photo:tools:view) \
        -onvalue 1 -offvalue 0

    # Segmentation.

    menu $menu.segmentation
    $menu add cascade \
        -label "Segmentation" \
        -underline 0 \
        -menu $menu.segmentation

    $menu.segmentation add command \
        -label "Normalize Outline" \
        -underline 0 \
        -command {::ibisa::event photo:outline:normalize}

    $menu.segmentation add command \
        -label "Adjust Outline" \
        -underline 0 \
        -command {::ibisa::event photo:outline:adjust}

    # Registration.

    menu $menu.registration
    $menu add cascade \
        -label "Registration" \
        -underline 0 \
        -menu $menu.registration

    $menu.registration add command \
        -label "Set Photo Reference" \
        -underline 8 \
        -command ::ibisa::work:area:photo:reference:set

    $menu.registration add command \
        -label "Unset Photo Reference" \
        -underline 1 \
        -command ::ibisa::work:area:photo:reference:clear

    $menu.registration add separator

    $menu.registration add command \
        -label "Intercorrelation" \
        -underline 0 \
        -command {::ibisa::event current:photo:intercorrelation}

    $menu.registration add command \
        -label "Photo Registration" \
        -underline 10 \
        -command {::ibisa::event photo:registration}

    $menu.registration add command \
        -label "Group Registration" \
        -underline 10 \
        -command {::ibisa::event group:registration}

    $menu.registration add separator

    $menu.registration add command \
        -label "Show Neighbors" \
        -underline 0 \
        -command {::ibisa::event photo:show:neighbors}

    $menu.registration add command \
        -label "Clear Photo Neighbors" \
        -underline 0 \
        -command {::ibisa::event photo:clear:neighbors}

    $menu.registration add command \
        -label "Clear All Neighbors!" \
        -underline 0 \
        -command {::ibisa::event clear:all:neighbors}

    # Help.

    menu $menu.help
    $menu add cascade \
        -label "Help" \
        -underline 0 \
        -menu $menu.help

    $menu.help add command \
        -label "About [getv acronym]..." \
        -underline 0 \
        -command {::ibisa::about:show copyright}

    $menu.help add command \
        -label "Reload Source Code" \
        -underline 0 \
        -command {::ibisa::reload:code}

    toplevel:menu:bind
    toplevel:menu:check:status
}

proc ::ibisa::toplevel:menu:check:status {} {
    variable menu

    if ![winfo exists $menu] return

    # Segmentation.
    $menu.segmentation entryconfigure "Normalize Outline" -state disabled
    $menu.segmentation entryconfigure "Adjust Outline" -state disabled

    if {[work:area:mode:get] == "photo"} {
        if {[llength [photo:outline:get:lines]] > 0} {
            $menu.segmentation entryconfigure "Normalize Outline" -state normal
        }

        if {[llength [photo:outline:get:closed:lines]] == 1} {
            $menu.segmentation entryconfigure "Adjust Outline" -state normal
        }
    }

    # Registration.
    $menu.registration entryconfigure "Set Photo Reference" -state disabled
    $menu.registration entryconfigure "Unset Photo Reference" -state disabled
    $menu.registration entryconfigure "Intercorrelation" -state disabled
    $menu.registration entryconfigure "Photo Registration" -state disabled
    $menu.registration entryconfigure "Group Registration" -state disabled
    $menu.registration entryconfigure "Show Neighbors" -state disabled
    $menu.registration entryconfigure "Clear Photo Neighbors" -state disabled
    $menu.registration entryconfigure "Clear All Neighbors!" -state disabled

    set current [work:area:current:photo:get]
    work:area:photo:reference:get ref _

    if {$current != ""} {
        $menu.registration entryconfigure "Show Neighbors" -state normal
        $menu.registration entryconfigure "Clear Photo Neighbors" -state normal
        $menu.registration entryconfigure "Clear All Neighbors!" -state normal

        if {$current != $ref} {
            $menu.registration entryconfigure "Set Photo Reference" -state normal
        }
    }

    if {$ref != ""} {
        $menu.registration entryconfigure "Unset Photo Reference" -state normal
        $menu.registration entryconfigure "Photo Registration" -state normal
        $menu.registration entryconfigure "Intercorrelation" -state normal
    }

    if {[work:area:mode:get] == "thumbnails"} {
        $menu.registration entryconfigure "Group Registration" -state normal
    }
}

proc ::ibisa::toplevel:menu:bind {} {
    variable menu
    bind $menu <<MenuSelect>> {::ibisa::toplevel:menu:select %W}
    foreach menu_ [winfo children $menu] {
        bind $menu_ <<MenuSelect>> {::ibisa::toplevel:menu:select %W}
    }
}

proc ::ibisa::toplevel:menu:select {w} {
    if {$w == ""} return
    set label [$w entrycget active -label]
    if {$label == ""} return
    set old [events:get menu:select]
    if {$label == $old} return
    events:set menu:select $label

    # FIXME: normalize label better.
    set label [string tolower $label]
    set label [split $label]
    set label [join $label ":"]
    help:frame:update:help:tag $label
}

proc ::ibisa::toplevel:build:canvas {width height} {
    variable canvas
    icanvas $canvas -width $width -height $height -highlightthickness 0
    pack $canvas -expand 1 -fill both
}

proc ::ibisa::toplevel:destroy {} {
    variable toplevel
    if [winfo exists $toplevel] {
        destroy $toplevel
    }
}

proc ::ibisa::toplevel:bindings {} {
    return {
        <Control-q> ::ibisa::exit
        <Command-q> ::ibisa::exit
        <Destroy> { ::ibisa::destroy:callback %W }
        <Escape> ::ibisa::about:destroy
        <Configure> { ::ibisa::event configure:event %W }
    }
}

proc ::ibisa::destroy:callback {window} {
    variable toplevel
    if {$window == $toplevel} ::ibisa::exit
}

proc ::ibisa::toplevel:bind {} {
    variable toplevel
    foreach {tag sequence} [toplevel:bindings] {
        bind $toplevel $tag $sequence
    }
}

proc ::ibisa::toplevel:unbind {} {
    variable toplevel
    foreach {tag sequence} [toplevel:bindings] {
        bind $toplevel $tag ""
    }
}

proc ::ibisa::toplevel:set:traces {} {
    foreach var {
        menu:view
        help:frame:view
        toolbar:view
        status:bar:view
        photo:tools:view
        work:area:photo:mode
    } {
        # Tracing the variable.
        trace add variable ::ibisa::options($var) \
            write "::ibisa::$var:trace"

        # A toggle procedure, if boolean.
        if {[string first "view" $var] != -1} {
            proc ::ibisa::$var:toggle {} [subst -nocommands {
                options:set $var [expr ![options:get $var]]
            }]
        }

        # A virtual event to eventually update the GUI.
        #options:set $var [options:get $var]
    }
}

proc ::ibisa::toplevel:configure:event {} {
    set geometry [getGeometry [getv toplevel]]
    options:set toplevel:geometry $geometry
}

proc ::ibisa::menu:view:trace {args} {
    variable toplevel
    variable menu
    if [options:get menu:view] {
        if ![winfo exists $menu] {
            toplevel:menu:build
            $toplevel configure -menu [getv menu]
        }
    } else {
        destroy $menu
        $toplevel configure -menu ""
    }
}


# Canvas.

proc ::ibisa::canvas:bindings {} {
    return {
        <FocusOut> { ::ibisa::canvas:focus:out }
        <Motion> { ::ibisa::canvas:mouse:motion %x %y }
        <ButtonPress> { ::ibisa::canvas:mouse:press %b %x %y }
        <ButtonRelease> { ::ibisa::canvas:mouse:release %b %x %y }
        <MouseWheel> { ::ibisa::canvas:mouse:wheel %b %D %x %y }
        <KeyPress> { ::ibisa::canvas:key:press %K %A %x %y }
        <KeyRelease> { ::ibisa::canvas:key:release %K %A %x %y }
    }
}

proc ::ibisa::canvas:bind {} {
    variable canvas
    foreach {tag sequence} [canvas:bindings] {
        bind $canvas $tag $sequence
    }

    $canvas bind all <Enter> { ::ibisa::canvas:mouse:enter %x %y }
    $canvas bind all <Leave> { ::ibisa::canvas:mouse:leave %x %y }

    canvas:bind:windows
    focus $canvas
}

proc ::ibisa::canvas:unbind {} {
    variable canvas
    foreach {tag sequence} [canvas:bindings] {
        bind $canvas $tag ""
    }
}

proc ::ibisa::canvas:bind:windows {} {
    variable canvas

    # Should be done with every new window item.
    foreach item [$canvas find all] {
        if {[$canvas type $item] != "window"} continue
        set window [$canvas itemcget $item -window]
        bind $window <Motion> { ::ibisa::canvas:callback:window:mouse:motion %W %X %Y %x %y }
        bind $window <Leave> "focus $canvas"
    }
}

proc ::ibisa::canvas:configure:event {} {
    variable canvas

    # Hierarchy order.
    $canvas add:children ibisa \
        status:bar \
        toolbar toolbar:contents \
        work:area \
        help:frame

    # Status bar.
    if {[$canvas find withtag status:bar] == {}} {
        status:bar:build
        $canvas place:callback status:bar ::ibisa::status:bar:place:callback
    }

    if ![options:get status:bar:view] {
        $canvas place:set away status:bar
    } else {
        $canvas place:set anchor status:bar -from sw -to sw -expand:x 1
    }

    # Toolbar.
    if {[$canvas find withtag toolbar] == {}} {
        toolbar:build
        $canvas place:callback toolbar ::ibisa::toolbar:place:callback
    }

    if ![options:get toolbar:view] {
        $canvas place:set away toolbar
    } else {
        $canvas place:set anchor toolbar -from nw -to nw -align:min 32 -expand:x 1
    }

    # Work area.
    if {[$canvas find withtag work:area] == {}} {
        work:area:build
        $canvas place:set anchor work:area -expand:x 1 -expand:y 1
        $canvas size:set:callback work:area ::ibisa::work:area:size:set:callback
        $canvas place:callback work:area ::ibisa::work:area:place:callback
    }

    # Help frame.
    if {[$canvas find withtag help:frame] == {}} {
        help:frame:build
        event 100 help:frame:update:help help:frame
        eval $canvas [options:get help:frame:anchor]
        $canvas anchor:adjust help:frame
        options:set help:frame:anchor [$canvas place:get help:frame]
        $canvas place:callback help:frame ::ibisa::help:frame:place:callback
    }

    if ![options:get help:frame:view] {
        $canvas place:set away help:frame
    } else {
        eval $canvas place:set [options:get help:frame:anchor]
    }

    # Update layout.
    after 0 $canvas places:update
}

proc ::ibisa::canvas:focus:out {} {
    canvas:clear:modifiers
}

proc ::ibisa::canvas:mouse:enter {x y} {
    canvas:callback:mouse:motion $x $y
}

proc ::ibisa::canvas:mouse:leave {x y} {
}

proc ::ibisa::canvas:mouse:motion {x y} {
    canvas:callback:mouse:motion $x $y
}

proc ::ibisa::canvas:mouse:motion {x y} {
    canvas:callback:mouse:motion $x $y
}

proc ::ibisa::canvas:mouse:press {b x y} {
    photo:search:cancel
    canvas:callback:mouse:press $b $x $y
}

proc ::ibisa::canvas:mouse:release {b x y} {
    photo:search:cancel
    canvas:callback:mouse:release $b $x $y
}

proc ::ibisa::canvas:mouse:wheel {b D x y} {
    photo:search:cancel
    canvas:callback:mouse:wheel $b $D $x $y
}

proc ::ibisa::canvas:key:press {K A x y} {
    canvas:callback:key:press $K $A $x $y

    switch $K {
        F1 { help:frame:view:toggle }
        F2 { help:frame:scroll -1 pages }
        F3 { help:frame:scroll 1 pages }
        F4 { help:frame:frozen:toggle }
        F5 { toolbar:view:toggle }
        F6 { status:bar:view:toggle }
        F7 { menu:view:toggle }
        F8 { photo:tools:view:toggle }
        Escape { operation:cancel }

        n { if [canvas:check:modifier Control] {collection:open 1} }
        o { if [canvas:check:modifier Control] collection:open }
        i { if [canvas:check:modifier Control] collection:import }
        k { if [canvas:check:modifier Control] collection:search }
        F12 { if [canvas:check:modifier Control] reload:code }

        default { work:area:keypress $K }
    }
}

proc ::ibisa::canvas:key:release {K A x y} {
    canvas:callback:key:release $K $A $x $y
}


# Status bar.

proc ::ibisa::status:bar:view:trace {args} {
    canvas:configure:event
}

proc ::ibisa::status:bar:build {} {
    variable canvas

    set r [$canvas create rectangle \
               [options:get status:bar:coords] \
               -fill [options:get status:bar:fill] \
               -outline [options:get status:bar:outline] \
               -width [options:get status:bar:outline:width]]
    $canvas add:children status:bar $r
    $canvas addtag help:tag:status:bar withtag status:bar

    set t [$canvas create text 0 0 -text "" \
               -anchor w -font ::font::12 \
               -tags status:bar:text]
}

proc ::ibisa::status:bar:place:callback {event} {
    variable canvas
    switch $event {
        start {
            $canvas away status:bar
            $canvas away status:bar:text
        }
        end {
            $canvas anchor status:bar:text \
                -in status:bar -from w -to w -x 10
        }
    }
}

proc ::ibisa::status:bar:message {{text ""}} {
    variable canvas
    after cancel [events:get status:bar:eraser]
    if {[$canvas find withtag status:bar:text] == {}} return
    $canvas itemconfigure status:bar:text -text $text
    #puts $text
    events:set status:bar:eraser \
        [after 10000 $canvas itemconfigure status:bar:text -text \"\"]
}

proc ::ibisa::status:bar:current:message {} {
    variable canvas
    if {[$canvas find withtag status:bar:text] == {}} { return "" }
    return [$canvas itemcget status:bar:text -text]
}


# Progress bar.

proc ::ibisa::progress:bar:reset {args} {
}

proc ::ibisa::progress:bar:update {args} {
}

proc ::ibisa::progress:bar:text {args} {
}


# Toolbar.

proc ::ibisa::toolbar:view:trace {args} {
    canvas:configure:event
}

proc ::ibisa::toolbar:build {} {
    variable canvas

    set r [$canvas create rectangle \
               [options:get toolbar:coords] \
               -fill [options:get toolbar:fill] \
               -outline [options:get toolbar:outline] \
               -width [options:get toolbar:outline:width]]

    $canvas add:children toolbar $r
    $canvas addtag help:tag:toolbar withtag toolbar
    toolbar:build:default:buttons
}

proc ::ibisa::toolbar:build:default:buttons {} {
    toolbar:buttons:set {}

    set buttons {}
    foreach {button:tag help:tag image cmd} {
        button:collection:import collection:import plus collection:import
        button:operation:cancel operation:cancel times operation:cancel
        button:collection:search collection:search search collection:search
        button:home home home work:area:home
        button:context:back context:back left work:area:photo:history:back
        button:context:forward context:forward right work:area:photo:history:forward
        button:context:up context:up up context:up
        button:context:down context:down down context:down
        button:photo:zoom:mode photo:zoom:mode zoom photo:zoom:mode
        button:photo:outline:mode photo:outline:mode outline photo:outline:mode
        button:photo:eraser:mode photo:eraser:mode eraser photo:eraser:mode
        button:photo:outline:extract photo:outline:extract extract photo:outline:extract
        button:photo:tags photo:tag:mode tag photo:tag:mode
        button:group:registration group:registration register group:registration
    } {
        set tag [canvas:button:build ${button:tag} ${help:tag} $image $cmd]
        lappend buttons $tag
        canvas:button:state $tag disabled
    }

    toolbar:buttons:set $buttons
}

proc ::ibisa::toolbar:place:callback {event} {
    switch $event {
        start {
            variable canvas
            $canvas away toolbar
            $canvas away toolbar:contents
        }
        end {
            toolbar:buttons:set [toolbar:buttons]
        }
    }
}

proc ::ibisa::toolbar:buttons {} {
    return [events:get toolbar:buttons]
}

proc ::ibisa::toolbar:buttons:set {new} {
    set old [events:get toolbar:buttons]
    events:set toolbar:buttons $new

    variable canvas
    $canvas remove:children toolbar:contents

    foreach button $old {
        if {[lsearch -exact $new $button] != -1} continue
        $canvas delete $button
    }

    set bbox [$canvas coords:bbox toolbar]
    lassign [$canvas grid:properties $bbox 32] m w n h

    set idx 0
    set nbuttons [llength $new]
    for {set j 0} {$j < $n && $idx < $nbuttons} {incr j} {
        for {set i 0} {$i < $m && $idx < $nbuttons} {incr i; incr idx} {
            set x [expr $w * (0.5 + $i)]
            set y [expr $h * (0.5 + $j)]
            set button [lindex $new $idx]
            $canvas anchor $button -in toolbar -to nw -x $x -y $y
        }
    }

    eval $canvas add:children toolbar:contents $new
    toolbar:buttons:check:status
}

proc ::ibisa::toolbar:add:buttons {new} {
    set buttons [toolbar:buttons]
    foreach button $new {
        if {[lsearch -exact $buttons $button] != -1} return
        lappend buttons $button
    }
    toolbar:buttons:set $buttons
}

proc ::ibisa::toolbar:remove:buttons {new} {
    set buttons [toolbar:buttons]
    foreach button $new {
        while {[set idx [lsearch -exact $buttons $button]] != -1} {
            set buttons [lreplace $buttons $idx $idx]
        }
    }
    toolbar:buttons:set $buttons
}

proc ::ibisa::toolbar:clear:buttons {} {
    toolbar:buttons:set {}
}

proc ::ibisa::toolbar:buttons:check:status {{buttons {}}} {
    toplevel:menu:check:status
    if {$buttons == {}} { set buttons [toolbar:buttons] }
    foreach button $buttons {
        switch $button {

            button:collection:import {
                set state "normal"
                if {[work:area:mode:get] != "thumbnails"} { set state "disabled" }
                canvas:button:state $button $state
            }

            button:operation:cancel {
                set operation [operation:get:current]
                set state [expr {$operation == "" ? "disabled" : "normal"}]
                canvas:button:state $button $state
            }

            button:home {
                if {[work:area:mode:get] == "photo"} {
                    set state "normal"
                } else {
                    set state "disabled"
                }
                canvas:button:state $button $state
            }

            button:context:back {
                work:area:photo:history:get index history
                set state [expr {$index >= 0 ? "normal" : "disabled"}]
                canvas:button:state $button $state
            }

            button:context:forward {
                work:area:photo:history:get index history
                set state [expr {$index + 1 < [llength $history] ? "normal" : "disabled"}]
                canvas:button:state $button $state
            }

            button:context:down {
                switch [work:area:mode:get] {
                    thumbnails {
                        set state disabled

                        set properties [events:get work:area:grid:properties]
                        lassign $properties m w wp n h hp
                        if {$m > 0 && $n > 0} {
                            set photos [events:get work:area:photos]
                            set nphotos [llength $photos]
                            set offset [events:get work:area:thumbnail:offset]
                            if {$offset + $m * $n < $nphotos } {
                                set state normal
                            }
                        }
                    }
                    photo {
                        set state disabled
                    }
                }

                canvas:button:state $button $state
            }

            button:context:up {
                switch [work:area:mode:get] {
                    thumbnails {
                        set state disabled

                        set properties [events:get work:area:grid:properties]
                        lassign $properties m w wp n h hp
                        if {$m > 0 && $n > 0} {
                            set offset [events:get work:area:thumbnail:offset]
                            if {$offset > 0} {
                                set state normal
                            }
                        }
                    }
                    photo {
                        set state disabled
                    }
                }

                canvas:button:state $button $state
            }

            button:photo:zoom:mode {
                if {[work:area:mode:get] == "photo"} {
                    canvas:button:toggle:check $button zoom [work:area:get:photo:mode]
                } else {
                    canvas:button:state $button disabled
                }
            }

            button:photo:outline:mode {
                if {[work:area:mode:get] == "photo"} {
                    canvas:button:toggle:check $button outline [work:area:get:photo:mode]
                } else {
                    canvas:button:state $button disabled
                }
            }

            button:photo:eraser:mode {
                if {[work:area:mode:get] == "photo"} {
                    canvas:button:toggle:check $button eraser [work:area:get:photo:mode]
                } else {
                    canvas:button:state $button disabled
                }
            }

            button:photo:outline:extract {
                if {[work:area:mode:get] == "photo"} {
                    canvas:button:state $button normal
                } else {
                    canvas:button:state $button disabled
                }
            }

            button:photo:tags {
                if {[work:area:mode:get] == "photo"} {
                    canvas:button:toggle:check $button tags [work:area:get:photo:mode]
                } else {
                    canvas:button:state $button disabled
                }
            }

            button:collection:search {
                canvas:button:state $button "normal"
            }

            button:group:registration {
                if {[work:area:mode:get] == "photo"} {
                    canvas:button:state $button disabled
                } else {
                    canvas:button:state $button normal
                }
            }

        }
    }
}


# Work area.

proc ::ibisa::work:area:build {} {
    variable canvas
    set r [$canvas create rectangle 0 0 0 0 -fill "" -outline ""]
    $canvas add:children work:area $r

    events:set work:area:cell:width 64
    events:set work:area:min:pad 5
    events:set work:area:photos {}
    events:set work:area:thumbnail:offset 0
    events:set work:area:hilight:thumbnail:index 0

    event work:area:photo:history:reset

    photo:tools:build
    photo:tools:hide
}

proc ::ibisa::work:area:mode:get {} {
    return [events:get work:area:mode]
}

proc ::ibisa::work:area:mode:set {mode {force ""}} {
    variable canvas

    if {$force == ""} {
        set old [work:area:mode:get]
        if {$old == $mode} return
    }

    events:set work:area:mode $mode
    switch $mode {
        thumbnails {
            $canvas away work:area:photo
            $canvas anchor work:area:thumbnails -in work:area -from nw -to nw
            work:area:map:thumbnails
        }
        photo {
            $canvas away work:area:thumbnails
            set margin [options:get work:area:photo:margin]
            $canvas anchor work:area:photo -in work:area -from nw -to nw -x $margin -y $margin
            $canvas lower work:area:photo
            $canvas lower [$canvas find withtag work:area]
        }
    }

    event toolbar:buttons:check:status
}

proc ::ibisa::work:area:collect:all:photos {} {
    set collection [getv collection:name]
    status:bar:message "Collecting photos..."

    set photos [collection:get:all:photos]
    work:area:set:photos $photos
    events:set photo:search:pattern "all"

    set nphotos [llength $photos]
    status:bar:message "Collection \"$collection\" contains $nphotos photos."
}

proc ::ibisa::work:area:set:photos {photos} {
    work:area:clear:photos

    set nphotos [llength $photos]
    set sleep [expr 0.5 / $nphotos]
    set properties [events:get work:area:grid:properties]
    lassign $properties m w wp n h hp

    # A short "animation" for the first page only.
    for {set i 0} {$i < $nphotos} {incr i} {
        if {$i >= $m * $n} break
        set photo [lindex $photos $i]
        work:area:new:photo $photo
        if {$i < $nphotos - 1} {
            ::chrono::sleep $sleep
        }
    }

    events:set work:area:photos $photos
    work:area:hilight:thumbnail 0
    event toolbar:buttons:check:status
}

proc ::ibisa::work:area:size:set:callback {tag w_ h_ w h} {
    #::chrono::trigger

    variable canvas
    set bbox [$canvas coords:bbox work:area]
    set width [events:get work:area:cell:width]
    set min:pad [events:get work:area:min:pad]
    set old:properties [events:get work:area:grid:properties]
    set properties [$canvas grid:properties $bbox $width ${min:pad}]
    events:set work:area:grid:properties $properties

    if {${old:properties} == ""} {
        # First time we get here.  Create a Tk photo for the photo
        # reference (background).
        image create photo ::image::work:area:photo:reference
        $canvas create image 0 0 -tags work:area:photo -image ::image::work:area:photo:reference -anchor nw

        # Create a Tk photo for the current photo.
        image create photo ::image::work:area:photo
        $canvas create image 0 0 -tags work:area:photo -image ::image::work:area:photo -anchor nw

        # Create area for photo thumbnails.
        $canvas create rectangle 0 0 0 0 -fill "" -outline "" -tags work:area:thumbnails

        set old:properties [list 0 0 0 0 0 0]

        # Photos in database will be collected later.
        event 500 work:area:collect:all:photos
        work:area:configure:photo
    }

    # Change current photo view.
    set margin [options:get work:area:photo:margin]
    work:area:photo:view:set:size [expr $w - 2 * $margin] [expr $h - 2 * $margin]

    # Proceed with work area properties.
    lassign ${old:properties} _m _w _wp _n _h _hp
    lassign $properties m w wp n h hp
    set old [expr $_m * $_n]
    set new [expr $m * $n]

    set bg [options:get background]
    set outline [::color::darker $bg 0.1]

    $canvas size:set work:area:thumbnails $w $h

    # Delete old outlines and thumbnails eventually.
    for {set k $new} {$k < $old} {incr k} {
        $canvas delete outline:$k
        $canvas delete thumbnail:$k
    }

    # Create new outlines and thumbnails eventually.
    set ids {}
    for {set k $old} {$k < $new} {incr k} {
        set tkImg ::image::thumbnail:$k
        if {[lsearch [image names] $tkImg] == -1} {
            image create photo $tkImg
        }

        lappend ids [$canvas create image 1 1 -tags thumbnail:$k -image $tkImg]
        lappend ids [$canvas create rectangle 1 1 $w $h -outline $outline -dash . -tags outline:$k]
    }

    if {$ids != {}} {
        eval $canvas add:children work:area:thumbnails $ids
        work:area:map:thumbnails $old
    }

    # Place all outlines and thumbnails relatively to the thumbnail rectangle.
    for {set j 0} {$j < $n} {incr j} {
        for {set i 0} {$i < $m} {incr i} {
            set x [expr ($w + $wp) * $i + $wp + $w * 0.5]
            set y [expr ($h + $hp) * $j + $hp + $h * 0.5]
            set k [expr $j * $m + $i]
            $canvas anchor outline:$k \
                -in work:area:thumbnails \
                -to nw -x $x -y $y
            $canvas anchor thumbnail:$k \
                -in work:area:thumbnails \
                -to nw -x $x -y $y
        }
    }

    # Hilight current thumbnail.
    if {[$canvas find withtag hilight] == ""} {
        set color [::color::closer $bg red 0.5]
        set hilight [$canvas create rectangle 1 1 [expr $w + 2] [expr $h + 2] \
                         -outline $color -dash . \
                         -tags thumbnail:hilight -width 2]

        #$canvas lower $hilight work:area:thumbnails
        $canvas add:children work:area:thumbnails $hilight
    }

    set index [events:get work:area:hilight:thumbnail:index]
    work:area:hilight:thumbnail $index

    event toolbar:buttons:check:status
    #puts "work:area:size:set:callback: $w_ $h_ -> $w $h, [::chrono::trigger]s"
}

proc ::ibisa::work:area:place:callback {event} {
    variable canvas
    switch $event {
        start {
            $canvas away work:area
            $canvas away work:area:thumbnails
            $canvas away work:area:photo
        }
        end {
            work:area:mode:set [work:area:mode:get] -force
        }
    }
}

proc ::ibisa::work:area:new:photo {file} {
    set properties [events:get work:area:grid:properties]
    lassign $properties m w wp n h hp

    if {[work:area:mode:get] != "thumbnails"} {
        # Save the thumbnail anyway.
        # w h dx dy angle scale opacity
        set view [list $w $h 0 0 0 1 1]
        set tag thumbnail:tmp
        set save:thumbnail 1
        photo:put:view $file $view ::image::$tag ${save:thumbnail}
        work:area:append:photo $file
        return
    }

    set photos [events:get work:area:photos]
    set offset [events:get work:area:thumbnail:offset]
    set k [expr [llength $photos] - $offset]
    set j [expr $k / $m]

    if {$j >= $n} {
        # Change page.
        incr offset [expr $m * $n]
        events:set work:area:thumbnail:offset $offset
        work:area:map:thumbnails
        return
    }

    work:area:configure:thumbnail $k $file
    work:area:append:photo $file
}

proc ::ibisa::work:area:append:photo {file} {
    set photos [events:get work:area:photos]
    lappend photos $file
    events:set work:area:photos $photos
}

proc ::ibisa::work:area:clear:photos {} {
    variable canvas
    set properties [events:get work:area:grid:properties]
    lassign $properties m w wp n h hp

    for {set j 0} {$j < $n} {incr j} {
        for {set i 0} {$i < $m} {incr i} {
            set k [expr $j * $m + $i]
            $canvas itemconfigure thumbnail:$k -state hidden
            $canvas itemconfigure outline:$k -state normal
        }
    }

    events:set work:area:photos {}
    events:set work:area:thumbnail:offset 0
    events:set work:area:hilight:thumbnail:index 0

    work:area:photo:history:reset
    work:area:map:thumbnails
    toolbar:buttons:check:status
}

proc ::ibisa::work:area:unregister:photo {index} {
    set photos [events:get work:area:photos]
    set file [lindex $photos $index]
    if {$file == ""} return
    set photos [lreplace $photos $index $index]
    events:set work:area:photos $photos
    work:area:map:thumbnails
    event collection:unregister $file
}

proc ::ibisa::thumbnail:info {tag} {
    variable imgDB
    set file [events:get $tag:file]
    return [collection:get:photo:info $file]
}

proc ::ibisa::thumbnail:index {tag} {
    scan $tag "thumbnail:%d" index
    return $index
}

proc ::ibisa::thumbnail:mouse:event {event tag args} {
    switch $event {
        enter {
            set dict [thumbnail:info $tag]
            if [dict exists $dict file] {
                set file [dict get $dict file]
                set w [dict get $dict width]
                set h [dict get $dict height]
                set message "[file tail $file] \[$w x $h\]"
                event status:bar:message $message
            }
        }
        press {
            set index [thumbnail:index $tag]
            set old [events:get work:area:hilight:thumbnail:index]
            if {$index != $old} {
                work:area:hilight:thumbnail $index
            } else {
                work:area:view:photo $index
            }
        }
    }
}

proc ::ibisa::work:area:view:photo {index} {
    set tag thumbnail:$index
    set dict [thumbnail:info $tag]
    if ![dict exists $dict file] return
    set file [dict get $dict file]

    set tail [file tail $file]
    set ok [operation:start "Loading photo \"$tail\"..."]
    if !$ok {
        set message "operation in progress... "
        append message "loading \"$tail\" cancelled."
        operation:message $message
        update
        ::chrono::sleep 2
        return
    }
    operation:message "please wait..."
    update

    work:area:photo:history:push $file

    operation:message "done."
    operation:end
}

proc ::ibisa::work:area:hilight:thumbnail {index} {
    set properties [events:get work:area:grid:properties]
    lassign $properties m w wp n h hp
    set size [expr $m * $n]
    if {$size <= 0} return

    set offset [events:get work:area:thumbnail:offset]
    set photos [events:get work:area:photos]
    set nphotos [llength $photos]
    set remap 0

    while {$index < 0 && $offset >= $size} {
        incr index $size
        incr offset -$size
        set remap 1
    }

    while {$index >= $size && $offset + $size < $nphotos} {
        incr index -$size
        incr offset $size
        set remap 1
    }

    if {$nphotos > 0 && $offset + $index >= $nphotos} {
        set index [expr $nphotos - $offset - 1]
    }

    if {$index < 0 || $nphotos == 0} {
        set index 0
    }

    if {$index >= $size} {
        set index [expr $size - 1]
    }

    if $remap {
        events:set work:area:thumbnail:offset $offset
        work:area:map:thumbnails
        event toolbar:buttons:check:status
    }

    set j [expr $index / $m]
    set i [expr $index - ($j * $m)]
    set x [expr ($w + $wp) * $i + $wp + $w * 0.5]
    set y [expr ($h + $hp) * $j + $hp + $h * 0.5]

    variable canvas
    $canvas anchor thumbnail:hilight -in work:area:thumbnails -to nw -x $x -y $y
    events:set work:area:hilight:thumbnail:index $index

    if {$nphotos == 0} return

    set tag thumbnail:$index
    set dict [thumbnail:info $tag]
    if [dict exists $dict file] {
        set file [dict get $dict file]
        work:area:current:thumbnail:set $file
        work:area:photo:history:reset
        set w [dict get $dict width]
        set h [dict get $dict height]
        set message "[file tail $file] \[$w x $h\]"
        status:bar:message $message
        event toolbar:buttons:check:status
    }
}

proc ::ibisa::work:area:current:photo:get {} {
    return [work:area:photo:history:top]
}

proc ::ibisa::work:area:current:thumbnail:get {} {
    return [events:get work:area:current:thumbnail]
}

proc ::ibisa::work:area:current:thumbnail:set {file} {
    events:set work:area:current:thumbnail $file
}

proc ::ibisa::work:area:current:photo:load:data {file} {
    set old [events:get work:area:current:photo:data]

    set view:stacks [events:get work:area:view:stacks]
    if {${view:stacks} == ""} { set view:stacks [dict create] }

    set outlines [events:get photo:outlines]
    if {${outlines} == ""} { set outlines [dict create] }

    # The following get/release order is important for reference
    # counting.

    if {$file != ""} {
        ::image::cache:get $file
    }

    if {$old != ""} {
        dict set view:stacks $old [work:area:photo:view:stack:get]
        dict set outlines $old [photo:outline:get:lines]
        ::image::cache:release $old
    }

    if {$file != $old} {
        events:set work:area:current:photo:data $file

        # View stack.
        if [dict exists ${view:stacks} $file] {
            # Note: view stack deactivated.
            work:area:photo:view:stack:set [dict get ${view:stacks} $file]
            work:area:photo:view:redraw
        } else {
            work:area:current:photo:view:reset
        }

        # Outlines.
        photo:outline:delete:lines
        if [dict exists ${outlines} $file] {
            photo:outline:set:lines [dict get ${outlines} $file]
        }

        # Tags
        if {[work:area:get:photo:mode] == "tags"} {
            photo:tags:load:tags
        }
    }

    events:set work:area:view:stacks ${view:stacks}
    events:set photo:outlines ${outlines}
}

proc ::ibisa::work:area:photo:reference:get {file:var view:var} {
    set file ""
    set view ""
    set reference [events:get work:area:photo:reference]
    if {$reference != ""} { lassign $reference file view }
    upvar ${file:var} file_
    upvar ${view:var} view_
    set file_ $file
    set view_ $view
}

proc ::ibisa::work:area:photo:reference:set {{file ""} {view ""}} {
    if {$file == ""} {
        set file [work:area:current:photo:get]
    }

    if {$view == ""} {
        if {[work:area:mode:get] == "thumbnails"} {
            lassign [work:area:photo:view:get:size] w h
            # w h dx dy angle scale opacity
            set view [list $w $h 0 0 0 1 1]
        } else {
            set view [work:area:photo:view:stack:top]
        }
    }

    if {$file == "" || $view == ""} return

    work:area:photo:reference:get _file _view
    if {$file == $_file && $view == $_view} return

    if {$file != ""} {
        ::image::cache:get $file
    }

    if {$_file != ""} {
        ::image::cache:release $_file
    }

    set reference [list $file $view]
    events:set work:area:photo:reference $reference

    set save:view 0
    photo:put:view $file $view ::image::work:area:photo:reference ${save:view}
    event toolbar:buttons:check:status
}

proc ::ibisa::work:area:photo:reference:clear {} {
    ::image::work:area:photo:reference blank

    work:area:photo:reference:get file view
    if {$file != ""} {
        ::image::cache:release $file
    }

    events:unset work:area:photo:reference
    event toolbar:buttons:check:status
}

proc ::ibisa::work:area:home {} {
    work:area:photo:history:home
}

proc ::ibisa::work:area:photo:history:get {index:var list:var} {
    set photo:history [events:get work:area:photo:history]
    if {${photo:history} == ""} { set photo:history [list -1 {}] }
    lassign ${photo:history} index list
    upvar ${index:var} index_
    upvar ${list:var} list_
    set index_ $index
    set list_ $list
}

proc ::ibisa::work:area:photo:history:set {index list} {
    set problem [catch {

        if {$index >= 0} {
            set file [lindex $list $index]
            # If there is a problem, it's here: file doesn't exist
            # (anymore?).
            work:area:current:photo:load:data $file
            work:area:mode:set photo
        } else {
            work:area:mode:set thumbnails
        }

        events:set work:area:photo:history [list $index $list]

    } result]

    if $problem { event 100 status:bar:message $result }
}

proc ::ibisa::work:area:photo:history:reset {} {
    work:area:photo:history:set -1 {}
}

proc ::ibisa::work:area:photo:history:home {} {
    work:area:photo:history:get index history
    work:area:photo:history:set -1 $history
}

proc ::ibisa::work:area:photo:history:push {file} {
    if {$file == ""} return
    work:area:photo:history:get index history
    set history [lrange $history 0 $index]
    lappend history $file
    incr index
    work:area:photo:history:set $index $history
}

proc ::ibisa::work:area:photo:history:top {} {
    work:area:photo:history:get index history
    if {$index < 0} { return [work:area:current:thumbnail:get] }
    return [lindex $history $index]
}

proc ::ibisa::work:area:photo:history:back {} {
    work:area:photo:history:get index history
    if {$index < 0} return
    incr index -1
    work:area:photo:history:set $index $history
}

proc ::ibisa::work:area:photo:history:forward {} {
    work:area:photo:history:get index history
    if {$index >= [llength $history] - 1} return
    incr index
    work:area:photo:history:set $index $history
}

proc ::ibisa::work:area:photo:view:stack:get {} {
    set stack [events:get work:area:photo:view:stack]
    return $stack
}

proc ::ibisa::work:area:photo:view:stack:set {stack} {
    events:set work:area:photo:view:stack $stack
}

proc ::ibisa::work:area:photo:view:stack:push {view} {
    set stack [work:area:photo:view:stack:get]
    lappend stack $view
    work:area:photo:view:stack:set $stack
}

proc ::ibisa::work:area:photo:view:stack:pop {} {
    set stack [work:area:photo:view:stack:get]
    set view [lindex $stack end]
    set stack [lrange $stack 0 end-1]
    work:area:photo:view:stack:set $stack
    return $view
}

proc ::ibisa::work:area:photo:view:stack:top {} {
    set stack [work:area:photo:view:stack:get]
    if {$stack == {}} {
        lassign [work:area:photo:view:get:size] w h
        # w h dx dy angle scale opacity
        return [list $w $h 0 0 0 1 1]
    }
    return [lindex $stack end]
}

proc ::ibisa::work:area:current:photo:view:set {view} {
    work:area:photo:view:stack:push $view
    work:area:photo:view:redraw
}

proc ::ibisa::work:area:current:photo:view:reset {} {
    set view [work:area:photo:view:stack:top]
    lset view 2 0
    lset view 3 0
    lset view 4 0
    lset view 5 1
    lset view 6 1
    work:area:photo:view:stack:set {}
    work:area:current:photo:view:set $view
}

proc ::ibisa::work:area:photo:view:get:size {} {
    return [events:get work:area:photo:view:size]
}

proc ::ibisa::work:area:photo:view:set:size {w h} {
    set view:stacks [events:get work:area:view:stacks]
    if {${view:stacks} == ""} { set view:stacks [dict create] }
    foreach file [dict keys ${view:stacks}] {
        set new:stack {}
        foreach view [dict get ${view:stacks} $file] {
            lset view 0 $w
            lset view 1 $h
            lappend new:stack $view
        }
        dict set view:stacks $file ${new:stack}
    }
    events:set work:area:view:stacks ${view:stacks}

    events:set work:area:photo:view:size [list $w $h]
    set stack [work:area:photo:view:stack:get]
    set new:stack {}
    foreach view $stack {
        lset view 0 $w
        lset view 1 $h
        lappend new:stack $view
    }
    work:area:photo:view:stack:set ${new:stack}
    work:area:photo:view:redraw
}

proc ::ibisa::work:area:photo:view:back {} {
    set view [work:area:photo:view:stack:pop]
    set view_ [work:area:photo:view:stack:pop]
    if {$view_ != ""} {
        work:area:current:photo:view:set $view_
    } else {
        # Empty stack.  Back in history and thumbnails eventually.
        work:area:current:photo:view:reset
        work:area:photo:history:back
    }
}

proc ::ibisa::work:area:photo:view:redraw {} {
    set file [work:area:photo:history:top]
    if {$file == ""} return

    set view [work:area:photo:view:stack:top]

    # Keep old and new views for each file.
    set photo:last:views [events:get photo:last:views]
    if {${photo:last:views} == ""} {
        set photo:last:views [dict create]
    }

    if [dict exists ${photo:last:views} $file] {
        set old [lindex [dict get ${photo:last:views} $file] 1]
    } else {
        set old $view
    }

    dict set photo:last:views $file [list $old $view]
    events:set photo:last:views ${photo:last:views}

    # Old and new views are used to adjust outlines.
    photo:outline:adjust:lines $old $view

    set save:view 0
    photo:put:view $file $view ::image::work:area:photo ${save:view}
}

proc ::ibisa::work:area:map:thumbnails {{k0 0}} {
    variable canvas
    set properties [events:get work:area:grid:properties]
    if {$properties == {}} return
    lassign $properties m w wp n h hp
    set nthumbnails [expr $m * $n]
    set photos [events:get work:area:photos]
    set nphotos [llength $photos]
    set offset [events:get work:area:thumbnail:offset]
    incr offset $k0

    for {set k $k0} {$k < $nthumbnails} {incr k} {
        if {$offset >= $nphotos} {
            $canvas itemconfigure thumbnail:$k -state hidden
            $canvas itemconfigure outline:$k -state normal
            continue
        }

        set file [lindex $photos $offset]
        work:area:configure:thumbnail $k $file
        incr offset
    }

    set index [events:get work:area:hilight:thumbnail:index]
    work:area:hilight:thumbnail $index
}

proc ::ibisa::work:area:configure:thumbnail {k file} {
    variable canvas
    set properties [events:get work:area:grid:properties]
    lassign $properties m w wp n h hp
    set tag thumbnail:$k
    # w h dx dy angle scale opacity
    set view [list $w $h 0 0 0 1 1]
    set tkImg ::image::$tag
    set save:thumbnails 1
    photo:put:view $file $view $tkImg ${save:thumbnails}
    $canvas itemconfigure $tag -state normal
    $canvas itemconfigure outline:$k -state hidden
    $canvas addtag help:tag:thumbnails withtag $tag
    canvas:callback:set mouse:events thumbnail:mouse:event $tag
    events:set $tag:file $file
}

proc ::ibisa::work:area:configure:photo {} {
    variable canvas
    $canvas addtag help:tag:work:area:photo withtag work:area:photo
    canvas:callback:set mouse:events photo:mouse:event work:area:photo
    canvas:callback:set key:events photo:key:event work:area:photo
}


# Work area navigation.

proc ::ibisa::work:area:keypress {key} {
    # Key events independent of the mouse position.
    set mode [work:area:mode:get]
    work:area:keypress:$mode $key
}

proc ::ibisa::work:area:keypress:thumbnails {key} {
    if {[work:area:mode:get] != "thumbnails"} return

    set index [events:get work:area:hilight:thumbnail:index]
    set properties [events:get work:area:grid:properties]
    lassign $properties m w wp n h hp
    if {$m * $n <= 0} return

    # TODO: delete thumbnail (and photo).  Don't delete the 'visited'
    # tag in the database for the photo, so that it won't be possible
    # to add it again (unless the visited flags are cleared).

    switch $key {
        Right {
            if [canvas:check:modifier Alt] {
                work:area:photo:history:forward
            } else {
                work:area:hilight:thumbnail [expr $index + 1]
            }
        }
        Left { work:area:hilight:thumbnail [expr $index - 1] }
        Up { work:area:hilight:thumbnail [expr $index - $m] }
        Down { work:area:hilight:thumbnail [expr $index + $m] }
        End { work:area:hilight:thumbnail [expr $m * ($index / $m) + $m - 1] }
        Home { work:area:hilight:thumbnail [expr $m * ($index / $m)] }
        Prior { work:area:hilight:thumbnail [expr $index - $m * $n] }
        Next { work:area:hilight:thumbnail [expr $index + $m * $n] }
        KP_Enter -
        Return { work:area:view:photo $index }
        Delete { work:area:unregister:photo $index }
    }
}

proc ::ibisa::work:area:keypress:photo {key} {
    switch $key {
        Home { if [canvas:check:modifier Alt] work:area:home }
        Left { if [canvas:check:modifier Alt] work:area:photo:history:back }
        Right { if [canvas:check:modifier Alt] work:area:photo:history:forward }
    }
}

proc ::ibisa::context:down {} {
    switch [work:area:mode:get] {
        thumbnails {
            set properties [events:get work:area:grid:properties]
            lassign $properties m w wp n h hp
            set offset [events:get work:area:thumbnail:offset]
            incr offset [expr $m * $n]
            set photos [events:get work:area:photos]
            set nphotos [llength $photos]
            if {$offset >= $nphotos} return
            events:set work:area:thumbnail:offset $offset
            work:area:map:thumbnails
            event toolbar:buttons:check:status
        }
    }
}

proc ::ibisa::context:up {} {
    switch [work:area:mode:get] {
        thumbnails {
            set properties [events:get work:area:grid:properties]
            lassign $properties m w wp n h hp
            set offset [events:get work:area:thumbnail:offset]
            incr offset [expr - ($m * $n)]
            if {$offset < 0} { set offset 0 }
            events:set work:area:thumbnail:offset $offset
            work:area:map:thumbnails
            event toolbar:buttons:check:status
        }
    }
}


# Work area photo mode.

proc ::ibisa::work:area:set:photo:mode {mode} {
    # Triggers the work:area:photo:mode:trace procedure below.
    options:set work:area:photo:mode $mode
}

proc ::ibisa::work:area:photo:mode:trace {args} {
    set mode [options:get work:area:photo:mode]

    set _mode [events:get work:area:photo:mode:old]
    events:set work:area:photo:mode:old $mode

    if {$mode != $_mode} {
        if {$_mode != ""} photo:$_mode:leave
        photo:$mode:enter
        status:bar:message "[string toupper $mode 0 0] mode."
    }

    event toolbar:buttons:check:status
}

proc ::ibisa::work:area:toggle:photo:mode {mode0 mode1} {
    set mode [options:get work:area:photo:mode]
    if {$mode != $mode0} {
        work:area:set:photo:mode $mode0
        return $mode0
    } else {
        work:area:set:photo:mode $mode1
        return $mode1
    }
}

proc ::ibisa::work:area:get:photo:mode {} {
    return [options:get work:area:photo:mode]
}

proc ::ibisa::photo:zoom:mode {} {
    work:area:set:photo:mode zoom
}

proc ::ibisa::photo:outline:mode {} {
    work:area:set:photo:mode outline
}

proc ::ibisa::photo:eraser:mode {} {
    work:area:set:photo:mode eraser
}

proc ::ibisa::photo:tag:mode {} {
    work:area:set:photo:mode tags
}

proc ::ibisa::photo:mouse:event {event tag args} {
    set mode [work:area:get:photo:mode]
    eval photo:$mode:mouse:event $event $tag $args
}

proc ::ibisa::photo:key:event {event tag K A x y} {
    set mode [work:area:get:photo:mode]
    set stop [photo:$mode:key:event $event $tag $K $A $x $y]
    if {$stop != ""} return

    if {$event == "press"} {
        switch $K {
            z {
                work:area:set:photo:mode zoom
                help:frame:update:help:tag zoom:mode
            }
            e {
                set mode [work:area:toggle:photo:mode eraser outline]
                after 10 "::ibisa::help:frame:update:help:tag $mode:mode"
            }
            s {
                work:area:set:photo:mode outline
                help:frame:update:help:tag outline:mode
            }
            t {
                work:area:set:photo:mode tags
                help:frame:update:help:tag tag:mode
            }
            X {
                photo:outline:extract
            }
        }
    }

    photo:tools:key:event $event $tag $K $A $x $y
}


# Work area photo zoom mode.

proc ::ibisa::photo:zoom:enter {} {
}

proc ::ibisa::photo:zoom:leave {} {
}

proc ::ibisa::photo:zoom:key:event {event tag K A x y} {
    if {$event == "press"} {
        switch $K {
            default {}
        }
    }
}

proc ::ibisa::photo:zoom:mouse:event {event tag args} {
    variable canvas
    switch $event {
        press {
            events:set photo:mouse:pressed $args
            $canvas delete photo:zoom
            $canvas delete photo:zoom:center
        }
        motion {
            set pressed [events:get photo:mouse:pressed]
            if {$pressed != ""} {
                # Start or continue with region selection.
                lassign $pressed _ x1 y1
                lassign $args _ _ x2 y2
                photo:zoom:selection $x1 $y1 $x2 $y2
            }
        }
        release {
            set pressed [events:get photo:mouse:pressed]
            if {$pressed != ""} {
                events:unset photo:mouse:pressed
                lassign $args _ x y

                $canvas delete photo:zoom
                $canvas delete photo:zoom:center

                # Trigger zoom.
                lassign $pressed _ _x _y
                photo:zoom $_x $_y $x $y
            }
        }
        wheel {
            # TODO: implement other ways to translate, rotate and
            # scale the photo.
        }
    }
}

proc ::ibisa::photo:zoom:selection {x1 y1 x2 y2} {
    variable canvas
    if ![$canvas exists photo:zoom] {
        $canvas create rectangle $x1 $y1 $x2 $y2 -tags {photo:zoom no:top} -outline red -width 2 -dash .
        $canvas create rectangle $x2 $y2 $x2 $y2 -tags {photo:zoom:center no:top} -outline red
        $canvas raise photo:zoom work:area:photo
        $canvas raise photo:zoom:center work:area:photo
    } else {
        $canvas coords photo:zoom $x1 $y1 $x2 $y2
        set cx [expr ($x1 + $x2) * 0.5]
        set cy [expr ($y1 + $y2) * 0.5]
        $canvas coords photo:zoom:center $cx $cy $cx $cy
    }
}

proc ::ibisa::photo:zoom {x1 y1 x2 y2} {
    lassign [work:area:get:photo:coords $x1 $y1] x1 y1
    lassign [work:area:get:photo:coords $x2 $y2] x2 y2
    set x [expr ($x1 + $x2) * 0.5]
    set y [expr ($y1 + $y2) * 0.5]

    set view [work:area:photo:view:stack:top]
    lassign $view w h dx dy angle zoom opacity
    set photo [work:area:current:photo:get]
    lassign [::image::get:src:center:offset $photo $view $x $y] dx dy
    lset view 2 [expr -$dx]
    lset view 3 [expr -$dy]

    if {abs($x2 - $x1) >= 5 && abs($y2 - $y1) >= 5} {
        # Zoom in.
        set r1 [expr double($w) / abs(double($x2) - $x1)]
        set r2 [expr double($h) / abs(double($y2) - $y1)]
        set r [expr min($r1, $r2)]
        lset view 5 [expr $r * $zoom]
        work:area:current:photo:view:set $view
    } else {
        # Backwards in view stack.
        work:area:photo:view:back
    }
}

proc ::ibisa::work:area:get:photo:coords {x y} {
    variable canvas
    lassign [$canvas coords work:area:photo] _x _y
    set x_ [expr $x - $_x]
    set y_ [expr $y - $_y]
    return [list $x_ $y_]
}


# Work area photo outline mode.

proc ::ibisa::photo:outline:enter {} {
}

proc ::ibisa::photo:outline:leave {} {
}

proc ::ibisa::photo:outline:key:event {event tag K A x y} {
    if {$event == "press"} {
        switch $K {
            Delete { photo:outline:delete:lines }
        }
    }
}

proc ::ibisa::photo:outline:mouse:event {event tag args} {
    switch $event {
        press {
            lassign $args _ x y
            events:set photo:mouse:pressed $args
            photo:outline:mouse:press $x $y
        }
        motion {
            lassign $args _ _ x y
            if {[events:get photo:mouse:pressed] != ""} {
                photo:outline:mouse:drag $x $y
            }
        }
        release {
            if {[events:get photo:mouse:pressed] != ""} {
                lassign $args _ x y
                events:unset photo:mouse:pressed
                photo:outline:mouse:release $x $y
            }
        }
        wheel {
            # TODO: implement other ways to translate, rotate and
            # scale the photo.
        }
    }
}

proc ::ibisa::photo:outline:mouse:press {x y} {
    variable canvas

    # Check the ends of previous lines.
    set point [photo:outline:find:closest:end $x $y]
    if {$point != ""} {
        lassign $point id index
        set line [$canvas coords $id]
        if {$index == 0} {
            # Reverse the points.
            set line [lreverse $line]
            foreach {y_ x_} $line {
                lappend line_ $x_ $y_
            }
            set line $line_
        }

        # Continue line.
        lappend line $x $y
        $canvas coords $id $line
        events:set photo:outline:id $id
        events:set photo:outline $line
        return
    }

    # Start new line.
    set id [photo:outline:create:line $x $y $x $y]
    events:set photo:outline:id $id
    events:set photo:outline [list $x $y]
}

proc ::ibisa::photo:outline:mouse:drag {x y} {
    variable canvas

    # Continue line.
    set line [events:get photo:outline]

    if [canvas:check:modifier Control] {
        if {[llength $line] <= 2} {
            lappend line $x $y
        } else {
            lset line end-1 $x
            lset line end $y
        }
    } else {
        lappend line $x $y
    }

    events:set photo:outline $line
    set id [events:get photo:outline:id]
    $canvas coords $id $line
}

proc ::ibisa::photo:outline:mouse:release {x y} {
    variable canvas

    set line [events:get photo:outline]
    events:unset photo:outline
    set id [events:get photo:outline:id]
    events:unset photo:outline:id

    if {[llength $line] <= 2} {
        # Likely a click without a drag.  Pop the view stack.
        $canvas delete $id
        work:area:photo:view:back
        return
    }

    lassign $line x0 y0
    if {abs($x - $x0) < 20 && abs($y - $y0) < 20} {
        # Close the region.
        if [canvas:check:modifier Control] {
            if {[llength $line] <= 2} {
                lappend line $x0 $y0
            } else {
                lset line end-1 $x0
                lset line end $y0
            }
        } else {
            lappend line $x0 $y0
        }

        $canvas coords $id $line
        event toolbar:buttons:check:status
        return
    }

    # Check the ends of other lines.
    $canvas dtag $id photo:outlines
    set point [photo:outline:find:closest:end $x $y]
    $canvas addtags $id photo:outlines

    if {$point != ""} {
        # Merge lines.
        lassign $point id2 index
        set line2 [$canvas coords $id2]

        if {$index != 0} {
            # At the end of other line.  Reverse its points.
            set line2 [lreverse $line2]
            foreach {y_ x_} $line2 {
                lappend line_ $x_ $y_
            }
            set line2 $line_
        }

        if [canvas:check:modifier Control] {
            set line [lrange $line 0 end-2]
        }

        eval lappend line $line2
        $canvas delete $id2
        $canvas coords $id $line
    }

    toolbar:buttons:check:status
}

proc ::ibisa::photo:outline:get:lines {} {
    variable canvas
    set file [work:area:current:photo:get]
    set view [work:area:photo:view:stack:top]
    set lines {}

    foreach id [$canvas find withtag photo:outlines] {
        set line [$canvas relative:coords $id work:area:photo]
        set line [::image::coords:dst:to:src $file $view $line]
        lappend lines $line
    }

    return $lines
}

proc ::ibisa::photo:outline:set:lines {lines} {
    variable canvas
    set file [work:area:current:photo:get]
    set view [work:area:photo:view:stack:top]
    photo:outline:delete:lines

    foreach line $lines {
        set line [::image::coords:src:to:dst $file $view $line]
        set line [$canvas relative:coords work:area:photo $line]
        eval photo:outline:create:line $line
    }

    event 0 toolbar:buttons:check:status
}

proc ::ibisa::photo:outline:adjust:lines {view0 view1} {
    if {$view0 == $view1} return
    variable canvas
    set file [work:area:current:photo:get]

    # FIXME: because of conversions between line coordinates (from
    # original photo to canvas and back), doing what it seems to be
    # the same extraction twice would result in two very slightly
    # different regions (apparently the same, but not the same
    # signatures).  It would be better if there were a single
    # reference system.  In the original photo the coordinates are
    # floating point numbers, when they are integers (clicked pixels)
    # in a given view (which is itself made of floating point numbers,
    # but still).  The latter could prove to be better.

    foreach id [$canvas find withtag photo:outlines] {
        set line [$canvas relative:coords $id work:area:photo]
        set line [::image::coords:dst:to:src $file $view0 $line]
        set line [::image::coords:src:to:dst $file $view1 $line]
        set line [$canvas relative:coords work:area:photo $line]
        $canvas coords $id $line
    }
}

proc ::ibisa::photo:outline:delete:lines {} {
    [getv canvas] delete photo:outlines
}

proc ::ibisa::photo:outline:create:line {args} {
    variable canvas
    set id [$canvas create line $args -fill red -width 2]
    $canvas addtags $id photo:outlines no:top
    $canvas raise $id work:area:photo
    $canvas add:children work:area:photo $id
    return $id
}

proc ::ibisa::photo:outline:is:closed {line} {
    if {[llength $line] <= 2} { return 0 }
    set x0 [lindex $line 0]
    set y0 [lindex $line 1]
    set x1 [lindex $line end-1]
    set y1 [lindex $line end]
    if {$x0 != $x1 || $y0 != $y1} { return 0 }
    return 1
}

proc ::ibisa::photo:outline:find:closest:end {x y {min 20}} {
    variable canvas

    set min2 [expr double($min) * $min]

    set min_ [expr $min * 0.5]
    set neigbors \
        [$canvas find overlapping \
             [expr $x - $min_] [expr $y - $min_] \
             [expr $x + $min_] [expr $y + $min_]]

    set ids [$canvas find withtag photo:outlines]

    set _id -1
    set _index -1
    set _x 0
    set _y 0

    foreach id $ids {
        if {[lsearch -exact $neigbors $id] == -1} continue
        set coords [$canvas coords $id]
        if [photo:outline:is:closed $coords] continue
        set ncoords [llength $coords]
        set indices [list 0 [expr $ncoords - 2]]

        foreach i1 $indices {
            set x1 [lindex $coords $i1]
            set y1 [lindex $coords [expr $i1 + 1]]

            set dx [expr abs($x - $x1)]
            set dy [expr abs($y - $y1)]
            set distance2 [expr $dx * $dx + $dy * $dy]

            if {$distance2 < $min2} {
                set min2 $distance2
                set _id $id
                set _index $i1
                set _x $x1
                set _y $y1
            }
        }
    }

    if {$_id == -1} { return "" }
    return [list $_id $_index]
}

proc ::ibisa::photo:outline:find:points {x y {min 20}} {
    # NOTE: currently not used.

    variable canvas

    set min2 [expr double($min) * $min]

    set min_ [expr $min * 0.5]
    set neigbors \
        [$canvas find overlapping \
             [expr $x - $min_] [expr $y - $min_] \
             [expr $x + $min_] [expr $y + $min_]]

    set ids [$canvas find withtag photo:outlines]
    set points {}

    # FIXME: this algorithm is not efficient.  A better solution would
    # be to store the points in a special data structure (kd-tree?).

    foreach id $ids {
        if {[lsearch -exact $neigbors $id] == -1} continue
        set coords [$canvas coords $id]
        set ncoords [llength $coords]

        for {set i1 0} {$i1 < $ncoords} {incr i1 2} {
            set x1 [lindex $coords $i1]
            set y1 [lindex $coords [expr $i1 + 1]]

            # IDEA: distance could be from (x, y) to the [i1, i1+1]
            # line outline.

            set dx [expr abs($x - $x1)]
            set dy [expr abs($y - $y1)]
            set distance2 [expr $dx * $dx + $dy * $dy]

            if {$distance2 < $min2} {
                lappend points [list $id $i1]
            }
        }
    }

    return $points
}

proc ::ibisa::photo:outline:get:closed:lines {} {
    set lines {}
    foreach line [photo:outline:get:lines] {
        if [photo:outline:is:closed $line] {
            lappend lines $line
        }
    }
    return $lines
}

proc ::ibisa::photo:outline:set:closed:lines {lines} {
    foreach line [photo:outline:get:lines] {
        if ![photo:outline:is:closed $line] {
            lappend lines $line
        }
    }
    photo:outline:set:lines $lines
}

proc ::ibisa::photo:outline:extract {} {
    set file [work:area:current:photo:get]
    if {$file == ""} return

    # FIXME: because of conversions between line coordinates (from
    # original photo to canvas and back), doing what it seems to be
    # the same extraction twice would result in two very slightly
    # different regions (apparently the same, but not the same
    # signature).  It would be better if there were a single reference
    # system (say, original photo, of course).

    set lines [photo:outline:get:closed:lines]
    if {$lines == {}} {
        append message "There is no closed region"
        append message " in current photo!"
        status:bar:message $message
        return
    }

    set view [work:area:photo:view:stack:top]
    lassign $view w h dx dy angle scale opacity

    event work:area:photo:history:push \
        [collection:import:region $file $lines $angle]
}


# Work area photo eraser mode.

proc ::ibisa::photo:eraser:enter {} {
    variable canvas
    lassign [events:get last:x:y] x y
    set w [options:get photo:outline:eraser:width]
    set id [$canvas create oval 1 1 $w $w -outline red -fill red]
    $canvas raise $id work:area:photo
    $canvas addtags $id photo:outline:eraser no:top
    $canvas add:children work:area:photo $id
    $canvas anchor photo:outline:eraser -to nw -x $x -y $y
}

proc ::ibisa::photo:eraser:leave {} {
    [getv canvas] delete photo:outline:eraser
}

proc ::ibisa::photo:eraser:key:event {event tag K A x y} {
    if {$event == "press"} {
        switch $K {
            Delete { photo:outline:delete:lines }
        }
    }
}

proc ::ibisa::photo:eraser:mouse:event {event tag args} {
    switch $event {
        press {
            lassign $args _ x y
            events:set photo:mouse:pressed $args
            photo:eraser:check $x $y
        }
        motion {
            lassign $args _ _ x y
            photo:eraser:check $x $y
        }
        leave {
            [getv canvas] away photo:outline:eraser
        }
        release {
            lassign $args _ x y
            photo:eraser:check $x $y
            events:unset photo:mouse:pressed
        }
    }
}

proc ::ibisa::photo:eraser:check {x y} {
    variable canvas
    $canvas anchor photo:outline:eraser -to nw -x $x -y $y
    if {[events:get photo:mouse:pressed] == ""} return

    set w_ [expr [options:get photo:outline:eraser:width] * 0.5]

    foreach fragment [photo:outline:break:lines $x $y $w_] {
        lassign $fragment id lines
        $canvas delete $id
        foreach line $lines {
            eval photo:outline:create:line $line
        }
    }
}

proc ::ibisa::photo:outline:break:lines {x y {min 20}} {
    variable canvas

    set min2 [expr double($min) * $min]

    set min_ [expr $min * 0.5]
    set neigbors \
        [$canvas find overlapping \
             [expr $x - $min_] [expr $y - $min_] \
             [expr $x + $min_] [expr $y + $min_]]

    set ids [$canvas find withtag photo:outlines]
    set fragments {}

    # FIXME: this algorithm is not very efficient.

    foreach id $ids {
        if {[lsearch -exact $neigbors $id] == -1} {
            continue
        }

        set coords [$canvas coords $id]
        set ncoords [llength $coords]
        set line {}
        set broken 0
        set lines {}

        for {set i1 0} {$i1 < $ncoords} {incr i1 2} {
            set x1 [lindex $coords $i1]
            set y1 [lindex $coords [expr $i1 + 1]]
            set dx [expr abs($x - $x1)]
            set dy [expr abs($y - $y1)]
            set distance2 [expr $dx * $dx + $dy * $dy]

            if {$distance2 < $min2} {
                set broken 1
                if {[llength $line] > 2} {
                    lappend lines $line
                }
                set line {}
            } else {
                lappend line $x1 $y1
            }
        }

        if $broken {
            if {[llength $line] > 2} {
                lappend lines $line
            }

            lappend fragments [list $id $lines]
        }
    }

    return $fragments
}

# Work area photo tag mode.

proc ::ibisa::photo:tags:enter {} {
    photo:tags:load:tags
}

proc ::ibisa::photo:tags:leave {} {
    [getv canvas] delete photo:tags
}

proc ::ibisa::photo:tags:key:event {event tag K A x y} {
    set focus [photo:tags:get:focus]
    if {$focus != ""} {
        photo:tag:focus:key:event $event $focus $K $A $x $y
        return 0
    }

    if {$event == "press"} {
        switch $K {
            Delete { photo:tags:delete:tags }
        }
    }
}

proc ::ibisa::photo:tags:mouse:check:grab {event tag _args} {
    foreach type {photo:tags photo:tag} {
        set grab [events:get $type:mouse:grab]
        if {$grab == $tag} { return 0 }
        if {$grab == ""} continue
        eval $type:mouse:event $event $grab $_args
        return 1
    }
    return 0
}

proc ::ibisa::photo:tags:mouse:event {event tag args} {
    if [photo:tags:mouse:check:grab $event $tag $args] return
    set proc photo:tags:mouse:$event
    if {[info procs $proc] == ""} return
    eval $proc $tag $args
}

proc ::ibisa::photo:tags:mouse:press {tag b x y} {
    events:set photo:tags:mouse:grab $tag
    events:set photo:mouse:pressed [list $b $x $y]
    photo:tags:set:focus ""
}

proc ::ibisa::photo:tags:mouse:motion {tag _x _y x y} {
    set pressed [events:get photo:mouse:pressed]
    if {$pressed == ""} return
    lassign $pressed _ x_ y_

    variable canvas
    set frame [$canvas find withtag photo:tags:new:tag:frame]

    if {$frame == ""} {
        set frame [photo:tags:new:tag:frame $x_ $y_ $x $y]
    } else {
        $canvas coords $frame $x_ $y_ $x $y
    }
}

proc ::ibisa::photo:tags:mouse:release {tag b x y} {
    set pressed [events:get photo:mouse:pressed]
    events:unset photo:mouse:pressed
    events:unset photo:tags:mouse:grab

    variable canvas
    set frame [$canvas find withtag photo:tags:new:tag:frame]
    if {$frame == ""} {
        work:area:photo:history:back
        return
    }

    set coords [$canvas coords $frame]
    $canvas delete $frame
    lassign $pressed _ x_ y_
    set tag [photo:tags:new:tag $x_ $y_]
    photo:tags:set:focus $tag
}

proc ::ibisa::photo:tag:key:event {event tag K A x y} {
    variable canvas

    set focus [photo:tags:get:focus]
    if {$focus != ""} {
        photo:tag:focus:key:event $event $focus $K $A $x $y
        return
    }

    if {$event == "press"} {
        switch $K {
            Delete {
                photo:tags:delete:tag $tag
            }
            default {
                # Forward event to photo level.
                photo:key:event $event work:area:photo $K $A $x $y
            }
        }

        return
    }

    # Forward event to photo level.
    photo:key:event $event $tag $K $A $x $y
}

proc ::ibisa::photo:tag:focus:key:event {event tag K A x y} {
    variable canvas

    if {$event == "press"} {
        switch $K {
            Escape { photo:tags:set:focus "" }
            Delete { photo:tags:delete:char $tag }
            BackSpace { photo:tags:delete:char $tag -1 }
            Left { photo:tags:move:icursor $tag -1 }
            Right { photo:tags:move:icursor $tag 1 }
            Return -
            Enter { photo:tags:insert:char "\n" $tag }

            default {
                set is:char [expr {$A != "" && [string is print $A]}]
                if !${is:char} return
                photo:tags:insert:char $A $tag
            }
        }
    }
}

proc ::ibisa::photo:tag:mouse:event {event tag args} {
    if [photo:tags:mouse:check:grab $event $tag $args] return
    set proc photo:tag:mouse:$event
    if {[info procs $proc] == ""} return
    eval $proc $tag $args
}

proc ::ibisa::photo:tag:mouse:press {tag b x y} {
    events:set photo:tag:mouse:grab $tag
    events:set photo:mouse:pressed [list $b $x $y]
    variable canvas
    $canvas raise $tag photo:tags
    if {[photo:tags:get:focus] != $tag} {
        photo:tags:set:focus ""
    }
}

proc ::ibisa::photo:tag:mouse:motion {tag _x _y x y} {
    set pressed [events:get photo:mouse:pressed]
    if {$pressed == ""} return
    [getv canvas] move $tag [expr $x - $_x] [expr $y - $_y]
}

proc ::ibisa::photo:tag:mouse:release {tag b x y} {
    variable canvas

    set pressed [events:get photo:mouse:pressed]
    events:unset photo:mouse:pressed
    events:unset photo:tag:mouse:grab

    if {$pressed == ""} return
    lassign $pressed _ _x _y

    if {$x != $_x || $y != $_y} {
        if [canvas:check:modifier Shift] {
            # Fit to the grid.
            lassign [$canvas coords $tag:frame] x y
            $canvas move $tag [expr -(int($x) % 20)] [expr -(int($y) % 20)]
        }
        photo:tags:update:tag $tag
        return
    }

    photo:tags:set:focus $tag
    set index [$canvas index $tag:text @$x,$y]
    $canvas icursor $tag:text $index
    events:set photo:tags:icursor:index $index
}

proc ::ibisa::photo:tags:get:focus {} {
    return [events:get photo:tags:focus]
}

proc ::ibisa::photo:tags:set:focus {tag} {
    set old [photo:tags:get:focus]
    if {$old == $tag} return
    events:set photo:tags:focus $tag

    if {$old != ""} { photo:tags:update:tag $old }

    variable canvas
    set id $tag:text
    set text [$canvas itemcget $id -text]

    $canvas focus $tag
    events:set photo:tags:focus $tag
    set index [string length $text]
    $canvas icursor $id $index
    events:set photo:tags:icursor:index $index
}

proc ::ibisa::photo:tags:new:tag:frame {x1 y1 x2 y2} {
    variable canvas
    set bg [options:get background]
    set frame [$canvas create rectangle $x1 $y1 $x2 $y2]
    $canvas itemconfigure $frame -tags photo:tags:new:tag:frame
    $canvas itemconfigure $frame -fill white
    $canvas itemconfigure $frame -outline [::color::darker $bg 0.15]
    $canvas add:children work:area:photo $frame
    return $frame
}

proc ::ibisa::photo:tags:new:tag:item {tag:number text parameters} {
    variable canvas

    # FIXME: parameters are dependant on the current implementation.
    # There should be a way to abstract them a little bit so to resist
    # a change of implementation.

    if {$parameters == ""} {
        set bbox [$canvas coords:bbox:all photo:tags]
        if {$bbox == ""} {
            lassign [$canvas coords work:area:photo] x y
            set bbox [list [expr $x + 10] $y [expr $x + 10] $y]
        }

        set bbox [$canvas relative:coords $bbox work:area:photo]
        lassign $bbox x1 y1 x2 y2
        set parameters [list $x1 [expr $y2 + 10]]
    }

    lassign [$canvas relative:coords work:area:photo $parameters] x y

    set frame [photo:tags:new:tag:frame $x $y $x $y]
    $canvas itemconfigure $frame -tags photo:tags

    set id [$canvas create text [expr $x + 6] [expr $y + 5] -anchor nw]
    $canvas itemconfigure $id -font ::font::12
    $canvas itemconfigure $id -text "$text"
    $canvas add:children work:area:photo $id

    photo:tags:adjust:frame $frame $id
    photo:tags:bind ${tag:number} $id $frame
    return $id
}

proc ::ibisa::photo:tags:adjust:frame {frame id} {
    variable canvas
    lassign [$canvas coords $frame] x1 y1 x2 y2
    set bbox [$canvas bbox $id]
    set x1 [expr [lindex $bbox 0] - 5]
    set y1 [expr [lindex $bbox 1] - 5]
    set x2 [expr [lindex $bbox 2] + 5]
    set y2 [expr [lindex $bbox 3] + 5]
    $canvas coords $frame $x1 $y1 $x2 $y2
}

proc ::ibisa::photo:tags:bind {tag:number id frame} {
    variable canvas
    set tkTag photo:tag:${tag:number}
    $canvas itemconfigure $id -tags [list photo:tags $tkTag $tkTag:text]
    $canvas itemconfigure $frame -tags [list photo:tags $tkTag $tkTag:frame]
    canvas:callback:set mouse:events photo:tag:mouse:event $tkTag
    canvas:callback:set key:events photo:tag:key:event $tkTag
    $canvas raise $tkTag photo:tags
}

proc ::ibisa::photo:tags:new:tag {x y} {
    variable canvas

    # FIXME: should tag coordinates be relative to the cartesian
    # system of the photo?

    set file [work:area:current:photo:get]
    if {$file == ""} return

    set text ""
    set parameters [$canvas relative:coords [list $x $y] work:area:photo]
    # Temporary number
    set tag:number -1

    photo:tags:new:tag:item ${tag:number} $text $parameters

    set tkTag photo:tag:${tag:number}
    return $tkTag
}

proc ::ibisa::photo:tags:load:tags {} {
    variable canvas
    $canvas delete photo:tags

    set file [work:area:current:photo:get]
    if {$file == ""} return

    set tags [collection:get:tags $file]
    foreach tag $tags {
        lassign $tag tag:number text parameters
        photo:tags:new:tag:item ${tag:number} $text $parameters
    }
}

proc ::ibisa::photo:tags:delete:tag {tkTag} {
    scan $tkTag "photo:tag:%d" number
    collection:delete:tag $number
    [getv canvas] delete photo:tag:$number
}

proc ::ibisa::photo:tags:delete:tags {} {
    set file [work:area:current:photo:get]
    if {$file == ""} return

    variable canvas
    if {[$canvas find withtag photo:tags] == ""} return

    set title "Clear Tags!"
    set message "Are you sure you want to clear all the tags of this photo?"
    set confirm [$canvas confirm $title $message]
    if {$confirm != "ok"} return

    collection:clear:tags $file
    $canvas delete photo:tags
}

proc ::ibisa::photo:tags:update:tag {tag} {
    set file [work:area:current:photo:get]
    if {$file == ""} return

    variable canvas
    set text [$canvas itemcget $tag:text -text]
    set coords [$canvas coords $tag:frame]
    set parameters [$canvas relative:coords $coords work:area:photo]
    scan $tag "photo:tag:%d" number

    if {$text == "" && [photo:tags:get:focus] != $tag} {
        collection:delete:tag $number
        $canvas delete $tag
        return
    }

    if {$number == -1} {
        set number [collection:new:tag $file $text $parameters]
        set tkTag photo:tag:$number
        set id [$canvas find withtag $tag:text]
        set frame [$canvas find withtag $tag:frame]
        photo:tags:bind $number $id $frame
    } else {
        collection:set:tag $number $text $parameters
    }
}

proc ::ibisa::photo:tags:insert:char {char tag} {
    variable canvas
    set index [events:get photo:tags:icursor:index]
    $canvas insert $tag:text $index $char
    incr index
    events:set photo:tags:icursor:index $index
    photo:tags:adjust:frame $tag:frame $tag:text
}

proc ::ibisa::photo:tags:delete:char {tag {offset 0}} {
    variable canvas
    set index [events:get photo:tags:icursor:index]
    incr index $offset
    if {$index < 0} return
    $canvas dchars $tag:text $index
    events:set photo:tags:icursor:index $index
    photo:tags:adjust:frame $tag:frame $tag:text
}

proc ::ibisa::photo:tags:move:icursor {tag offset} {
    variable canvas
    set text [$canvas itemcget $tag:text -text]
    set index [events:get photo:tags:icursor:index]
    incr index $offset
    if {$index < 0} return
    if {$index > [string length $text]} return
    $canvas icursor $tag:text $index
    events:set photo:tags:icursor:index $index
}


# Work area photo search.

proc ::ibisa::work:area:photo:search:ask:for:pattern {} {
    if {[events:get photo:search:status] == "shown"} return
    photo:search:show
    vwait ::ibisa::events(photo:search:answer)
    if {[events:get photo:search:answer] == "cancel"} return
    set entry [getv canvas].search:entry
    set pattern [$entry get]
    #photo:search:delete
    return $pattern
}

proc ::ibisa::photo:search:show {} {
    variable canvas
    if {[$canvas find withtag photo:search] == ""} {
        photo:search:build
    }

    set status [events:get photo:search:status]
    if {$status == "shown"} return
    events:set photo:search:status "shown"

    $canvas anchor photo:search -in work:area
    $canvas raise photo:search
    set entry $canvas.search:entry
    $entry select range 0 end
    focus $entry
}

proc ::ibisa::photo:search:hide {} {
    set status [events:get photo:search:status]
    if {$status == "hidden"} return
    events:set photo:search:status "hidden"
    variable canvas
    $canvas lower photo:search
    $canvas away photo:search
    focus $canvas
}

proc ::ibisa::photo:search:build {} {
    variable canvas
    set bg [options:get background]
    set fill1 [::color::darker $bg 0.1]
    set fill2 [::color::brighter $bg 0.5]
    set outline [::color::darker $bg 0.5]

    set entry $canvas.search:entry
    entry $entry -background $fill2 \
        -relief flat -borderwidth 1 \
        -highlightcolor $outline \
        -font ::font::12

    bind $entry <FocusOut> { ::ibisa::photo:search:cancel }
    bind $entry <Escape> { ::ibisa::photo:search:cancel }
    bind $entry <Return> { ::ibisa::photo:search:validate }
    bind $entry <KP_Enter> { ::ibisa::photo:search:validate }

    set items [subst {
        frame {round:rectangle 1 1 200 40 -fill $fill1 -outline $outline}
        entry {window 11 11 -window $entry -anchor nw -height 20 -width 180}
    }]

    foreach {kind item} $items {
        set tag photo:search:$kind
        set help:tag help:tag:collection:search
        lappend item -tags [list photo:search $tag ${help:tag}]
        eval $canvas create $item
    }

    $canvas lower photo:search
    canvas:bind:windows
}

proc ::ibisa::photo:search:delete {} {
    photo:search:hide
    variable canvas
    $canvas delete photo:search
    destroy $canvas.search:entry
}

proc ::ibisa::photo:search:validate {} {
    photo:search:hide
    events:set photo:search:answer "ok"
}

proc ::ibisa::photo:search:cancel {} {
    photo:search:hide
    events:set photo:search:answer "cancel"
}

# Work area photo tools.

proc ::ibisa::photo:tools:view:trace {args} {
    variable canvas
    if {[$canvas find withtag photo:tools] == ""} {
        photo:tools:build
        photo:tools:hide
    }

    if [options:get photo:tools:view] {
        photo:tools:show
    } else {
        photo:tools:hide
    }
}

proc ::ibisa::photo:tools:check {x y} {
    # DEPRECATED
    variable canvas

    if {[events:get photo:tools:grab] != ""} return

    if {[$canvas find withtag photo:tools] == ""} {
        photo:tools:build
        photo:tools:hide
    }

    #set bbox [$canvas coords:bbox photo:tools]
    #lassign $bbox x1 y1 x2 y2
    #set w [expr abs($x2 - $x1)]
    #set h [expr abs($y2 - $y1)]
    set w 32
    set h 32

    lassign [$canvas coords work:area] x1_ y1_ x2_ y2_

    if {($x > $x2_ - $w) && ($x < $x2_) &&
        ($y > $y1_) && ($y < $y1_ + $h)} {
        photo:tools:show
    } else {
        photo:tools:hide
    }
}

proc ::ibisa::photo:tools:show {} {
    set status [events:get photo:tools:status]
    if {$status == "shown"} return
    events:set photo:tools:status "shown"
    variable canvas

    lassign [work:area:photo:view:get:size] w h
    $canvas anchor photo:tools -in work:area:photo -from ne -to nw -x $w
    $canvas raise photo:tools work:area:photo
    $canvas add:children work:area:photo photo:tools

    # Push a copy of the current view on top of the view stack.
    set view [work:area:photo:view:stack:top]
    work:area:photo:view:stack:push $view
}

proc ::ibisa::photo:tools:hide {} {
    set status [events:get photo:tools:status]
    if {$status == "hidden"} return
    events:set photo:tools:status "hidden"
    variable canvas
    $canvas remove:children work:area:photo photo:tools
    $canvas away photo:tools
    $canvas lower photo:tools work:area:photo
    # Check the views on top of the view stack.
    set view [work:area:photo:view:stack:pop]
    set view_ [work:area:photo:view:stack:pop]
    if {$view_ != "" && $view_ != $view} {
        work:area:photo:view:stack:push $view_
    }
    if {$view != ""} {
        work:area:photo:view:stack:push $view
    }

    # NOTE: uncomment for debugging only.
    #$canvas delete photo:tools
}

proc ::ibisa::photo:tools:build {} {
    variable canvas
    set fill [options:get background]
    set outline [::color::darker $fill 0.5]

    # WARNING: coordinates have been crafted so a knob is right at the
    # center of its operation rectangle.  If they were not the
    # operation may behave strangely.
    set items [subst {
        frame {rectangle -19 1 100 238 -fill "" -outline ""}

        translate {rectangle 0 20 80 100 -fill $fill -outline $outline}
        translate {line 0 60 80 60 -fill $outline -dash .}
        translate {line 40 20 40 100 -fill $outline -dash .}
        translate:knob {oval 35 55 45 65 -fill turquoise -outline $outline}

        rotate {rectangle 0 120 80 124 -fill $fill -outline $outline}
        rotate:knob {oval 35 117 45 127 -fill red -outline $outline}

        scale {rectangle 0 144 80 148 -fill $fill -outline $outline}
        scale:knob {oval 35 141 45 151 -fill salmon -outline $outline}

        opacity {rectangle 0 168 80 172 -fill $fill -outline $outline}
        opacity:knob {oval 35 165 45 175 -fill aquamarine4 -outline $outline}

        home {round:rectangle 25 192 55 218 -fill $fill -outline $outline}
    }]

    set no:mouse:bind {frame home}

    foreach {kind item} $items {
        set tag photo:tools:$kind
        lassign [photo:tools:parse $tag] operation knob
        set help:tag help:tag:$operation
        lappend item -tags [list photo:tools $tag ${help:tag}]
        eval $canvas create $item
        if {[lsearch ${no:mouse:bind} $kind] == -1} {
            canvas:callback:set mouse:events photo:tools:mouse:event $tag
        }
        canvas:callback:set key:events photo:tools:key:event $tag
    }

    set button [canvas:button:build button:photo:tools:home photo:tools:home home photo:tools:home]
    $canvas anchor $button -in photo:tools:home
    $canvas add:children photo:tools $button
    $canvas lower photo:tools
}

proc ::ibisa::photo:tools:home {} {
    work:area:current:photo:view:reset
}

proc ::ibisa::photo:tools:parse {tag} {
    set operation $tag
    regexp "(.*):knob" $tag _ operation
    set knob ${operation}:knob
    return [list $operation $knob]
}

proc ::ibisa::photo:tools:mouse:event {event tag args} {
    lassign [photo:tools:parse $tag] operation knob
    variable canvas

    switch $event {
        enter {
            $canvas create line 0 -10 0 10 -fill red -tags pt:center
            $canvas create line -10 0 10 0 -fill red -tags pt:center
            $canvas create oval -10 -10 10 10 -outline red -fill "" -tags pt:center
            $canvas anchor pt:center -in work:area
        }
        leave {
            $canvas delete pt:center
        }

        press {
            if {$operation == "photo:tools:frame"} return
            if {$operation == "photo:tools:home"} return

            set start [events:get photo:tools:grab]
            if {$start != ""} return

            lassign $args _ x y
            set knob:coords [$canvas coords $knob]
            set start [list $operation ${knob:coords}]
            events:set photo:tools:grab $start

            lassign [::icanvas::anchor:to:coords center ${knob:coords}] cx cy
            set dx [expr $x - $cx]
            set dy [expr $y - $cy]
            if {$operation != "photo:tools:translate"} {set dy 0}
            $canvas move $knob $dx $dy

            photo:tools:operation start
        }
        motion {
            set start [events:get photo:tools:grab]
            if {$start == ""} return

            lassign $args x_ y_ x y
            lassign $start operation _
            set bounds [$canvas coords $operation]
            lassign $bounds x1 y1 x2 y2
            set knob ${operation}:knob
            set knob:coords [$canvas coords $knob]
            lassign [::icanvas::anchor:to:coords center ${knob:coords}] cx cy

            set _cx $x
            set _cx [expr max($_cx, $x1)]
            set _cx [expr min($_cx, $x2)]
            set dx [expr $_cx - $cx]

            if {$operation == "photo:tools:translate"} {
                set _cy $y
                set _cy [expr max($_cy, $y1)]
                set _cy [expr min($_cy, $y2)]
            } else {
                # Don't move the knob vertically.
                set _cy $cy
            }
            set dy [expr $_cy - $cy]
            $canvas move $knob $dx $dy
        }
        release {
            set start [events:get photo:tools:grab]
            if {$start == ""} return
            lassign $start operation knob:coords
            $canvas coords ${operation}:knob ${knob:coords}
            events:unset photo:tools:grab

            photo:tools:operation stop
        }
    }
}

proc ::ibisa::photo:tools:key:event {event tag K A x y} {
    if {$event == "press" && $K == "Home"} {
        events:unset photo:tools:key:event:future
        events:unset photo:tools:key:event:counts
        photo:tools:home
        return
    }

    if {[lsearch {Right Left Up Down} $K] == -1} {
        return
    }

    set events [events:get photo:tools:key:events]
    lappend events [list $event $tag $K $A $x $y]
    events:set photo:tools:key:events $events
    photo:tools:key:event:cycle start
}

proc ::ibisa::photo:tools:key:event:cycle {event} {
    switch $event {
        start {
            set future [events:get photo:tools:key:event:future]
            if {$future != ""} return
            photo:tools:key:event:cycle continue
        }
        continue {
            if ![photo:tools:key:event:step] {
                events:unset photo:tools:key:event:future
                return
            }

            set future [after 100 "::ibisa::photo:tools:key:event:cycle continue"]
            events:set photo:tools:key:event:future $future
        }
        stop {
            set future [events:get photo:tools:key:event:future]
            if {$future == ""} return
            events:unset photo:tools:key:event:future
            after cancel $future
        }
    }
}

proc ::ibisa::photo:tools:key:event:step {} {
    set events [events:get photo:tools:key:events]
    set counts [events:get photo:tools:key:event:counts]
    if {$counts == ""} { set counts {0 0 0 0}}
    lassign $counts nRight nLeft nUp nDown

    foreach e $events {
        lassign $e event tag K A x y
        if {$event == "press"} {incr n$K 1} else {set n$K 0}
    }

    set modifiers [events:get modifiers]
    if {$modifiers != "" && $modifiers != "Shift"} {
        lassign {0 0 0 0} nRight nLeft nUp nDown
    }

    events:unset photo:tools:key:events

    set counts [list $nRight $nLeft $nUp $nDown]
    events:set photo:tools:key:event:counts $counts
    if {$counts == {0 0 0 0}} {
        events:set photo:tools:factors {0 0 0 0 0}
        photo:tools:operation stop
        return 0
    }

    set factors [events:get photo:tools:factors]
    if {$factors == ""} { set factors [list 0 0 0 0 0] }
    lassign $factors dxf dyf anglef scalef opacityf

    if {$modifiers == ""} {
        set xf [expr ($nRight > 0 ? 1 : 0) + ($nLeft > 0 ? -1 : 0)]
        if {$xf == 0} { set dxf 0 }
        set dxf [expr $dxf + $xf * (0.05 * $dxf + 0.05)]
        set dxf [expr min(1, max(-1, $dxf))]

        set yf [expr ($nUp > 0 ? -1 : 0) + ($nDown > 0 ? 1 : 0)]
        if {$yf == 0} { set dyf 0 }
        set dyf [expr $dyf + $yf * (0.05 * $dyf + 0.05)]
        set dyf [expr min(1, max(-1, $dyf))]

    } elseif {$modifiers == "Shift"} {
        set af [expr ($nRight > 0 ? -1 : 0) + ($nLeft > 0 ? 1 : 0)]
        if {$af == 0} { set anglef 0 }
        set anglef [expr $anglef + $af * (0.1 * abs($anglef) + 0.1)]
        set anglef [expr min(1, max(-1, $anglef))]

        set sf [expr ($nUp > 0 ? 1 : 0) + ($nDown > 0 ? -1 : 0)]
        if {$sf == 0} { set scalef 0 }
        set scalef [expr $scalef + $sf * (0.1 * abs($scalef) + 0.1)]
        set scalef [expr min(1, max(-1, $scalef))]
    }

    set factors [list $dxf $dyf $anglef $scalef $opacityf]
    events:set photo:tools:factors $factors
    photo:tools:operation start
    return 1
}

proc ::ibisa::photo:tools:operation {event} {
    switch $event {
        start {
            set future [events:get photo:tools:future]
            if {$future != ""} return
            update idletasks
            photo:tools:operation continue
        }
        continue {
            set t0 [::chrono::now]
            photo:tools:operation:step
            set t1 [::chrono::now]
            set delay [expr int(1000 * min(0.02, max(0.02, $t1 - $t0)))]
            set future [after $delay "::ibisa::photo:tools:operation continue"]
            events:set photo:tools:future $future
        }
        stop {
            set future [events:get photo:tools:future]
            if {$future == ""} return
            events:unset photo:tools:future
            after cancel $future
        }
    }
}

proc ::ibisa::photo:tools:operation:step {} {
    variable canvas

    lassign {0 0 0 1 1} dx dy angle scale opacity

    set factors [events:get photo:tools:factors]
    if {$factors == ""} { set factors [list 0 0 0 0 0] }
    lassign $factors dxf dyf anglef scalef opacityf

    foreach op {translate rotate scale opacity} {
        set operation "photo:tools:$op"
        set bounds [$canvas coords $operation]
        if {$bounds == ""} continue
        lassign [::icanvas::anchor:to:coords center $bounds] cx cy
        lassign $bounds x1 y1 x2 y2
        set w [expr $x2 - $x1]
        set h [expr $y2 - $y1]

        set knob "$operation:knob"
        set knob:coords [$canvas coords $knob]
        lassign [::icanvas::anchor:to:coords center ${knob:coords}] kcx kcy

        set xratio [expr 2.0 * ($kcx - $cx) / $w]
        set yratio [expr 2.0 * ($kcy - $cy) / $h]

        switch $op {
            translate {
                if {$dxf != 0} { set xratio $dxf }
                if {$dyf != 0} { set yratio $dyf }
                set x [expr -$xratio * $w]
                set y [expr -$yratio * $h]
                # Compute offset based on the current view.
                set file [work:area:current:photo:get]
                set view [work:area:photo:view:stack:top]
                lassign [::image::get:src:center:offset $file $view 0 0] x1 y1
                lassign [::image::get:src:center:offset $file $view $x $y] x2 y2
                set dx [expr $dx + $x2 - $x1]
                set dy [expr $dy + $y2 - $y1]
            }
            rotate {
                if {$anglef != 0} { set xratio $anglef }
                set angle [expr $angle + (acos(-1) * -$xratio * 10) / 180]
            }
            scale {
                if {$scalef != 0} { set xratio $scalef }
                set scale [expr $scale + $xratio * 0.125]
            }
            opacity {
                set opacity [expr $opacity - 1 + $xratio * 0.125]
            }
        }
    }

    if {$dx == 0 && $dy == 0 && $angle == 0 && $scale == 1 && $opacity == 1} {
        # No Transform.
    } else {
        # Change photo view on top of the stack.
        set view [work:area:photo:view:stack:pop]
        lassign $view w h dx_ dy_ angle_ scale_ opacity_
        set dx [expr $dx_ + $dx]
        set dy [expr $dy_ + $dy]
        set angle [expr $angle_ + $angle]
        set scale [expr $scale_ * $scale]
        set opacity [expr $opacity_ + $opacity]
        if {$opacity > 1} { set opacity 1 }
        if {$opacity < 0} { set opacity 0 }
        set view [list $w $h $dx $dy $angle $scale $opacity]
        work:area:current:photo:view:set $view
    }
}


# Help frame.

proc ::ibisa::help:frame:view:trace {args} {
    variable canvas
    if ![options:get help:frame:view] {
        $canvas place:set away help:frame
        $canvas away help:frame
    } else {
        set anchor [options:get help:frame:anchor]
        eval $canvas place:set $anchor
        eval $canvas $anchor

        if ![$canvas is:visible help:frame] {
            $canvas anchor help:frame -from se -to se -x -5 -y -5
            $canvas anchor:adjust help:frame
            options:set help:frame:anchor [$canvas place:get help:frame]
        }
    }
}

proc ::ibisa::help:frame:build {} {
    variable canvas

    set r [$canvas create round:rectangle \
               [options:get help:frame:coords] \
               -fill [options:get help:frame:fill] \
               -outline [options:get help:frame:outline] \
               -width [options:get help:frame:outline:width]]

    set text $canvas.help:text
    text $text -state disabled \
        -background [options:get help:frame:fill] \
        -relief flat \
        -highlightthickness 0

    $text configure -state normal
    $text tag configure gold \
        -font ::font::16 -foreground #a80 \
        -wrap word -justify left \
        -spacing1 0 -spacing2 2 -spacing3 10
    $text tag configure normal \
        -font ::font::12 -foreground black \
        -wrap word -justify left \
        -spacing1 0 -spacing2 2 -spacing3 10
    $text configure -state disabled

    set sb $canvas.help:sb

    ttk::style configure TScrollbar \
        -relief flat -activerelief flat -borderwidth 0 -arrowsize 0 \
        -background [options:get help:frame:outline] \
        -foreground [options:get help:frame:outline] \
        -activebackground [options:get help:frame:outline] \
        -activeforeground [options:get help:frame:outline] \
        -hilightcolor [options:get help:frame:outline] \
        -troughcolor [::color::darker [options:get background] 0.1]

    ttk::scrollbar $sb -style TScrollbar -command "$text yview"
    $text configure -yscrollcommand ::ibisa::help:frame:sb:set

    set w1 [$canvas create window 0 0 -window $text -anchor nw -tags help:text]
    $canvas place:set anchor $w1 -in $r -from nw -to nw -x 10 -y 3 \
        -relwidth 1 -width -20 -relheight 1 -height -5

    set w2 [$canvas create window 0 0 -window $sb -anchor nw -tags help:sb]
    $canvas place:set anchor $w2 -in $r -from ne -to ne -x -6 -y 5 \
        -relheight 1 -height -10 -width 2

    $canvas add:children help:frame $r $w1 $w2
    $canvas addtag help:tag:help:frame withtag help:frame

    canvas:callback:set mouse:events \
        help:frame:mouse:event help:frame
    canvas:bind:windows
}

proc ::ibisa::help:frame:place:callback {event} {
    variable canvas
    switch $event {
        start {
            $canvas away help:frame
        }
        end {
            $canvas raise help:frame
        }
    }
}

proc ::ibisa::help:frame:sb:set {args} {
    variable canvas
    uplevel 0 $canvas.help:sb set $args

    set text $canvas.help:text
    if {![options:get help:frame:view] || [$text yview] == "0.0 1.0"} {
        $canvas itemconfigure help:sb -state hidden
    } else {
        $canvas itemconfigure help:sb -state normal
    }
}

proc ::ibisa::help:frame:update:help {item} {
    variable canvas
    set tag [$canvas scan:tags $item "help:tag:%s"]
    help:frame:update:help:tag $tag
}

proc ::ibisa::help:frame:update:help:tag {tag} {
    variable canvas

    if {$tag == [events:get last:help:tag]} return

    if [events:get help:frame:frozen] return

    if {$tag == ""} return
    events:set last:help:tag $tag
    set action [help:tag:to:action:get $tag]
    if {$action == ""} return

    set text $canvas.help:text
    $text configure -state normal
    $text delete 1.0 end
    # FIXME: security risk.  Risk is low since the source code of the
    # help actions is local.
    eval $action
    $text configure -state disabled
}

proc ::ibisa::help:frame:scroll {args} {
    variable canvas
    if {[$canvas find withtag help:frame] == {}} return
    eval $canvas.help:text yview scroll $args
}

proc ::ibisa::help:frame:frozen:toggle {} {
    events:set help:frame:frozen [expr ![events:get help:frame:frozen]]
}

proc ::ibisa::help:frame:mouse:event {event tag args} {
    eval drag:drop:misc:b1 $event $tag $args
    if {$event == "motion" && [events:get drag:1] == "help:frame"} {
        variable canvas
        $canvas anchor:adjust help:frame
        options:set help:frame:anchor [$canvas place:get help:frame]
    }
}


# Buttons.

proc ::ibisa::canvas:button:build {button:tag help:tag image {cmd ""}} {
    variable canvas
    set tag ${button:tag}
    set imgDir [getv imgDir]
    set ids {}
    set last:ext ""

    foreach {tag_ ext} {
        disabled _disabled
        active _active
        above _above
        normal ""
    } {
        set file [file join $imgDir ${image}${ext}.png]
        if ![file exists $file] {
            #puts "no file: $file"
            set ext ${last:ext}
            set file [file join $imgDir ${image}${last:ext}.png]
        }
        if ![file exists $file] continue
        set last:ext $ext
        set img [::image::load $file]
        set id [$canvas create image 0 0 -image $img]

        $canvas itemconfigure $id -tags $tag:$tag_ -state hidden
        lappend ids $id
    }

    eval $canvas add:children $tag $ids
    $canvas addtag help:tag:${help:tag} withtag $tag
    canvas:button:command $tag $cmd
    canvas:button:state $tag normal
    canvas:callback:set mouse:events canvas:button:mouse:event $tag
    return $tag
}

proc ::ibisa::canvas:button:command {tag {cmd ""}} {
    variable canvas
    if {$cmd == ""} {
        return [events:get $tag:command]
    }

    events:set $tag:command $cmd
}

proc ::ibisa::canvas:button:state {tag {state ""}} {
    variable canvas
    if {$state == ""} {
        return [events:get $tag:state]
    }

    #puts "canvas:button:state $tag $state"
    events:set $tag:state $state
    $canvas itemconfigure $tag -state hidden
    $canvas itemconfigure $tag:$state -state normal
}

proc ::ibisa::canvas:button:mouse:event {event tag args} {
    set state [canvas:button:state $tag]
    if {$state == "disabled"} return

    switch $event {
        enter -
        motion {
            if {$state == "active"} return
            if {$state == "above"} return
            canvas:button:state $tag above
        }
        leave {
            if {$state == "normal"} return
            canvas:button:state $tag normal
            events:set mouse:grab:1 ""
        }
        press {
            if {$state == "active"} return
            canvas:button:state $tag active
        }
        release {
            if {$state != "active"} return
            events:set mouse:grab:1 ""
            canvas:button:state $tag above
            set cmd [canvas:button:command $tag]
            if {$cmd != ""} {
                after cancel [events:get $tag:cmd]
                set id [after 50 ::ibisa::event $cmd]
                events:set $tag:cmd $id
            }
        }
    }
}

proc ::ibisa::canvas:button:toggles:reset {} {
    foreach {key val} [events:get:pairs] {
        if [string match "button:*:toggle" $key] {
            events:unset $key
        }
    }
}

proc ::ibisa::canvas:button:toggle:check {tag mode mode_} {
    set state [events:get $tag:toggle]

    if {$state == ""} {
        canvas:button:toggle $tag inactive
        events:set $tag:toggle inactive
    } elseif {$state == "inactive" && $mode == $mode_} {
        canvas:button:toggle $tag active
        events:set $tag:toggle active
    } elseif {$state == "active" && $mode != $mode_} {
        canvas:button:toggle $tag inactive
        events:set $tag:toggle inactive
    }

    canvas:button:state $tag normal
}

proc ::ibisa::canvas:button:toggle {tag state} {
    variable canvas
    set normal [$canvas find withtag $tag:normal]
    set above [$canvas find withtag $tag:above]
    set hidden [$canvas find withtag $tag:hidden]

    if {$state == "active"} {
        $canvas dtag $normal $tag:normal
        $canvas addtag $tag:hidden withtag $normal
        $canvas addtag $tag:normal withtag $above
    } else {
        $canvas dtag $hidden $tag:hidden
        $canvas addtag $tag:normal withtag $hidden
        $canvas dtag $above $tag:normal
    }
}


# Callbacks.

proc ::ibisa::canvas:callback:set {name cmd tagOrId} {
    variable canvas
    foreach id [$canvas find withtag $tagOrId] {
        events:set "$name:$id" [list $cmd $tagOrId]
    }
}

proc ::ibisa::canvas:callback:get {name id} {
    set result [events:get "$name:$id"]
    if {$result == ""} {
        set result [list noop $id]
    }
    return $result
}

# Callback which does nothing.
proc ::ibisa::noop {args} {
}

# Callback to drag & drop the given tag with mouse button 1.
proc ::ibisa::drag:drop:misc:b1 {event tag args} {
    switch $event {
        press {
            lassign $args b
            if {$b != 1} return
            events:set drag:1 $tag
        }
        motion {
            set drag [events:get drag:1]
            if {$drag != $tag} return
            variable canvas
            lassign $args x_ y_ x y
            $canvas move $tag [expr $x - $x_] [expr $y - $y_]
        }
        release {
            events:unset drag:1
        }
    }
}


# Events.

# Dispatches asynchronous events (using 'after).
proc ::ibisa::event {cmd args} {
    if [string is integer $cmd] {
        set ms $cmd
        set cmd [lindex $args 0]
        set args [lrange $args 1 end]
    } else {
        set ms 0
    }

    if {[info procs $cmd] != {}} {
        after $ms "::ibisa::$cmd $args"
        return
    }

    if {[info procs ::$cmd] != {}} {
        after $ms "::$cmd $args"
        return
    }

    status:bar:message "$cmd: not yet implemented, sorry."
    puts "::ibisa::event $cmd $args"
}

proc ::ibisa::configure:event {widget args} {
    foreach target { toplevel canvas } {
        if {$widget != [getv $target]} continue
        return [eval $target:configure:event $args]
    }
}

proc ::ibisa::canvas:callback:window:mouse:motion {W X Y x y} {
    variable canvas
    canvas:callback:mouse:motion \
        [expr $X - [winfo rootx $canvas]] \
        [expr $Y - [winfo rooty $canvas]]
}

proc ::ibisa::canvas:callback:mouse:motion {x y} {
    variable canvas

    lassign [events:get last:x:y] x_ y_
    set grab:tag ""

    set grab [events:get mouse:grab:1]
    if {$grab != ""} {
        # Give it a chance to move something so that it stays on top.
        lassign $grab button callback grab:tag
        if {$x != $x_ || $y != $y_} {
            $callback motion ${grab:tag} $x_ $y_ $x $y
        }
    }

    # Get top ID.
    set top [$canvas top:id $x $y]
    set cbk [canvas:callback:get mouse:events $top]
    lassign $cbk top:callback_ top:tag

    # Deal with previously registered top callback.  Leave or move.
    # Enter the new top ID eventually.
    foreach {callback tag} [events:get top:callback] {
        if {$tag != ${top:tag}} {
            $callback leave $tag $x_ $y_
            ${top:callback_} enter ${top:tag} $x $y
        } elseif {$tag != ${grab:tag} && ($x != $x_ || $y != $y_)} {
            ${top:callback_} motion ${top:tag} $x_ $y_ $x $y
        }
    }

    events:set top:callback $cbk
    events:set last:x:y [list $x $y]
    help:frame:update:help $top
}

proc ::ibisa::canvas:callback:mouse:press {b x y} {
    if {$b == 4} { canvas:mouse:wheel $b 1 $x $y }
    if {$b == 5} { canvas:mouse:wheel $b -1 $x $y }
    if {$b != 1} return
    set grab [events:get mouse:grab:$b]
    if {$grab != ""} return
    foreach {callback tag} [events:get top:callback] {
        events:set mouse:grab:$b [list $b $callback $tag]
        $callback press $tag $b $x $y
        break
    }
}

proc ::ibisa::canvas:callback:mouse:release {b x y} {
    if {$b != 1} return
    set grab [events:get mouse:grab:$b]
    if {$grab == ""} return
    lassign $grab button callback tag
    if {$b != $button} return
    $callback release $tag $b $x $y
    events:set mouse:grab:$b {}
}

proc ::ibisa::canvas:callback:mouse:wheel {b d x y} {
    foreach {callback tag} [events:get top:callback] {
        $callback wheel $tag $b $d $x $y
    }
}

proc ::ibisa::canvas:callback:key:press {K A x y} {
    set modifiers [events:get modifiers]
    foreach mod {Control Shift Alt} {
        if {[string first $mod $K] != -1 &&
            [lsearch -exact $modifiers $mod] == -1} {
            lappend modifiers $mod
            break
        }
    }
    events:set modifiers $modifiers

    set top [[getv canvas] top:id $x $y]
    set cbk [canvas:callback:get key:events $top]
    lassign $cbk top:callback top:tag
    ${top:callback} press ${top:tag} $K $A $x $y
}

proc ::ibisa::canvas:callback:key:release {K A x y} {
    set modifiers [events:get modifiers]
    set modifiers_ {}
    foreach mod {Control Shift Alt} {
        if {[string first $mod $K] == -1 &&
            [lsearch -exact $modifiers $mod] != -1} {
            lappend modifiers_ $mod
            continue
        }
    }
    events:set modifiers $modifiers_

    set top [[getv canvas] top:id $x $y]
    set cbk [canvas:callback:get key:events $top]
    lassign $cbk top:callback top:tag
    ${top:callback} release ${top:tag} $K $A $x $y
}

proc ::ibisa::canvas:check:modifier {mod} {
    foreach mod_ [events:get modifiers] {
        if {$mod_ == $mod} { return 1 }
    }
    return 0
}

proc ::ibisa::canvas:clear:modifiers {} {
    events:unset modifiers
}


# Operations.

proc ::ibisa::operation:start {operation} {
    set current [operation:get:current]
    if {$current != ""} {
        puts "An operation is already running: ${current}."
        return 0
    }

    events:set operation $operation
    events:set operation:cancel 0
    [events:get iworker] cancel 0
    toolbar:buttons:check:status
    status:bar:message $operation
    return 1
}

proc ::ibisa::operation:get:current {} {
    return [events:get operation]
}

proc ::ibisa::operation:message {message} {
    set operation [events:get operation]
    status:bar:message "$operation $message"
}

proc ::ibisa::operation:end {} {
    events:unset operation
    events:unset operation:cancel
    event 100 toolbar:buttons:check:status
}

proc ::ibisa::operation:cancel {} {
    [events:get iworker] cancel 1
    events:set operation:cancel 1
}

proc ::ibisa::operation:should:return {} {
    update idletasks

    if {[events:get operation:cancel] != 1} {
        return 0
    }

    operation:message "cancelled!"
    return 1
}

# Photo collection.

proc ::ibisa::collection:open {{new 0}} {
    set file ""

    if $new {
        set file [tk_getSaveFile \
                      -title "Enter the name of a new photo collection..." \
                      -initialdir [getv dbDir] \
                      -initialfile "name" \
                      -parent [getv toplevel]]
    } else {
        set file [tk_getOpenFile \
                      -title "Select a photo collection..." \
                      -initialdir [getv dbDir] \
                      -initialfile "" \
                      -parent [getv toplevel]]
    }

    variable canvas
    focus $canvas
    if {$file == ""} return

    if {[file pathtype $file] != "absolute"} {
        set file [file join [getv dbDir] $file]
    }

    if {$file == [getv appDB:file]} {
        set message "You have selected the application database."
        append message "  Operation cancelled."
        tk_messageBox -title "Error" -message $message
        focus $canvas
        return
    }

    if $new {
        set file [file join $file "collection"]

        if [file exists $file] {
            set message "You have selected the name of an existing file or directory."
            append message "  Operation cancelled."
            tk_messageBox -title "Error" -message $message
            focus $canvas
            return
        }
    }

    if {!$new && ![collection:valid $file]} {
        set message "You have selected an invalid file."
        append message "  Operation cancelled."
        tk_messageBox -title "Error" -message $message
        focus $canvas
        return
    }

    set basedir [getv dbDir]
    if {$new || [collection:format $file] == "1.1"} {
        set basedir [file dirname $file]
    }

    exit:database imgDB
    init:dir imgDBDir [file join $basedir "images"]
    setv imgDB:file $file
    init:database imgDB
    work:area:collect:all:photos
}

proc ::ibisa::collection:rename {} {
    set file ""
    set file [tk_getSaveFile \
                  -title "Enter the new collection name..." \
                  -initialdir [getv dbDir] \
                  -initialfile "" \
                  -parent [getv toplevel]]

    variable canvas
    focus $canvas
    if {$file == ""} return

    if {[file pathtype $file] != "absolute"} {
        set file [file join [getv dbDir] $file]
    }

    if [file exists $file] {
        set message "You have selected the name of an existing file or directory."
        append message "  Operation cancelled."
        tk_messageBox -title "Error" -message $message
        focus $canvas
        return
    }

    exit:database imgDB

    set format [getv collection:format]

    if {$format == "1.0"} {
        set old [getv imgDB:file]
        file rename -force -- $old $file

    }

    if {$format == "1.1"} {
        set old [file dirname [getv imgDBDir]]
        file rename -force -- $old $file
        init:dir imgDBDir [file join $file "images"]
        set file [file join $file "collection"]
    }

    setv imgDB:file $file
    init:database imgDB
    work:area:collect:all:photos
}

proc ::ibisa::collection:valid {file} {
    set valid 0

    catch {
        # Just try to access the database.
        set dbtest [::database::new $file]
        ${dbtest}::delete
        set valid 1
    }

    return $valid
}

proc ::ibisa::collection:default:format {} {
    return "1.1"
}

proc ::ibisa::collection:format {{file ""}} {
    set format [collection:default:format]

    if {$file == ""} { set file [getv imgDB:file] }
    if ![file exists $file] { return $format }
    if ![file isfile $file] { return $format }

    catch {
        set dbtest [::database::new $file]

        # Check version.
        set then [lindex [$dbtest map:get ::ibisa::version] 0 1]
        if {$then == "" || [string first "1.0" $then] == 0} {
            set format "1.0"
        }

        ${dbtest}::delete
    }

    return $format
}

proc ::ibisa::collection:name {{file ""}} {
    if {$file == ""} { set file [getv imgDB:file] }
    if {[getv collection:format] == "1.0"} {
        return [file rootname [file tail $file]]
    }
    return [file tail [file dirname $file]]
}

proc ::ibisa::collection:convert:from:1.0 {} {
    # FIXME
}

proc ::ibisa::collection:import {} {
    if ![operation:start "Importing new photos..."] return

    set dir [options:get import:directory]
    if ![file isdirectory $dir] {
        set dir [getv homeDir]
    }

#     set files [tk_getOpenFile \
#                    -parent [getv toplevel] \
#                    -title "Select files..." \
#                    -initialdir $dir \
#                    -multiple 1]
#     puts $files

    # FIXME: this only works for directories.
    # TODO: create a specific "open file" widget.
    set dir [tk_chooseDirectory \
                 -parent [getv toplevel] \
                 -title "Select a folder..." \
                 -initialdir $dir \
                 -mustexist 1]

    variable canvas
    focus $canvas
    if {$dir == ""} {
        operation:cancel
        operation:should:return
        operation:end
        return
    }

    set dir [file normalize $dir]
    options:set import:directory $dir

    # Retrieve the files recursively.
    set iworker [events:get iworker]
    set files [$iworker recursive:glob $dir]

    # Check each file.
    variable imgDB
    set db:photos [$imgDB map:get:count photo * file]
    set old:photos {}
    set new:photos {}
    set old:checksums {}
    set cant:load {}
    set nfiles [llength $files]

    event progress:bar:reset

    for {set i 0} {$i < $nfiles} {incr i} {
        if [operation:should:return] break

        set file [lindex $files $i]

        # GUI misc.
        set message "Importing new photos..."
        set new [llength ${new:photos}]
        if {$new > 0} { append message " found $new." }
        status:bar:message $message
        event progress:bar:update [expr double($i) / $nfiles]
        event progress:bar:text [file tail $file]

        # Check if file is already known by the database.
        if {[$imgDB map:get:count file $file visited] > 0} {
            lappend old:photos $file
            continue
        }

        # Check if file is an image.
        if ![$iworker run ::image::can:load $file] {
            #puts "probably not a photo: $file"
            lappend cant:load $file
            continue
        }

        # Compute checksum and see if file is a known photo.
        set signature [collection:compute:signature $file]
        if {[$imgDB map:get:count photo $signature file] > 0} {
            lappend old:checksums $file
            continue
        }

        if [operation:should:return] break
        collection:import:photo $file $signature
        collection:add:import:tags $file
        lappend new:photos $file
        update idletasks
    }

    # TODO: maybe the operation should just collect the names of
    # potentially new photos, rather than inserting them in the
    # database.  The user could then accept or reject all or some of
    # them.

    set message "Importing new photos... done.  "
    append message "New photos: [llength ${new:photos}]  "
    set total:photos [expr ${db:photos} + [llength ${new:photos}]]
    append message "Total photos: ${total:photos}  "
    #append message "Old photos: [llength ${old:photos}]  "
    #append message "Doubles: [llength ${old:checksums}]  "
    #append message "Skipped files: [llength ${cant:load}]  "
    event status:bar:message $message

    operation:end
}

proc ::ibisa::collection:compute:signature {file} {
    return [[events:get iworker] run ::image::signature $file]
}

proc ::ibisa::collection:import:photo {file signature} {
    variable imgDB
    set iworker [events:get iworker]

    # Initialize new database records.
    set records {}

    # Create new database records.
    lappend records [list [list file $file visited] 1]
    lappend records [list [list file $file signature] $signature]
    lappend records [list [list photo $signature file] $file]
    set properties [$iworker run ::image::properties $file]
    foreach {property value} [dict get $properties] {
        lappend records [list [list photo $signature $property] $value]
    }

    # Add the records to the database.
    $imgDB map:set:many $records

    # Update the GUI.
    work:area:new:photo $file
}

proc ::ibisa::collection:normalize:ascii {string} {
    # Strange things can happen on different systems when a filename
    # contains special characters.  Here we just keep the safe ones.
    set string [encoding convertto ascii $string]
    set ascii ""
    foreach char [split $string ""] {
        if ![string is alnum $char] continue
        append ascii $char
    }
    return $ascii
}

proc ::ibisa::collection:import:region {file polygons angle} {
    variable imgDB

    if ![operation:start "Extracting region..."] return
    if [operation:should:return] {
        operation:end
        return ""
    }

    # Forge the name of the new photo.
    set count -1
    foreach record [$imgDB map:get region:count *] {
        set count [lindex $record 1]
        break
    }
    incr count
    set prefix [file rootname [file tail $file]]
    set prefix [collection:normalize:ascii $prefix]
    set name "region $count - ${prefix}.png"

    operation:message "$name..."
    if [operation:should:return] {
        operation:end
        return ""
    }

    set tmp [file join [getv imgDBDir] $name]

    # Process mask and save to temporary file.
    ::image::save:mask $file $tmp $polygons $angle

    if [operation:should:return] {
        catch { file delete $tmp }
        operation:end
        return ""
    }

    # Compute signature and check existence.
    set signature [collection:compute:signature $tmp]
    foreach record [$imgDB map:get photo $signature] {
        catch { file delete $tmp }
        operation:message "region already exists... operation cancelled!"
        operation:end
        return ""
    }

    # Move temporary file to its final destination
    set dst [file join [photo:directory $signature] $name]
    file rename $tmp $dst

    if [operation:should:return] {
        catch { file delete $dst }
        operation:end
        return ""
    }

    # Import the region as an ordinary photo.
    collection:import:photo $dst $signature

    # Insert database records specific to regions.
    lappend records [list region:count $count]
    lappend records [list [list region $signature file] $dst]
    lappend records [list [list region $signature parent] $file]
    lappend records [list [list region $signature polygons] $polygons]
    $imgDB map:set:many $records

    # Copy tags from parent.
    collection:add:inherited:tags $file $dst

    # Add tags for region (or object) search.
    collection:new:tag $dst "region, object"

    operation:message "$name... done."
    operation:end
    return $dst
}

proc ::ibisa::collection:unregister {file} {
    variable imgDB

    set records [$imgDB map:get photo * file $file]
    if {$records != {}} {
        set signature [lindex $records 0 1]
    } else {
        # Fallback to photo info, but this shall not be necessary.
        set info [collection:get:photo:info $file]
        set signature [dict get $info signature]
    }

    # Remove cached views from disk.
    foreach record [$imgDB map:get view $signature] {
        set dst [lindex $record 3]
        catch { file delete $dst }
    }

    # Remove if region.
    set records [$imgDB map:get region $signature]
    if {[llength $records] > 0} {
        $imgDB map:delete file $file
        catch { file delete $file }
    }

    # NOTE: for an original photo (not an extracted region) the 'file'
    # database entries are not deleted, notably the 'visited' flag, to
    # prevent importing the file again.

    $imgDB map:delete photo $signature
    $imgDB map:delete view $signature
    $imgDB map:delete region $signature
    collection:clear:tags $file
    collection:clear:neighbors $file

    photo:info:unset $file
    set tail [file tail $file]
    status:bar:message "Removed \"$tail\" from collection."
}

proc ::ibisa::collection:clear:visited:flags {} {
    variable imgDB
    $imgDB map:delete file * visited
    status:bar:message "The 'visited' flags were cleared."
}

proc ::ibisa::collection:clear {} {
    variable canvas
    set title "Collection Clear!"
    set message "Are you sure you want to clear this collection?"
    set confirm [$canvas confirm $title $message]
    if {$confirm != "ok"} return

    work:area:mode:set thumbnails
    work:area:current:photo:load:data ""
    work:area:current:thumbnail:set ""
    work:area:clear:photos
    update idletasks

    variable imgDB

    # Remove cached views from disk.
    foreach record [$imgDB map:get view * *] {
        lassign $record _ signature view dst
        catch { file delete $dst }
    }

    # Remove extracted regions from disk.
    foreach record [$imgDB map:get region * file *] {
        set dst [lindex $record 3]
        catch { file delete $dst }
    }

    $imgDB clear
    event 100 status:bar:message "Collection cleared!"
}

proc ::ibisa::collection:get:all:photos {} {
    variable imgDB
    set photos {}
    set records [$imgDB map:get photo * file *]
    foreach record $records {
        set file [lindex $record 3]
        lappend photos $file
    }
    return $photos
}

proc ::ibisa::collection:get:photo:info {file} {
    variable imgDB
    set info [photo:info:get $file]
    if {$info != ""} { return $info }
    set record [$imgDB map:get photo * file $file]
    set signature [lindex $record 0 1]
    set dict [dict create]
    foreach record [$imgDB map:get photo $signature * *] {
        set key [lindex $record 2]
        set val [lindex $record 3]
        dict set dict $key $val
    }
    dict set dict signature $signature
    photo:info:set $file $dict
    return $dict
}

proc ::ibisa::collection:get:tags {file} {
    variable imgDB
    set tags {}
    foreach record [$imgDB map:get tag * file $file] {
        set number [lindex $record 1]
        set text "(bad tag)"
        set parameters "(bad parameters)"

        foreach record_ [$imgDB map:get tag $number text] {
            set text [lindex $record_ 3]
        }

        foreach record_ [$imgDB map:get tag $number parameters] {
            set parameters [lindex $record_ 3]
        }

        lappend tags [list $number $text $parameters]
    }
    return $tags
}

proc ::ibisa::collection:new:tag {file text {parameters {}}} {
    variable imgDB

    set count -1
    foreach record [$imgDB map:get tag:count *] {
        set count [lindex $record 1]
        break
    }
    incr count

    lappend records [list tag:count $count]
    lappend records [list [list tag $count file] $file]
    lappend records [list [list tag $count text] $text]
    lappend records [list [list tag $count parameters] $parameters]
    $imgDB map:set:many $records

    # Return the new tag number.
    return $count
}

proc ::ibisa::collection:set:tag {tag:number text {parameters {}}} {
    lappend records [list [list tag ${tag:number} text] $text]
    lappend records [list [list tag ${tag:number} parameters] $parameters]
    [getv imgDB] map:set:many $records
}

proc ::ibisa::collection:delete:tag {tag:number} {
    [getv imgDB] map:delete tag ${tag:number}
}

proc ::ibisa::collection:clear:tags {file} {
    variable imgDB
    foreach record [$imgDB map:get tag * file $file] {
        set number [lindex $record 1]
        $imgDB map:delete tag $number
    }
    status:bar:message "Tags cleared!"
}

proc ::ibisa::collection:add:import:tags {file} {
    append tag "Name: [file rootname [file tail $file]]"
    append tag "\nDate: (yyyy/mm/dd)"
    append tag "\nLocation: (a place)"
    append tag "\nPhotographer: (a person)"
    collection:new:tag $file $tag
}

proc ::ibisa::collection:add:inherited:tags {parent file} {
    foreach tag [collection:get:tags $parent] {
        lassign $tag number text parameters
        collection:new:tag $file $text $parameters
    }
}

proc ::ibisa::collection:search {} {
    variable imgDB

    set pattern [work:area:photo:search:ask:for:pattern]
    if {$pattern == ""} return

    if [regexp "\\*+" $pattern] {
        set pattern "all"
    }

    if {$pattern == "all"} {
        work:area:collect:all:photos
        return
    }

    set old [events:get photo:search:pattern]
    if {$old == $pattern} return
    events:set photo:search:pattern $pattern

    if ![operation:start "Searching for '$pattern'..."] return

    set words [split $pattern]

    # FIXME: all tags in database are retrieved and processed.  It
    # will be slower and slower as database grows.  Use text
    # indexation techniques.

    # Weigh all matching tags.
    set countToTags [dict create]
    set max 0

    foreach record [$imgDB map:get tag * text *] {
        if [operation:should:return] {
            operation:end
            return
        }

        set number [lindex $record 1]
        set text [lindex $record 3]
        set count 0

        foreach word $words {
            if ![string match -nocase "*$word*" $text] continue
            incr count
        }

        if {$count == 0} continue
        if {$count > $max} { set max $count }
        dict lappend countToTags $count $number
    }

    # Weigh all matching files.
    set fileToCount [dict create]
    for {set i $max} {$i >= 0} {incr i -1} {
        if [operation:should:return] {
            operation:end
            return
        }

        if ![dict exists $countToTags $i] continue

        foreach number [dict get $countToTags $i] {
            set records [$imgDB map:get tag $number file *]
            set file [lindex $records 0 3]
            dict incr fileToCount $file $i
        }

        dict unset countToTags $i
    }
    unset countToTags

    # Revert the dictionary to later get weight-sorted files.
    set countToFiles [dict create]
    set max 0
    dict for {file count} $fileToCount {
        if {$count > $max} { set max $count }
        dict lappend countToFiles $count $file
        dict unset fileToCount $file
    }
    unset fileToCount

    # Get weight-sorted files
    set files {}
    # If min is 0, we have a OR.  If number of words, it is a AND.
    set min [llength $words]
    for {set i $max} {$i >= $min} {incr i -1} {
        if ![dict exists $countToFiles $i] continue
        eval lappend files [dict get $countToFiles $i]
        dict unset countToFiles $i
    }
    unset countToFiles

    # Update thumbnails.
    work:area:set:photos $files
    event toolbar:buttons:check:status
    events:set photo:search:pattern $pattern

    operation:message "done.  Found [llength $files] photos."
    operation:end
}

proc ::ibisa::collection:clear:neighbors {file} {
    variable imgDB
    $imgDB map:delete intercorrelation * * $file * *
    $imgDB map:delete intercorrelation $file * * * *
}

# Photo view.

proc ::ibisa::photo:mipmap:info {size view} {
    lassign $size width height
    lassign $view w h dx dy angle zoom opacity
    set iwidth [expr $zoom * $width]
    set iheight [expr $zoom * $height]
    set ratio [::image::ratio $iwidth $iheight $w $h]
    set level [expr int(ceil(log($ratio) / log(2)))]
    set zoom1 [expr pow(2, $level)]
    set zoom2 [expr $ratio / $zoom1]
    return [list $level $zoom1 $zoom2]
}

proc ::ibisa::photo:put:view {file view tkImg {save 1}} {
    if !$save {
        ::image::put:view $file $view $tkImg
        return ""
    }

    variable imgDB
    set info [collection:get:photo:info $file]
    set signature [dict get $info signature]

    set record [$imgDB map:get view $signature $view *]
    if {$record != {}} {
        set file_ [lindex $record 0 3]
        if [file exists $file_] {
            ::image::load $file_ $tkImg
            return $file_
        }
    }

    set dir [photo:directory $signature]
    set dst [file join $dir "${signature} ${view}.png"]
    set iworker [events:get iworker]
    $iworker run ::image::save:view $file $dst $view
    $imgDB map:set [list view $signature $view] $dst
    ::image::load $dst $tkImg
    return $dst
}

proc ::ibisa::photo:directory {signature} {
    # The photo directory is under the application directory, with a
    # name made of characters from the signature (good distribution).
    variable imgDBDir
    set dir1 [file join $imgDBDir [string range $signature 0 1]]
    set dir2 [file join $dir1 [string range $signature 2 3]]
    if ![file exists $dir2] { file mkdir $dir2 }
    return $dir2
}

proc ::ibisa::photo:save:view {file view} {
    variable imgDB
    set info [collection:get:photo:info $file]
    set signature [dict get $info signature]

    set dir [photo:directory $signature]
    set dst [file join $dir "${signature} ${view}.png"]
    set iworker [events:get iworker]
    $iworker run ::image::save:view $file $dst $view
    return $dst
}

# Automatic operations.

proc ::ibisa::photo:outline:normalize {} {
    set file [work:area:current:photo:get]
    if {$file == ""} return

    set lines [photo:outline:get:lines]
    if {$lines == {}} return

    set lines_ {}

    foreach line $lines {
        set closed [photo:outline:is:closed $line]

        # Compute perimeter.  Cache segment lengths.
        set perimeter 0.0
        set lengths {}

        if $closed {
            set x0 [lindex $line end-1]
            set y0 [lindex $line end]
        } else {
            set x0 [lindex $line 0]
            set y0 [lindex $line 1]
        }

        set _x $x0
        set _y $y0

        foreach {x y} $line {
            set dx [expr $x - $_x]
            set dy [expr $y - $_y]
            set _x $x
            set _y $y
            set length [expr sqrt($dx * $dx + $dy * $dy)]
            lappend lengths $length
            set perimeter [expr $perimeter + $length]
        }

        # A fixed precision for the normalization.
        set division 5

        # Find new control points along the perimeter.
        set cpoints [list $x0 $y0]
        set _x $x0
        set _y $y0
        set i 0
        set rest $division

        foreach {x y} $line {
            set length [lindex $lengths $i]
            incr i

            while {$length >= $rest} {
                # Found control point.
                set factor [expr $rest / $length]
                set cpx [expr ($_x + $factor * ($x - $_x))]
                set cpy [expr ($_y + $factor * ($y - $_y))]
                lappend cpoints $cpx $cpy

                set length [expr $length - $rest]
                set rest $division
            }

            if {$length <= $rest} {
                set rest [expr $rest - $length]
            }

            set _x $x
            set _y $y
        }

        # Check that line is closed.
        if $closed {
            set _x [lindex $cpoints 0]
            set _y [lindex $cpoints 1]
            set x_ [lindex $cpoints end-1]
            set y_ [lindex $cpoints end]
            if {$_x != $x_ || $_y != $y_} {
                lappend cpoints $_x $_y
            }
        }

        lappend lines_ $cpoints
    }

    photo:outline:set:lines $lines_
}

proc ::ibisa::photo:outline:adjust {} {
    set ok [operation:start "Adjusting outline..."]
    if !$ok return

    set file [work:area:current:photo:get]
    if {$file == ""} {
        operation:message "error: no current photo."
        operation:end
        return
    }

    set lines [photo:outline:get:closed:lines]
    if {$lines == {}} {
        operation:message "error: there is no closed line."
        operation:end
        return
    }
    if {[llength $lines] > 1} {
        operation:message "error: there is more than one closed line."
        operation:end
        return
    }

    if ![::octave::has:support] {
        operation:message "error: no Octave support."
        operation:end
        return
    }

    # Get image.
    set img [::image::cache:get $file]
    set imgMatrix [::octave::image:matrix $img]
    ::image::cache:release $file

    # Get first closed line.
    set line [lindex $lines 0]
    set length [expr [llength $line] - 2]
    set lineMatrix [::octave::matrix 1 $length]
    for {set i 0} {$i < $length} {incr i} {
        $lineMatrix set 0 $i [lindex $line $i]
    }

    if [operation:should:return] {
        ::octave::delete $imgMatrix $lineMatrix
        operation:end
        return
    }

    # Call Octave's function.
    ::octave::eval:string "clear(\"segmentation\");"
    set result [::octave::eval segmentation $imgMatrix $lineMatrix]

    if [operation:should:return] {
        operation:end
        return
    }

    # Check the result.
    set length [llength $result]
    if {$length <= 2 || $length % 2} {
        operation:message "error: result contains wrong number of coordinates."
        operation:end
        return
    }

    # Close result.
    set x0 [lindex $result 0]
    set y0 [lindex $result 1]
    lappend result $x0 $y0
    lset lines 0 $result
    photo:outline:set:closed:lines $lines

    operation:message "done."
    operation:end
}

proc ::ibisa::photo:registration {} {
    set ok [operation:start "Registering photo..."]
    if !$ok return

    set file [work:area:current:photo:get]
    if {$file == ""} {
        operation:message "error: no current photo."
        operation:end
        return
    }

    work:area:photo:reference:get ref _
    if {$ref == ""} {
        operation:message "error: no reference photo."
        operation:end
        return
    }

    if {$file == $ref} {
        operation:message "error: current and reference photos are the same."
        operation:end
        return
    }

    if ![::octave::has:support] {
        operation:message "error: no Octave support."
        operation:end
        return
    }

    set files [list $file]
    set result [group:registration:loop $files $ref]

    if [operation:should:return] {
        operation:end
        return
    }

    # FIXME: use result.
    operation:end
}

proc ::ibisa::group:registration {} {
    set ok [operation:start "Registering photos..."]
    if !$ok return

    set files [events:get work:area:photos]
    if {$files == ""} {
        operation:message "error: no photos."
        operation:end
        return
    }

    set current [work:area:current:photo:get]
    if {$current == ""} {
        operation:message "error: no current photo."
        operation:end
        return
    }

    if ![::octave::has:support] {
        operation:message "error: no Octave support."
        operation:end
        return
    }

    set result [group:registration:loop $files $current]

    if [operation:should:return] {
        operation:end
        return
    }

    operation:end
    photo:show:neighbors
}

proc ::ibisa::group:registration:loop {files ref} {
    # w h dx dy angle scale opacity
    set view [list 512 512 0 0 0 1 1]
    set img2 [::image::view $ref $view]
    set img2Matrix [::octave::image:matrix $img2]
    $img2 -delete

    ::octave::eval:string "clear(\"registration\");"

    # Check previous records in database.
    variable imgDB
    set files_ {}
    foreach file $files {
        if {$file == $ref} continue

        set records [$imgDB map:get intercorrelation $file * $ref * *]
        if {$records != ""} continue

        # Triangular matrix.
        set records [$imgDB map:get intercorrelation $ref * $file * *]
        if {$records != ""} continue

        lappend files_ $file
    }

    # Build missing records.
    set result {}
    set records {}
    foreach file $files_ {
        if {$file == $ref} continue

        if [operation:should:return] break

        set img1 [::image::view $file $view]
        set img1Matrix [::octave::image:matrix $img1]
        $img1 -delete

        operation:message [file tail $file]

        if [operation:should:return] break

        # Call Octave's function.
        set result_ [::octave::eval:no:delete registration $img1Matrix $img2Matrix]
        ::octave::delete $img1Matrix

        # Compute intercorrelation.
        lassign $result_ angle scale xOffset yOffset
        set file:view [list 512 512 $xOffset $yOffset $angle $scale 1]
        set icorr [intercorrelation $file ${file:view} $ref $view]

        # Prepare new database record.
        set record [list [list intercorrelation $file ${file:view} $ref ${view}] $icorr]
        lappend records $record

        # Question: should we save the intercorrelation right now, or
        # should we wait until the loop is over?  Current answer is we
        # save after the loop.

        ::chrono::sleep
        operation:message "[file tail $file]: $result_ $icorr"
        lappend result $result_
    }

    ::octave::delete $img2Matrix

    if ![operation:should:return] {
        $imgDB map:set:many $records
    }

    return $result
}

proc ::ibisa::current:photo:intercorrelation {} {
    set file [work:area:current:photo:get]
    if {$file == ""} return
    set file:view [work:area:photo:view:stack:top]

    work:area:photo:reference:get ref ref:view
    if {$ref == ""} return

    ::chrono::sleep
    set icorr [intercorrelation $file ${file:view} $ref ${ref:view}]
    status:bar:message "Intercorrelation: $icorr"
}

proc ::ibisa::intercorrelation {file file:view ref ref:view} {
    # Reducing complexity.
    lset file:view 0 512
    lset file:view 1 512
    # Opacity.
    lset file:view 6 1

    lset ref:view 0 512
    lset ref:view 1 512
    lset ref:view 6 1

    set icorr [::image::intercorrelation $file ${file:view} $ref ${ref:view}]
    if [expr $icorr > 1.0] { set icorr 1.0 }
    if [expr $icorr < 0.0] { set icorr 0.0 }

    return $icorr;
}

proc ::ibisa::photo:show:neighbors {} {
    set ok [operation:start "Showing neighbors..."]
    if !$ok return

    set current [work:area:current:photo:get]
    if {$current == ""} {
        operation:message "error: no current photo."
        operation:end
        return
    }

    variable imgDB
    set records [$imgDB map:get intercorrelation * * $current * *]
    # Triangular matrix.
    eval lappend records [$imgDB map:get intercorrelation $current * * * *]

    if [operation:should:return] {
        operation:end
        return
    }

    set records [lsort -decreasing -index 5 $records]

    if [operation:should:return] {
        operation:end
        return
    }

    set photos [list $current]
    foreach record $records {
        set file [lindex $record 1]
        if {$file == $current} {
            # Triangular matrix.
            set file [lindex $record 3]
        }
        lappend photos $file
    }

    work:area:set:photos $photos
    operation:message "done."
    operation:end
}

proc ::ibisa::photo:clear:neighbors {} {
    set ok [operation:start "Clearing neighbors..."]
    if !$ok return

    set current [work:area:current:photo:get]
    if {$current == ""} {
        operation:message "error: no current photo."
        operation:end
        return
    }

    collection:clear:neighbors $current

    operation:message "done."
    operation:end
}

proc ::ibisa::clear:all:neighbors {} {
    variable canvas
    set title "Clearing All Neighbors!"
    set message "Are you sure you want to clear all photo neighbors?"
    set confirm [$canvas confirm $title $message]
    if {$confirm != "ok"} return

    set ok [operation:start "Clearing all neighbors..."]
    if !$ok return

    variable imgDB
    $imgDB map:delete intercorrelation * * * * *

    operation:message "done."
    operation:end
}

