author | Claus Gittinger <cg@exept.de> |
Fri, 11 Apr 1997 16:51:27 +0200 | |
changeset 524 | 2911c30d10b3 |
parent 515 | 7df33af3beaa |
child 548 | 1a81d6be65b4 |
permissions | -rw-r--r-- |
341 | 1 |
Object subclass:#DragAndDropManager |
2 |
instanceVariableNames:'dragView motionAction releaseAction initialPoint previousPoint |
|
394 | 3 |
rememberedDelegate dragBlock lineMode dropAction opaque saveUnder |
397 | 4 |
dragSize dragOffset dropObjects saveCursor lastView' |
341 | 5 |
classVariableNames:'' |
6 |
poolDictionaries:'' |
|
7 |
category:'Interface-Support' |
|
8 |
! |
|
9 |
||
515 | 10 |
View subclass:#DemoView2 |
397 | 11 |
instanceVariableNames:'' |
12 |
classVariableNames:'' |
|
13 |
poolDictionaries:'' |
|
14 |
privateIn:DragAndDropManager |
|
15 |
! |
|
16 |
||
513 | 17 |
View subclass:#DemoView3 |
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
18 |
instanceVariableNames:'' |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
19 |
classVariableNames:'' |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
20 |
poolDictionaries:'' |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
21 |
privateIn:DragAndDropManager |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
22 |
! |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
23 |
|
515 | 24 |
View subclass:#DemoView |
341 | 25 |
instanceVariableNames:'' |
26 |
classVariableNames:'' |
|
27 |
poolDictionaries:'' |
|
28 |
privateIn:DragAndDropManager |
|
29 |
! |
|
30 |
||
31 |
!DragAndDropManager class methodsFor:'documentation'! |
|
32 |
||
348 | 33 |
documentation |
34 |
" |
|
35 |
this class provides low-level drag & drop mechanisms. |
|
36 |
||
37 |
[author:] |
|
38 |
Claus Gittinger |
|
39 |
" |
|
40 |
||
41 |
! |
|
42 |
||
341 | 43 |
history |
44 |
||
45 |
"Created: 26.10.1996 / 15:02:00 / cg" |
|
46 |
"Modified: 26.10.1996 / 15:21:42 / cg" |
|
47 |
! ! |
|
48 |
||
397 | 49 |
!DragAndDropManager class methodsFor:'simple start'! |
50 |
||
51 |
startDrag:anObjectOrCollection from:aView |
|
52 |
"start a drop at the current pointer position" |
|
53 |
||
54 |
(self new) startDrag:anObjectOrCollection from:aView offset:0@0 |
|
55 |
||
56 |
||
57 |
" |
|
58 |
|o v| |
|
59 |
||
60 |
v := (Button label:'press me'). |
|
61 |
v pressAction:[ |
|
62 |
|o| |
|
63 |
o := DropObject newFile:('.'). |
|
64 |
DragAndDropManager startDrag:o from:v. |
|
65 |
v turnOff |
|
66 |
]. |
|
67 |
v openAt:100@100 |
|
68 |
" |
|
69 |
||
70 |
! |
|
71 |
||
72 |
startDrag:anObjectOrCollection from:aView offset:offset |
|
73 |
"start a drop at the current pointer position" |
|
74 |
||
75 |
(self new) startDrag:anObjectOrCollection from:aView offset:offset |
|
76 |
||
77 |
||
78 |
" |
|
79 |
|o v| |
|
80 |
||
81 |
v := (Button label:'press me'). |
|
82 |
v pressAction:[ |
|
83 |
|o| |
|
84 |
o := DropObject newFile:('.'). |
|
85 |
DragAndDropManager startDrag:o from:v offset:10@10. |
|
86 |
v turnOff |
|
87 |
]. |
|
88 |
v openAt:100@100 |
|
89 |
" |
|
90 |
||
91 |
! ! |
|
92 |
||
394 | 93 |
!DragAndDropManager methodsFor:'accessing'! |
94 |
||
397 | 95 |
dropObjects |
96 |
^ dropObjects |
|
97 |
! |
|
98 |
||
99 |
dropObjects:anObjectOrCollection |
|
100 |
||
101 |
anObjectOrCollection isCollection ifTrue:[ |
|
102 |
dropObjects := anObjectOrCollection |
|
103 |
] ifFalse:[ |
|
104 |
dropObjects := Array with:anObjectOrCollection |
|
105 |
]. |
|
394 | 106 |
! ! |
107 |
||
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
108 |
!DragAndDropManager methodsFor:'dragging - generic'! |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
109 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
110 |
doGenericDragX:x y:y |
515 | 111 |
"drag to x/y; see if the target view allows a drop |
112 |
and change the mouse pointer as appropriate" |
|
113 |
||
114 |
|view newCursor| |
|
394 | 115 |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
116 |
previousPoint notNil ifTrue:[ |
394 | 117 |
opaque ifTrue:[ |
118 |
self restoreGenericAt:previousPoint |
|
119 |
] ifFalse:[ |
|
120 |
self invertGenericAt:previousPoint |
|
121 |
] |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
122 |
]. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
123 |
previousPoint := x @ y. |
394 | 124 |
|
125 |
view := self destinationViewAt:previousPoint. |
|
126 |
view ~~ lastView ifTrue:[ |
|
397 | 127 |
view isNil ifTrue:[ |
515 | 128 |
"/ alien view - dont know if it likes a drop |
129 |
newCursor := Cursor questionMark |
|
394 | 130 |
] ifFalse:[ |
515 | 131 |
"/ ST/X view - ask it. |
397 | 132 |
(view canDrop:dropObjects) ifTrue:[ |
515 | 133 |
newCursor := Cursor thumbsUp |
397 | 134 |
] ifFalse:[ |
515 | 135 |
newCursor := Cursor thumbsDown |
397 | 136 |
] |
394 | 137 |
]. |
515 | 138 |
dragView cursor:newCursor now:true. |
394 | 139 |
lastView := view |
140 |
]. |
|
141 |
||
142 |
opaque ifTrue:[ |
|
143 |
self drawGenericAt:previousPoint. |
|
144 |
] ifFalse:[ |
|
145 |
self invertGenericAt:previousPoint |
|
146 |
]. |
|
515 | 147 |
|
148 |
"Modified: 6.4.1997 / 14:29:44 / cg" |
|
394 | 149 |
! |
150 |
||
151 |
drawGenericAt:ip |
|
152 |
|t offs p rootView| |
|
153 |
||
154 |
rootView := dragView device rootView. |
|
155 |
||
156 |
p := ip. |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
157 |
|
394 | 158 |
" |
159 |
get device coordinates |
|
160 |
" |
|
161 |
(t := dragView transformation) notNil ifTrue:[ |
|
162 |
p := t applyTo:p. |
|
163 |
]. |
|
164 |
||
165 |
" |
|
166 |
translate to screen |
|
167 |
" |
|
168 |
offs := dragView device |
|
169 |
translatePoint:0@0 |
|
170 |
from:(dragView id) to:(rootView id). |
|
171 |
p := p + offs. |
|
172 |
||
173 |
rootView clippedByChildren:false. |
|
174 |
saveUnder isNil ifTrue:[ |
|
175 |
saveUnder := Form width:dragSize x height:dragSize y depth:rootView device depth on:dragView device. |
|
176 |
saveUnder clippedByChildren:false. |
|
177 |
]. |
|
178 |
saveUnder |
|
179 |
copyFrom:rootView |
|
180 |
x:p x - dragOffset x |
|
181 |
y:p y - dragOffset y |
|
182 |
toX:0 |
|
183 |
y:0 |
|
184 |
width:dragSize x |
|
185 |
height:dragSize y. |
|
186 |
||
187 |
rootView lineWidth:0. |
|
188 |
dragBlock value:p value:rootView. |
|
189 |
rootView flush |
|
190 |
||
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
191 |
! |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
192 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
193 |
endGenericDragX:x y:y |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
194 |
previousPoint notNil ifTrue:[ |
394 | 195 |
opaque ifTrue:[ |
196 |
self restoreGenericAt:previousPoint |
|
197 |
] ifFalse:[ |
|
198 |
self invertGenericAt:previousPoint |
|
199 |
] |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
200 |
]. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
201 |
previousPoint := nil. |
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
202 |
self uncatchEvents. |
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
203 |
self endDragAt:x @ y |
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
204 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
205 |
"Created: 26.10.1996 / 15:17:20 / cg" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
206 |
"Modified: 26.10.1996 / 15:22:41 / cg" |
394 | 207 |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
208 |
! |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
209 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
210 |
invertGenericAt:ip |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
211 |
|t offs p rootView| |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
212 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
213 |
rootView := dragView device rootView. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
214 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
215 |
p := ip. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
216 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
217 |
" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
218 |
get device coordinates |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
219 |
" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
220 |
(t := dragView transformation) notNil ifTrue:[ |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
221 |
p := t applyTo:p. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
222 |
]. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
223 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
224 |
" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
225 |
translate to screen |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
226 |
" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
227 |
offs := dragView device |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
228 |
translatePoint:0@0 |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
229 |
from:(dragView id) to:(rootView id). |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
230 |
p := p + offs. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
231 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
232 |
rootView clippedByChildren:false. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
233 |
rootView xoring:[ |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
234 |
rootView lineWidth:0. |
348 | 235 |
dragBlock value:p value:rootView. |
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
236 |
rootView flush |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
237 |
]. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
238 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
239 |
"Created: 26.10.1996 / 15:15:26 / cg" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
240 |
"Modified: 26.10.1996 / 15:27:09 / cg" |
394 | 241 |
|
242 |
! |
|
243 |
||
244 |
restoreGenericAt:ip |
|
245 |
|t offs p rootView| |
|
246 |
||
247 |
||
248 |
rootView := dragView device rootView. |
|
249 |
p := ip. |
|
250 |
||
251 |
" |
|
252 |
get device coordinates |
|
253 |
" |
|
254 |
(t := dragView transformation) notNil ifTrue:[ |
|
255 |
p := t applyTo:p. |
|
256 |
]. |
|
257 |
||
258 |
" |
|
259 |
translate to screen |
|
260 |
" |
|
261 |
offs := dragView device |
|
262 |
translatePoint:0@0 |
|
263 |
from:(dragView id) to:(rootView id). |
|
264 |
p := p + offs. |
|
265 |
||
266 |
rootView clippedByChildren:false. |
|
267 |
rootView |
|
268 |
copyFrom:saveUnder |
|
269 |
x:0 |
|
270 |
y:0 |
|
271 |
toX:p x - dragOffset x |
|
272 |
y:p y - dragOffset y |
|
273 |
width:dragSize x |
|
274 |
height:dragSize y. |
|
275 |
||
276 |
||
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
277 |
! |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
278 |
|
348 | 279 |
startGenericDrag:aTwoArgDragBlock in:aView at:p atEnd:aFourArgEndBlock |
280 |
"start a generic (caller-provided drag); |
|
281 |
the dragBlock, aTwoArgDragBlock will be called with two args |
|
282 |
aPoint and a drawingGC, to perform the drawing at some dragPoint. |
|
283 |
The drag starts in aView at point p. |
|
284 |
When finished, the endAction is called with four args: |
|
285 |
the targetView, the targetViews windowID (useful, if its an alien view), |
|
286 |
the dropPoint in root-coordinates and the dropPoint within the targetView" |
|
287 |
||
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
288 |
self catchEventsFrom:aView. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
289 |
motionAction := #doGenericDragX:y:. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
290 |
releaseAction := #endGenericDragX:y:. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
291 |
initialPoint := p. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
292 |
previousPoint := nil. |
348 | 293 |
dragBlock := aTwoArgDragBlock. |
294 |
dropAction := aFourArgEndBlock. |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
295 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
296 |
"Modified: 26.10.1996 / 15:09:26 / cg" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
297 |
"Created: 26.10.1996 / 15:16:13 / cg" |
394 | 298 |
|
299 |
! |
|
300 |
||
301 |
startOpaqueDrag:aTwoArgDragBlock offset:offs extent:ext in:aView at:p atEnd:aFourArgEndBlock |
|
302 |
"start a generic opaque (caller-provided drag); |
|
303 |
opaque drag means, that the drawing cannot be undone by two inverting |
|
304 |
draws, but instead, the area under the dragged object must be saved |
|
305 |
and restored. The areas size to be saved/restored is passed in ext. |
|
306 |
the dragBlock, aTwoArgDragBlock will be called with two args |
|
307 |
aPoint and a drawingGC, to perform the drawing at some dragPoint. |
|
308 |
The drag starts in aView at point p. |
|
309 |
When finished, the endAction is called with four args: |
|
310 |
the targetView, the targetViews windowID (useful, if its an alien view), |
|
311 |
the dropPoint in root-coordinates and the dropPoint within the targetView" |
|
312 |
||
313 |
self catchEventsFrom:aView. |
|
314 |
motionAction := #doGenericDragX:y:. |
|
315 |
releaseAction := #endGenericDragX:y:. |
|
316 |
initialPoint := p. |
|
317 |
previousPoint := nil. |
|
318 |
dragBlock := aTwoArgDragBlock. |
|
319 |
dropAction := aFourArgEndBlock. |
|
320 |
opaque := true. |
|
321 |
dragSize := ext. |
|
322 |
dragOffset := offs. |
|
323 |
||
324 |
"Modified: 26.10.1996 / 15:09:26 / cg" |
|
325 |
"Created: 26.10.1996 / 15:16:13 / cg" |
|
326 |
||
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
327 |
! ! |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
328 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
329 |
!DragAndDropManager methodsFor:'dragging - lines'! |
341 | 330 |
|
331 |
doLineDragX:x y:y |
|
332 |
previousPoint notNil ifTrue:[ |
|
333 |
self invertLineFrom:initialPoint to:previousPoint |
|
334 |
]. |
|
335 |
previousPoint := x @ y. |
|
336 |
self invertLineFrom:initialPoint to:previousPoint |
|
337 |
||
338 |
"Modified: 26.10.1996 / 15:16:59 / cg" |
|
394 | 339 |
|
340 |
||
341 | 341 |
! |
342 |
||
343 |
endLineDragX:x y:y |
|
344 |
previousPoint notNil ifTrue:[ |
|
345 |
self invertLineFrom:initialPoint to:previousPoint |
|
346 |
]. |
|
347 |
previousPoint := nil. |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
348 |
self uncatchEvents. |
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
349 |
self endDragAt:x @ y |
341 | 350 |
|
351 |
"Created: 26.10.1996 / 15:17:20 / cg" |
|
352 |
"Modified: 26.10.1996 / 15:22:41 / cg" |
|
394 | 353 |
|
341 | 354 |
! |
355 |
||
356 |
invertLineFrom:ip1 to:ip2 |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
357 |
|t offs p1 p2 rootView a| |
341 | 358 |
|
359 |
rootView := dragView device rootView. |
|
360 |
||
361 |
p1 := ip1. |
|
362 |
p2 := ip2. |
|
363 |
||
364 |
" |
|
365 |
get device coordinates |
|
366 |
" |
|
367 |
(t := dragView transformation) notNil ifTrue:[ |
|
368 |
p1 := t applyTo:p1. |
|
369 |
p2 := t applyTo:p2. |
|
370 |
]. |
|
371 |
||
372 |
" |
|
373 |
translate to screen |
|
374 |
" |
|
375 |
offs := dragView device |
|
376 |
translatePoint:0@0 |
|
377 |
from:(dragView id) to:(rootView id). |
|
378 |
p1 := p1 + offs. |
|
379 |
p2 := p2 + offs. |
|
380 |
||
381 |
rootView clippedByChildren:false. |
|
382 |
rootView xoring:[ |
|
383 |
rootView lineWidth:0. |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
384 |
lineMode == #arrow ifTrue:[ |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
385 |
a := Arrow from:p1 to:p2. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
386 |
a arrowHeadLength:(rootView device horizontalPixelPerMillimeter * 4) rounded. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
387 |
a displayFilledOn:rootView. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
388 |
] ifFalse:[ |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
389 |
rootView displayLineFrom:p1 to:p2. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
390 |
]. |
341 | 391 |
rootView flush |
392 |
]. |
|
393 |
||
394 |
"Created: 26.10.1996 / 15:15:26 / cg" |
|
395 |
"Modified: 26.10.1996 / 15:27:09 / cg" |
|
394 | 396 |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
397 |
! |
341 | 398 |
|
345 | 399 |
startArrowDragIn:aView at:p atEnd:aBlock |
348 | 400 |
"start a line-drag of an arrow-line. |
401 |
The drag starts in aView at point p. |
|
402 |
When finished, the endAction is called with four args: |
|
403 |
the targetView, the targetViews windowID (useful, if its an alien view), |
|
404 |
the dropPoint in root-coordinates and the dropPoint within the targetView" |
|
405 |
||
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
406 |
self catchEventsFrom:aView. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
407 |
motionAction := #doLineDragX:y:. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
408 |
releaseAction := #endLineDragX:y:. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
409 |
initialPoint := p. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
410 |
previousPoint := nil. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
411 |
dragBlock := nil. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
412 |
lineMode := #arrow. |
345 | 413 |
dropAction := aBlock. |
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
414 |
|
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
415 |
"Modified: 26.10.1996 / 15:09:26 / cg" |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
416 |
"Created: 26.10.1996 / 15:16:13 / cg" |
394 | 417 |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
418 |
! |
341 | 419 |
|
348 | 420 |
startLineDragIn:aView at:p atEnd:aFourArgEndBlock |
421 |
"start a line-drag of a normal line. |
|
422 |
The drag starts in aView at point p. |
|
423 |
When finished, the endAction is called with four args: |
|
424 |
the targetView, the targetViews windowID (useful, if its an alien view), |
|
425 |
the dropPoint in root-coordinates and the dropPoint within the targetView" |
|
426 |
||
341 | 427 |
self catchEventsFrom:aView. |
428 |
motionAction := #doLineDragX:y:. |
|
429 |
releaseAction := #endLineDragX:y:. |
|
430 |
initialPoint := p. |
|
342
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
431 |
previousPoint := nil. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
432 |
dragBlock := nil. |
7563cbf04502
added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents:
341
diff
changeset
|
433 |
lineMode := nil. |
348 | 434 |
dropAction := aFourArgEndBlock. |
341 | 435 |
|
436 |
"Modified: 26.10.1996 / 15:09:26 / cg" |
|
437 |
"Created: 26.10.1996 / 15:16:13 / cg" |
|
394 | 438 |
|
341 | 439 |
! ! |
440 |
||
397 | 441 |
!DragAndDropManager methodsFor:'drawing'! |
442 |
||
443 |
showDragging:items in:aView at:p |
|
444 |
|offs| |
|
445 |
||
446 |
items size > 1 ifTrue:[ |
|
447 |
offs := 0. |
|
448 |
items do:[:item | |
|
449 |
item displayOn:aView at:p + (0@offs). |
|
450 |
offs := offs + (item heightOn:self) |
|
451 |
] |
|
452 |
] ifFalse:[ |
|
453 |
items first displayOn:aView at:p. |
|
454 |
] |
|
455 |
||
456 |
"Created: 14.11.1996 / 15:31:31 / cg" |
|
457 |
"Modified: 14.11.1996 / 16:32:00 / cg" |
|
458 |
||
459 |
||
460 |
! ! |
|
461 |
||
462 |
!DragAndDropManager methodsFor:'easy drag & drop'! |
|
463 |
||
464 |
startDrag:anObjectOrCollection from:aView offset:offset |
|
465 |
"start a drop at the current pointer position" |
|
466 |
||
467 |
|pos displayObjects device width height| |
|
468 |
||
469 |
self dropObjects:anObjectOrCollection. |
|
470 |
||
471 |
device := aView device. |
|
472 |
pos := device translatePoint:(device pointerPosition) |
|
473 |
from:(device rootView id) |
|
474 |
to:(aView id). |
|
475 |
||
476 |
displayObjects := dropObjects collect:[:each | each displayObject on:device]. |
|
477 |
height := displayObjects inject:0 into:[:sum :each | sum + (each heightOn:aView)]. |
|
478 |
width := displayObjects inject:0 into:[:max :each | max max:(each widthOn:aView)]. |
|
479 |
||
480 |
self startOpaqueDrag:[:aPoint :aView|self showDragging:displayObjects in:aView at:(aPoint - offset)] |
|
481 |
offset:offset |
|
482 |
extent:(width @ height) |
|
483 |
in:aView |
|
484 |
at:pos |
|
485 |
atEnd:nil. |
|
486 |
! ! |
|
487 |
||
341 | 488 |
!DragAndDropManager methodsFor:'event catching'! |
489 |
||
490 |
buttonMotion:button x:x y:y view:aView |
|
491 |
self perform:motionAction with:x with:y |
|
492 |
||
493 |
"Created: 26.10.1996 / 15:09:00 / cg" |
|
394 | 494 |
|
495 |
||
341 | 496 |
! |
497 |
||
498 |
buttonRelease:button x:x y:y view:aView |
|
499 |
self perform:releaseAction with:x with:y |
|
500 |
||
501 |
"Created: 26.10.1996 / 15:09:14 / cg" |
|
394 | 502 |
|
503 |
! |
|
504 |
||
505 |
drop:something in:targetView at:aPoint from:sourceView ifOk:okAction ifFail:failAction |
|
506 |
"try to drop some object in a targetView; |
|
513 | 507 |
if any view along the targetViews superView chain takes it, |
508 |
the okAction is evaluated; if not, failAction is evaluated." |
|
509 |
||
510 |
|v pnt| |
|
511 |
||
512 |
v := targetView. |
|
513 |
pnt := aPoint. |
|
394 | 514 |
|
513 | 515 |
[v notNil] whileTrue:[ |
516 |
(v canDrop:something) ifTrue:[ |
|
517 |
v |
|
518 |
drop:something |
|
519 |
at:aPoint |
|
520 |
from:sourceView |
|
521 |
with:[:o | okAction. ^ true] |
|
522 |
ifFail:[:o | failAction. ^ false]. |
|
523 |
]. |
|
524 |
v := v superView. |
|
525 |
pnt := nil |
|
394 | 526 |
]. |
513 | 527 |
failAction value. |
394 | 528 |
^ false |
529 |
||
513 | 530 |
"Modified: 4.4.1997 / 18:25:18 / cg" |
341 | 531 |
! |
532 |
||
533 |
handlesButtonMotion:button inView:aView |
|
534 |
"query from event processor: am I interested in button-events ? |
|
535 |
yes I am (to activate the clicked-on field)." |
|
536 |
||
537 |
^ aView == dragView |
|
538 |
||
539 |
"Created: 26.10.1996 / 15:05:36 / cg" |
|
394 | 540 |
|
341 | 541 |
! |
542 |
||
543 |
handlesButtonRelease:button inView:aView |
|
544 |
"query from event processor: am I interested in button-events ? |
|
545 |
yes I am (to activate the clicked-on field)." |
|
546 |
||
547 |
^ aView == dragView |
|
548 |
||
549 |
"Created: 26.10.1996 / 15:05:48 / cg" |
|
394 | 550 |
|
341 | 551 |
! ! |
552 |
||
553 |
!DragAndDropManager methodsFor:'private'! |
|
554 |
||
555 |
catchEventsFrom:aView |
|
394 | 556 |
dragView := aView. |
557 |
saveCursor := dragView cursor. |
|
558 |
||
341 | 559 |
rememberedDelegate := aView delegate. |
394 | 560 |
aView delegate:self. |
341 | 561 |
|
562 |
"Created: 26.10.1996 / 15:03:12 / cg" |
|
563 |
"Modified: 26.10.1996 / 15:21:57 / cg" |
|
394 | 564 |
|
565 |
||
566 |
! |
|
567 |
||
568 |
destinationViewAt:ip |
|
569 |
|rootPoint t viewId offs destinationId lastViewId destinationView |
|
570 |
rootView destinationPoint device| |
|
571 |
||
572 |
device := dragView device. |
|
573 |
rootView := device rootView. |
|
574 |
rootPoint := ip. |
|
575 |
||
576 |
" |
|
577 |
get device coordinates |
|
578 |
" |
|
579 |
(t := dragView transformation) notNil ifTrue:[ |
|
580 |
rootPoint := t applyTo:ip. |
|
581 |
]. |
|
582 |
viewId := rootView id. |
|
583 |
||
584 |
" |
|
585 |
translate to screen |
|
586 |
" |
|
587 |
offs := device translatePoint:0@0 from:(dragView id) to:viewId. |
|
588 |
rootPoint := rootPoint + offs. |
|
589 |
||
590 |
"search view the drop is in" |
|
591 |
||
592 |
[viewId notNil] whileTrue:[ |
|
593 |
destinationId := device viewIdFromPoint:rootPoint in:viewId. |
|
594 |
lastViewId := viewId. |
|
595 |
viewId := destinationId |
|
596 |
]. |
|
597 |
^ device viewFromId:lastViewId |
|
341 | 598 |
! |
599 |
||
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
600 |
endDragAt:ip |
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
601 |
|rootPoint t viewId offs destinationId lastViewId destinationView |
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
602 |
rootView destinationPoint device| |
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
603 |
|
394 | 604 |
dragView cursor:saveCursor now:true. |
605 |
device := dragView device. |
|
606 |
rootView := device rootView. |
|
607 |
rootPoint := ip. |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
608 |
|
394 | 609 |
" |
610 |
get device coordinates |
|
611 |
" |
|
612 |
(t := dragView transformation) notNil ifTrue:[ |
|
613 |
rootPoint := t applyTo:ip. |
|
614 |
]. |
|
615 |
viewId := rootView id. |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
616 |
|
394 | 617 |
" |
618 |
translate to screen |
|
619 |
" |
|
620 |
offs := device translatePoint:0@0 from:(dragView id) to:viewId. |
|
621 |
rootPoint := rootPoint + offs. |
|
622 |
||
623 |
"search view the drop is in" |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
624 |
|
394 | 625 |
[viewId notNil] whileTrue:[ |
626 |
destinationId := device viewIdFromPoint:rootPoint in:viewId. |
|
627 |
lastViewId := viewId. |
|
628 |
viewId := destinationId |
|
629 |
]. |
|
630 |
destinationView := device viewFromId:lastViewId. |
|
631 |
destinationId := lastViewId. |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
632 |
|
513 | 633 |
dropAction notNil ifTrue:[ |
634 |
"/ initiator wants to do it himself, manually. |
|
635 |
||
636 |
dropAction value:destinationView |
|
637 |
value:destinationId |
|
638 |
value:rootPoint |
|
639 |
value:destinationPoint. |
|
640 |
^ self |
|
641 |
]. |
|
642 |
||
643 |
"/ default drop behavior: |
|
644 |
"/ if its one of my own views, ask if dropping is ok. |
|
645 |
"/ if not, ask the device to drop it. |
|
646 |
||
394 | 647 |
destinationView notNil ifTrue:[ |
513 | 648 |
"/ |
649 |
"/ one of my views |
|
650 |
"/ |
|
394 | 651 |
destinationPoint := device translatePoint:rootPoint |
652 |
from:(rootView id) |
|
653 |
to:(destinationView id). |
|
654 |
destinationView transformation notNil ifTrue:[ |
|
655 |
destinationPoint := destinationView transformation applyInverseTo:destinationPoint |
|
513 | 656 |
]. |
657 |
||
658 |
(destinationView canDrop:dropObjects) ifTrue:[ |
|
659 |
destinationView drop:dropObjects at:destinationPoint. |
|
660 |
^ self. |
|
661 |
]. |
|
394 | 662 |
|
513 | 663 |
"/ try superViews along the chain ... |
664 |
destinationView := destinationView superView. |
|
665 |
[destinationView notNil] whileTrue:[ |
|
666 |
(destinationView canDrop:dropObjects) ifTrue:[ |
|
667 |
destinationView drop:dropObjects at:nil. |
|
668 |
^ self. |
|
669 |
]. |
|
670 |
destinationView := destinationView superView. |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
671 |
]. |
394 | 672 |
^ self |
673 |
]. |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
674 |
|
513 | 675 |
"/ |
676 |
"/ not one of my views |
|
677 |
"/ |
|
678 |
||
679 |
"/ XXX add external clipboard mechanism via display |
|
680 |
device |
|
681 |
drop:dropObjects |
|
682 |
inWindowID:destinationId |
|
683 |
position:destinationPoint |
|
684 |
rootPosition:rootPoint |
|
685 |
||
686 |
"Modified: 4.4.1997 / 18:32:43 / cg" |
|
346
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
687 |
! |
1612c23d9c5d
pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents:
345
diff
changeset
|
688 |
|
341 | 689 |
uncatchEvents |
690 |
dragView delegate:rememberedDelegate. |
|
691 |
||
692 |
"Created: 26.10.1996 / 15:22:29 / cg" |
|
394 | 693 |
|
411 | 694 |
" |
695 |
DragAndDropManager allInstancesDo:[:m | |
|
696 |
m uncatchEvents |
|
697 |
] |
|
698 |
" |
|
341 | 699 |
! ! |
700 |
||
515 | 701 |
!DragAndDropManager::DemoView2 methodsFor:'events'! |
702 |
||
703 |
buttonPress:button x:x y:y |
|
704 |
DragAndDropManager new |
|
705 |
startGenericDrag:[:p :v | v displayString:'hello' at:p] |
|
706 |
in:self |
|
707 |
at:(x@y) |
|
708 |
atEnd:[:view |
|
709 |
:viewID |
|
710 |
:rootPoint |
|
711 |
:viewPoint | ] |
|
712 |
||
713 |
||
714 |
" |
|
715 |
self new open |
|
716 |
" |
|
717 |
||
718 |
||
719 |
! ! |
|
720 |
||
721 |
!DragAndDropManager::DemoView3 methodsFor:'events'! |
|
722 |
||
723 |
buttonPress:button x:x y:y |
|
724 |
DragAndDropManager new |
|
725 |
startArrowDragIn:self |
|
726 |
at:(x@y) |
|
727 |
atEnd:[:view |
|
728 |
:viewID |
|
729 |
:rootPoint |
|
730 |
:viewPoint | ] |
|
731 |
||
732 |
" |
|
733 |
self new open |
|
734 |
" |
|
735 |
! ! |
|
736 |
||
397 | 737 |
!DragAndDropManager::DemoView methodsFor:'events'! |
738 |
||
739 |
buttonPress:button x:x y:y |
|
740 |
DragAndDropManager new |
|
741 |
startLineDragIn:self at:(x@y) |
|
742 |
atEnd:[:view |
|
743 |
:viewID |
|
744 |
:rootPoint |
|
745 |
:viewPoint | |
|
746 |
||
747 |
Transcript show:'dropped at '; |
|
748 |
show:viewPoint; |
|
749 |
show:' in '. |
|
750 |
view notNil ifTrue:[ |
|
751 |
Transcript showCR:view |
|
752 |
] ifFalse:[ |
|
753 |
Transcript show:'alien view '; |
|
754 |
showCR:viewID address |
|
755 |
] |
|
756 |
]. |
|
757 |
||
758 |
" |
|
759 |
self new open |
|
760 |
" |
|
761 |
! ! |
|
762 |
||
341 | 763 |
!DragAndDropManager class methodsFor:'documentation'! |
764 |
||
765 |
version |
|
515 | 766 |
^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.12 1997-04-06 13:03:43 cg Exp $' |
341 | 767 |
! ! |