1# ------------------------------------------------------------------------------
2#  dragsite.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: dragsite.tcl 606 2004-04-05 07:06:06Z mcourtoi $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - DragSite::include
8#     - DragSite::setdrag
9#     - DragSite::register
10#     - DragSite::_begin_drag
11#     - DragSite::_init_drag
12#     - DragSite::_end_drag
13#     - DragSite::_update_operation
14# ----------------------------------------------------------------------------
15
16namespace eval DragSite {
17    Widget::define DragSite dragsite -classonly
18
19    Widget::declare DragSite [list \
20	    [list	-dragevent	Enum	1	0	[list 1 2 3]] \
21	    [list	-draginitcmd	String	""	0] \
22	    [list	-dragendcmd	String	""	0] \
23	    ]
24
25    variable _topw ".drag"
26    variable _tabops
27    variable _state
28    variable _x0
29    variable _y0
30
31    bind BwDrag1 <ButtonPress-1> {DragSite::_begin_drag press  %W %s %X %Y}
32    bind BwDrag1 <B1-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
33    bind BwDrag2 <ButtonPress-2> {DragSite::_begin_drag press  %W %s %X %Y}
34    bind BwDrag2 <B2-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
35    bind BwDrag3 <ButtonPress-3> {DragSite::_begin_drag press  %W %s %X %Y}
36    bind BwDrag3 <B3-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
37
38    proc use {} {}
39}
40
41
42# ----------------------------------------------------------------------------
43#  Command DragSite::include
44# ----------------------------------------------------------------------------
45proc DragSite::include { class type event } {
46    set dragoptions [list \
47	    [list	-dragenabled	Boolean	0	0] \
48	    [list	-draginitcmd	String	""	0] \
49	    [list	-dragendcmd	String	""	0] \
50	    [list	-dragtype	String	$type	0] \
51	    [list	-dragevent	Enum	$event	0	[list 1 2 3]] \
52	    ]
53    Widget::declare $class $dragoptions
54}
55
56
57# ----------------------------------------------------------------------------
58#  Command DragSite::setdrag
59#  Widget interface to register
60# ----------------------------------------------------------------------------
61proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} {
62    set cen       [Widget::hasChanged $path -dragenabled en]
63    set cdragevt  [Widget::hasChanged $path -dragevent   dragevt]
64    if { $en } {
65        if { $force || $cen || $cdragevt } {
66            register $subpath \
67                -draginitcmd $initcmd \
68                -dragendcmd  $endcmd  \
69                -dragevent   $dragevt
70        }
71    } else {
72        register $subpath
73    }
74}
75
76
77# ----------------------------------------------------------------------------
78#  Command DragSite::register
79# ----------------------------------------------------------------------------
80proc DragSite::register { path args } {
81    upvar \#0 DragSite::$path drag
82
83    if { [info exists drag] } {
84        bind $path $drag(evt) {}
85        unset drag
86    }
87    Widget::init DragSite .drag$path $args
88    set event   [Widget::getMegawidgetOption .drag$path -dragevent]
89    set initcmd [Widget::getMegawidgetOption .drag$path -draginitcmd]
90    set endcmd  [Widget::getMegawidgetOption .drag$path -dragendcmd]
91    set tags    [bindtags $path]
92    set idx     [lsearch $tags "BwDrag*"]
93    Widget::destroy .drag$path
94    if { $initcmd != "" } {
95        if { $idx != -1 } {
96            bindtags $path [lreplace $tags $idx $idx BwDrag$event]
97        } else {
98            bindtags $path [concat $tags BwDrag$event]
99        }
100        set drag(initcmd) $initcmd
101        set drag(endcmd)  $endcmd
102        set drag(evt)     $event
103    } elseif { $idx != -1 } {
104        bindtags $path [lreplace $tags $idx $idx]
105    }
106}
107
108
109# ----------------------------------------------------------------------------
110#  Command DragSite::_begin_drag
111# ----------------------------------------------------------------------------
112proc DragSite::_begin_drag { event source state X Y } {
113    variable _x0
114    variable _y0
115    variable _state
116
117    switch -- $event {
118        press {
119            set _x0    $X
120            set _y0    $Y
121            set _state "press"
122        }
123        motion {
124            if { ![info exists _state] } {
125                # This is just extra protection. There seem to be
126                # rare cases where the motion comes before the press.
127                return
128            }
129            if { [string equal $_state "press"] } {
130                if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } {
131                    set _state "done"
132                    _init_drag $source $state $X $Y
133                }
134            }
135        }
136    }
137}
138
139
140# ----------------------------------------------------------------------------
141#  Command DragSite::_init_drag
142# ----------------------------------------------------------------------------
143proc DragSite::_init_drag { source state X Y } {
144    variable _topw
145    upvar \#0 DragSite::$source drag
146
147    destroy  $_topw
148    toplevel $_topw
149    wm withdraw $_topw
150    wm overrideredirect $_topw 1
151
152    set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]]
153    if { $info != "" } {
154        set type [lindex $info 0]
155        set ops  [lindex $info 1]
156        set data [lindex $info 2]
157
158        if { [winfo children $_topw] == "" } {
159            if { [string equal $type "BITMAP"] || [string equal $type "IMAGE"] } {
160                label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0
161            } else {
162                label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0
163            }
164            pack  $_topw.l
165        }
166        wm geometry $_topw +[expr {$X+1}]+[expr {$Y+1}]
167        wm deiconify $_topw
168        if {[catch {tkwait visibility $_topw}]} {
169            return
170        }
171        BWidget::grab  set $_topw
172        BWidget::focus set $_topw
173
174        bindtags $_topw [list $_topw DragTop]
175        DropSite::_init_drag $_topw $drag(evt) $source $state $X $Y $type $ops $data
176    } else {
177        destroy $_topw
178    }
179}
180
181
182# ----------------------------------------------------------------------------
183#  Command DragSite::_end_drag
184# ----------------------------------------------------------------------------
185proc DragSite::_end_drag { source target op type data result } {
186    variable _topw
187    upvar \#0 DragSite::$source drag
188
189    BWidget::grab  release $_topw
190    BWidget::focus release $_topw
191    destroy $_topw
192    if { $drag(endcmd) != "" } {
193        uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result]
194    }
195}
196
197
198