# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: drop.tcl,v 2.16 2006/01/28 19:16:59 jfontain Exp $


class dropSite {

    set (list) {}                                                                                      ;# initialize list of objects

    proc dropSite {this args} switched {$args} {
        lappend (list) $this                                                         ;# manage a list of drop sites for drop regions
        switched::complete $this
        if {[string length $switched::($this,-path)] == 0} {
            error {-path option must be defined}
        }
    }

    proc ~dropSite {this} {
        set index [lsearch -exact $(list) $this]                                                            ;# remove self from list
        set (list) [lreplace $(list) $index $index]
        if {[string length $switched::($this,-path)] > 0} {                                      ;# if there was an actual drop site
            delete $($this,bindings)                                                                         ;# remove drop bindings
        }
    }

    proc options {this} {                                          ;# accept all data formats by default, force state initialization
        return [list\
            [list -command {} {}]\
            [list -formats {{}} {{}}]\
            [list -path {} {}]\
            [list -regioncommand {} {}]\
            [list -state normal]\
        ]
    }

    proc set-command {this value} {}                                        ;# nothing to do as data is stored at the switched level
    proc set-formats {this value} {}

    proc set-state {this value} {
        switch $value {
            disabled {set ($this,enabled) 0}
            normal {set ($this,enabled) 1}
            default {
                error "bad state value \"$value\": must be normal or disabled"
            }
        }
    }

    # may be used in complement of -path, with a higher priority, must return a left, top, right, bottom region or an empty list:
    proc set-regioncommand {this value} {}

    proc set-path {this value} {                                                    ;# target widget path (must always be specified)
        if {$switched::($this,complete)} {
            error {option -path cannot be set dynamically}
        }
        if {![winfo exists $value]} {
            error "invalid widget: \"$value\""
        }
        set ($this,bindings) [new bindings $value end]                                    ;# do not interfere with existing bindings
        set ($this,visible) 1                                                                                  ;# monitor visibility
        bindings::set $($this,bindings) <Visibility> "set ::dropSite::($this,visible) \[string compare %s VisibilityFullyObscured\]"
    }

    proc dropped {this} {
        if {[string length $switched::($this,-command)] > 0} {
            uplevel #0 $switched::($this,-command)                         ;# always invoke command at global level as tk buttons do
            # the user command can retrieve data in the dragSite format indexed data array, for the available formats (dragSite
            # data array names). it is guaranteed that at least 1 drop site format is supported by the drag site
        }
    }

    proc regions {formats} {                                             ;# return a list of drop sites with compatible data formats
        # update was invoked here to make sure visibility and coordinates are correct, but it interferences with events in drag code
        set regions {}
        foreach site $(list) {
            if {!$($site,enabled)} continue
            set path $switched::($site,-path)
            set region {}
            if {[string length $switched::($site,-regioncommand)] > 0} {
                set region [uplevel #0 $switched::($site,-regioncommand)]
            } else {
                if {[catch {set viewable [winfo viewable $path]}]} continue             ;# check if viewable, path may also be empty
                if {!$viewable || !$($site,visible)} continue   ;# check that drop site is at least partly visible and not iconified
                set x [winfo rootx $path]
                set y [winfo rooty $path]
                set region [list $x $y [expr {$x + [winfo width $path]}] [expr {$y + [winfo height $path]}]]
            }
            foreach format $switched::($site,-formats) {
                if {[lsearch -exact $formats $format] < 0} continue
                if {[llength $region] > 0} {
                    lappend regions [concat $site $path $region]
                    break                               ;# drop site will accept at least one of the data formats from the drag site
                }
            }
        }
        return $regions
    }

}
