source: trunk/builder/scripts/dragdrop.tcl @ 4503

Last change on this file since 4503 was 3177, checked in by mmc, 8 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

File size: 9.7 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: dragdrop - drag-n-drop support for widgets
3#
4#  Derived classes inherit the basic drag-n-drop support from this
5#  widget class.  Widgets can register themselves as drag-n-drop
6#  sources and also as targets.
7#
8#  Derived classes should overload the following methods:
9#
10#    dd_get_source .... examines click point and returns drag data
11#
12#    dd_scan_target ... scans target at drop point and returns 1 if
13#                         data is accepted, and 0 if rejected
14#
15#    dd_finalize ...... handles final drag-and-drop operation,
16#                         transferring data from the start widget
17#                         to the final target.  Called with "-op start"
18#                         on the starting widget, and "-op end" on the
19#                         target widget.
20#
21# ======================================================================
22#  AUTHOR:  Michael McLennan, Purdue University
23#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
24#
25#  See the file "license.terms" for information on usage and
26#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
27# ======================================================================
28package require Itcl
29
30itcl::class Rappture::Dragdrop {
31    public method dragdrop {option args}
32
33    private method _get_source {widget x y}
34    private method _do_scan {x y {option indicate}}
35    private method _do_drop {x y}
36
37    # derived classes override these methods
38    protected method dd_get_source {widget x y}
39    protected method dd_scan_target {x y data}
40    protected method dd_finalize {option args}
41
42    private variable _enabled 1      ;# set to 0 to disable drag-n-drop
43    private variable _dragwin ""     ;# widget controlling drag-n-drop cursor
44    private variable _dragowner ""   ;# mega-widget that initiated drag-n-drop
45    private variable _dragx ""       ;# drag-n-drop started at this x
46    private variable _dragy ""       ;# drag-n-drop started at this y
47    private variable _dragdata ""    ;# description of drag-n-drop source data
48    private variable _lastcursor ""  ;# cursor before start of drag-n-drop
49    private variable _lasttarget ""  ;# last target found by _do_scan
50
51    set dir [file dirname [info script]]
52    private common _dcursor "@[file join $dir images drag.xbm] [file join $dir images dragm.xbm] black white"
53}
54
55# ----------------------------------------------------------------------
56# USAGE: dragdrop protocol
57# USAGE: dragdrop enabled ?<boolean>?
58# USAGE: dragdrop source <widget>
59# USAGE: dragdrop indicate -from <w> -to <w> -x <x> -y <y> -data <data>
60# USAGE: dragdrop finalize -op <dir> -from <w> -to <w> -x <x> -y <y> -data <data>
61# USAGE: dragdrop cancel
62#
63# Derived classes use this to register component widgets as drag-n-drop
64# sources and targets.
65# ----------------------------------------------------------------------
66itcl::body Rappture::Dragdrop::dragdrop {option args} {
67    switch -- $option {
68        protocol {
69            return "1.0"
70        }
71        enabled {
72            if {[llength $args] == 0} {
73                return $_enabled
74            } elseif {[llength $args] != 1} {
75                error "wrong # args: should be \"dragdrop enabled ?boolean?\""
76            }
77            set state [lindex $args 0]
78            set _enabled [expr {($state) ? 1 : 0}]
79            return $_enabled
80        }
81        source {
82            set widget [lindex $args 0]
83            bind $widget <ButtonPress> [itcl::code $this _get_source %W %X %Y]
84            bind $widget <B1-Motion> [itcl::code $this _do_scan %X %Y]
85            bind $widget <ButtonRelease> [itcl::code $this _do_drop %X %Y]
86        }
87        indicate {
88            array set params $args
89            return [dd_scan_target $params(-x) $params(-y) $params(-data)]
90        }
91        finalize {
92            return [eval dd_finalize drop $args]
93        }
94        cancel {
95            dd_finalize cancel
96        }
97        default {
98            error "bad option \"$option\": should be protocol, source, indicate, finalize, cancel"
99        }
100    }
101}
102
103# ----------------------------------------------------------------------
104# USAGE: _get_source <widget> <x> <y>
105#
106# Invoked when the user clicks on a widget to start a drag-n-drop
107# operation.  Saves the <x>,<y> coordinate, and waits for a _do_scan
108# call.  If the user drags the mouse a short distance away from the
109# click point, then the drag-n-drop operation begins.
110# ----------------------------------------------------------------------
111itcl::body Rappture::Dragdrop::_get_source {widget x y} {
112    set _dragowner ""
113    set _lasttarget ""
114
115    set winx [expr {$x-[winfo rootx $widget]}]
116    set winy [expr {$y-[winfo rooty $widget]}]
117    set d [dd_get_source $widget $winx $winy]
118
119    if {"" != $d && $_enabled} {
120        set _dragwin $widget
121        set w $widget
122        while {$w != "."} {
123            if {[catch {$w dragdrop protocol}] == 0} {
124                set _dragowner $w
125                break
126            }
127            set w [winfo parent $w]
128        }
129        set _dragx $x
130        set _dragy $y
131        set _dragdata $d
132        set _lastcursor [$widget cget -cursor]
133        $widget configure -cursor $_dcursor
134    } else {
135        set _dragwin ""
136        set _dragowner ""
137        set _dragx ""
138        set _dragy ""
139        set _dragdata ""
140    }
141}
142
143# ----------------------------------------------------------------------
144# USAGE: _do_scan <x> <y> ?<operation>?
145#
146# Invoked as the user moves the mouse pointer during a drag-n-drop
147# operation.  Scans for a widget at the given <x>,<y> root window
148# coordinate that will accept the drag data.
149# ----------------------------------------------------------------------
150itcl::body Rappture::Dragdrop::_do_scan {x y {option indicate}} {
151    if {"" != $_dragowner} {
152        set dx [expr {abs($x-$_dragx)}]
153        set dy [expr {abs($y-$_dragy)}]
154
155        # moved significantly away from click?
156        if {$dx > 3 || $dy > 3} {
157            set win [winfo containing $x $y]
158            if {"" != $win} {
159                set found 0
160                set wx [expr {$x-[winfo rootx $win]}]
161                set wy [expr {$y-[winfo rooty $win]}]
162                while {"." != $win} {
163                    # find the containing win that handles dragdrop and
164                    # accepts the given data type
165                    if {[catch {$win dragdrop $option -op end -from $_dragowner -to $win -x $wx -y $wy -data $_dragdata} result] == 0 && [string is boolean -strict $result] && $result} {
166                        if {"" != $_lasttarget && $_lasttarget != $win} {
167                            # if we had a different target, cancel it
168                            catch {$_lasttarget dragdrop cancel}
169                        }
170                        set _lasttarget $win
171                        set found 1
172
173                        # if this is a finalize operation, then send final
174                        # message to starting side
175                        if {$option == "finalize"} {
176                            catch {$_dragowner dragdrop finalize -op start -from $_dragowner -to $win -x $wx -y $wy -data $_dragdata}
177                        }
178                        break
179                    }
180                    set win [winfo parent $win]
181                }
182
183                if {!$found && "" != $_lasttarget} {
184                    # no drop target at this point? cancel any previous target
185                    catch {$_lasttarget dragdrop cancel}
186                    set _lasttarget ""
187                }
188            }
189        }
190    }
191}
192
193# ----------------------------------------------------------------------
194# USAGE: _do_drop <x> <y>
195#
196# Invoked when the user releases the mouse pointer during a drag-n-drop
197# operation.  Tries to send the drag data to the widget at the current
198# <x>,<y> root window coordinate to complete the operation.
199# ----------------------------------------------------------------------
200itcl::body Rappture::Dragdrop::_do_drop {x y} {
201    if {"" != $_dragowner} {
202        _do_scan $x $y indicate
203        _do_scan $x $y finalize
204        $_dragwin configure -cursor $_lastcursor
205    }
206}
207
208# ----------------------------------------------------------------------
209# USAGE: dd_get_source <widget> <x> <y>
210#
211# Derived classes override this method to look at the given <widget>
212# and <x>,<y> coordinate and figure out what data value the source
213# is exporting.  Returns a string that identifies the type of the
214# data.  This string is passed along to targets via the dd_scan_target
215# method.  If the target may check the source type and reject the data.
216# ----------------------------------------------------------------------
217itcl::body Rappture::Dragdrop::dd_get_source {widget x y} {
218    return "?"
219}
220
221# ----------------------------------------------------------------------
222# USAGE: dd_scan_target <x> <y> <data>
223#
224# Derived classes override this method to look within themselves at
225# the given <x>,<y> coordinate and decide whether or not it can
226# accept the <data> type at that location.  Returns 1 if the target
227# accepts the data, and 0 otherwise.
228# ----------------------------------------------------------------------
229itcl::body Rappture::Dragdrop::dd_scan_target {x y data} {
230    return 0
231}
232
233# ----------------------------------------------------------------------
234# USAGE: dd_finalize drop -op start|end -from <w> -to <w> \
235#                           -x <x> -y <y> -data <data>
236# USAGE: dd_finalize cancel
237#
238# Derived classes override this method to handle the end of a drag
239# and drop operation.  The operation can be completed with a successful
240# drop of data, or cancelled.  Returns 1 if drop was successful, and
241# 0 otherwise.
242# ----------------------------------------------------------------------
243itcl::body Rappture::Dragdrop::dd_finalize {option args} {
244    return 0
245}
Note: See TracBrowser for help on using the repository browser.