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