Object subclass:#DragAndDropManager
instanceVariableNames:'dragView motionAction releaseAction initialPoint previousPoint
rememberedDelegate dragBlock lineMode dropAction opaque saveUnder
dragSize dragOffset dropObjects saveCursor lastView'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
!
View subclass:#DemoView2
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:DragAndDropManager
!
View subclass:#DemoView3
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:DragAndDropManager
!
View subclass:#DemoView
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:DragAndDropManager
!
!DragAndDropManager class methodsFor:'documentation'!
documentation
"
this class provides low-level drag & drop mechanisms.
[author:]
Claus Gittinger
"
!
history
"Created: 26.10.1996 / 15:02:00 / cg"
"Modified: 26.10.1996 / 15:21:42 / cg"
! !
!DragAndDropManager class methodsFor:'simple start'!
startDrag:anObjectOrCollection from:aView
"start a drop at the current pointer position"
(self new) startDrag:anObjectOrCollection from:aView offset:0@0
"
|o v|
v := (Button label:'press me').
v pressAction:[
|o|
o := DropObject newFile:('.').
DragAndDropManager startDrag:o from:v.
v turnOff
].
v openAt:100@100
"
!
startDrag:anObjectOrCollection from:aView offset:offset
"start a drop at the current pointer position"
(self new) startDrag:anObjectOrCollection from:aView offset:offset
"
|o v|
v := (Button label:'press me').
v pressAction:[
|o|
o := DropObject newFile:('.').
DragAndDropManager startDrag:o from:v offset:10@10.
v turnOff
].
v openAt:100@100
"
! !
!DragAndDropManager methodsFor:'accessing'!
dropObjects
^ dropObjects
!
dropObjects:anObjectOrCollection
anObjectOrCollection isCollection ifTrue:[
dropObjects := anObjectOrCollection
] ifFalse:[
dropObjects := Array with:anObjectOrCollection
].
! !
!DragAndDropManager methodsFor:'dragging - generic'!
doGenericDragX:x y:y
"drag to x/y; see if the target view allows a drop
and change the mouse pointer as appropriate"
|view newCursor|
previousPoint notNil ifTrue:[
opaque ifTrue:[
self restoreGenericAt:previousPoint
] ifFalse:[
self invertGenericAt:previousPoint
]
].
previousPoint := x @ y.
view := self destinationViewAt:previousPoint.
view ~~ lastView ifTrue:[
view isNil ifTrue:[
"/ alien view - dont know if it likes a drop
newCursor := Cursor questionMark
] ifFalse:[
"/ ST/X view - ask it.
(view canDrop:dropObjects) ifTrue:[
newCursor := Cursor thumbsUp
] ifFalse:[
newCursor := Cursor thumbsDown
]
].
dragView cursor:newCursor now:true.
lastView := view
].
opaque ifTrue:[
self drawGenericAt:previousPoint.
] ifFalse:[
self invertGenericAt:previousPoint
].
"Modified: 6.4.1997 / 14:29:44 / cg"
!
drawGenericAt:ip
|t offs p rootView|
rootView := dragView device rootView.
p := ip.
"
get device coordinates
"
(t := dragView transformation) notNil ifTrue:[
p := t applyTo:p.
].
"
translate to screen
"
offs := dragView device
translatePoint:0@0
from:(dragView id) to:(rootView id).
p := p + offs.
rootView clippedByChildren:false.
saveUnder isNil ifTrue:[
saveUnder := Form width:dragSize x height:dragSize y depth:rootView device depth on:dragView device.
saveUnder clippedByChildren:false.
].
saveUnder
copyFrom:rootView
x:p x - dragOffset x
y:p y - dragOffset y
toX:0
y:0
width:dragSize x
height:dragSize y.
rootView lineWidth:0.
dragBlock value:p value:rootView.
rootView flush
!
endGenericDragX:x y:y
previousPoint notNil ifTrue:[
opaque ifTrue:[
self restoreGenericAt:previousPoint
] ifFalse:[
self invertGenericAt:previousPoint
]
].
previousPoint := nil.
self uncatchEvents.
self endDragAt:x @ y
"Created: 26.10.1996 / 15:17:20 / cg"
"Modified: 26.10.1996 / 15:22:41 / cg"
!
invertGenericAt:ip
|t offs p rootView|
rootView := dragView device rootView.
p := ip.
"
get device coordinates
"
(t := dragView transformation) notNil ifTrue:[
p := t applyTo:p.
].
"
translate to screen
"
offs := dragView device
translatePoint:0@0
from:(dragView id) to:(rootView id).
p := p + offs.
rootView clippedByChildren:false.
rootView xoring:[
rootView lineWidth:0.
dragBlock value:p value:rootView.
rootView flush
].
"Created: 26.10.1996 / 15:15:26 / cg"
"Modified: 26.10.1996 / 15:27:09 / cg"
!
restoreGenericAt:ip
|t offs p rootView|
rootView := dragView device rootView.
p := ip.
"
get device coordinates
"
(t := dragView transformation) notNil ifTrue:[
p := t applyTo:p.
].
"
translate to screen
"
offs := dragView device
translatePoint:0@0
from:(dragView id) to:(rootView id).
p := p + offs.
rootView clippedByChildren:false.
rootView
copyFrom:saveUnder
x:0
y:0
toX:p x - dragOffset x
y:p y - dragOffset y
width:dragSize x
height:dragSize y.
!
startGenericDrag:aTwoArgDragBlock in:aView at:p atEnd:aFourArgEndBlock
"start a generic (caller-provided drag);
the dragBlock, aTwoArgDragBlock will be called with two args
aPoint and a drawingGC, to perform the drawing at some dragPoint.
The drag starts in aView at point p.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView"
self catchEventsFrom:aView.
motionAction := #doGenericDragX:y:.
releaseAction := #endGenericDragX:y:.
initialPoint := p.
previousPoint := nil.
dragBlock := aTwoArgDragBlock.
dropAction := aFourArgEndBlock.
"Modified: 26.10.1996 / 15:09:26 / cg"
"Created: 26.10.1996 / 15:16:13 / cg"
!
startOpaqueDrag:aTwoArgDragBlock offset:offs extent:ext in:aView at:p atEnd:aFourArgEndBlock
"start a generic opaque (caller-provided drag);
opaque drag means, that the drawing cannot be undone by two inverting
draws, but instead, the area under the dragged object must be saved
and restored. The areas size to be saved/restored is passed in ext.
the dragBlock, aTwoArgDragBlock will be called with two args
aPoint and a drawingGC, to perform the drawing at some dragPoint.
The drag starts in aView at point p.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView"
self catchEventsFrom:aView.
motionAction := #doGenericDragX:y:.
releaseAction := #endGenericDragX:y:.
initialPoint := p.
previousPoint := nil.
dragBlock := aTwoArgDragBlock.
dropAction := aFourArgEndBlock.
opaque := true.
dragSize := ext.
dragOffset := offs.
"Modified: 26.10.1996 / 15:09:26 / cg"
"Created: 26.10.1996 / 15:16:13 / cg"
! !
!DragAndDropManager methodsFor:'dragging - lines'!
doLineDragX:x y:y
previousPoint notNil ifTrue:[
self invertLineFrom:initialPoint to:previousPoint
].
previousPoint := x @ y.
self invertLineFrom:initialPoint to:previousPoint
"Modified: 26.10.1996 / 15:16:59 / cg"
!
endLineDragX:x y:y
previousPoint notNil ifTrue:[
self invertLineFrom:initialPoint to:previousPoint
].
previousPoint := nil.
self uncatchEvents.
self endDragAt:x @ y
"Created: 26.10.1996 / 15:17:20 / cg"
"Modified: 26.10.1996 / 15:22:41 / cg"
!
invertLineFrom:ip1 to:ip2
|t offs p1 p2 rootView a|
rootView := dragView device rootView.
p1 := ip1.
p2 := ip2.
"
get device coordinates
"
(t := dragView transformation) notNil ifTrue:[
p1 := t applyTo:p1.
p2 := t applyTo:p2.
].
"
translate to screen
"
offs := dragView device
translatePoint:0@0
from:(dragView id) to:(rootView id).
p1 := p1 + offs.
p2 := p2 + offs.
rootView clippedByChildren:false.
rootView xoring:[
rootView lineWidth:0.
lineMode == #arrow ifTrue:[
a := Arrow from:p1 to:p2.
a arrowHeadLength:(rootView device horizontalPixelPerMillimeter * 4) rounded.
a displayFilledOn:rootView.
] ifFalse:[
rootView displayLineFrom:p1 to:p2.
].
rootView flush
].
"Created: 26.10.1996 / 15:15:26 / cg"
"Modified: 26.10.1996 / 15:27:09 / cg"
!
startArrowDragIn:aView at:p atEnd:aBlock
"start a line-drag of an arrow-line.
The drag starts in aView at point p.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView"
self catchEventsFrom:aView.
motionAction := #doLineDragX:y:.
releaseAction := #endLineDragX:y:.
initialPoint := p.
previousPoint := nil.
dragBlock := nil.
lineMode := #arrow.
dropAction := aBlock.
"Modified: 26.10.1996 / 15:09:26 / cg"
"Created: 26.10.1996 / 15:16:13 / cg"
!
startLineDragIn:aView at:p atEnd:aFourArgEndBlock
"start a line-drag of a normal line.
The drag starts in aView at point p.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView"
self catchEventsFrom:aView.
motionAction := #doLineDragX:y:.
releaseAction := #endLineDragX:y:.
initialPoint := p.
previousPoint := nil.
dragBlock := nil.
lineMode := nil.
dropAction := aFourArgEndBlock.
"Modified: 26.10.1996 / 15:09:26 / cg"
"Created: 26.10.1996 / 15:16:13 / cg"
! !
!DragAndDropManager methodsFor:'drawing'!
showDragging:items in:aView at:p
|offs|
items size > 1 ifTrue:[
offs := 0.
items do:[:item |
item displayOn:aView at:p + (0@offs).
offs := offs + (item heightOn:self)
]
] ifFalse:[
items first displayOn:aView at:p.
]
"Created: 14.11.1996 / 15:31:31 / cg"
"Modified: 14.11.1996 / 16:32:00 / cg"
! !
!DragAndDropManager methodsFor:'easy drag & drop'!
startDrag:anObjectOrCollection from:aView offset:offset
"start a drop at the current pointer position"
|pos displayObjects device width height|
self dropObjects:anObjectOrCollection.
device := aView device.
pos := device translatePoint:(device pointerPosition)
from:(device rootView id)
to:(aView id).
displayObjects := dropObjects collect:[:each | each displayObject on:device].
height := displayObjects inject:0 into:[:sum :each | sum + (each heightOn:aView)].
width := displayObjects inject:0 into:[:max :each | max max:(each widthOn:aView)].
self startOpaqueDrag:[:aPoint :aView|self showDragging:displayObjects in:aView at:(aPoint - offset)]
offset:offset
extent:(width @ height)
in:aView
at:pos
atEnd:nil.
! !
!DragAndDropManager methodsFor:'event catching'!
buttonMotion:button x:x y:y view:aView
self perform:motionAction with:x with:y
"Created: 26.10.1996 / 15:09:00 / cg"
!
buttonRelease:button x:x y:y view:aView
self perform:releaseAction with:x with:y
"Created: 26.10.1996 / 15:09:14 / cg"
!
drop:something in:targetView at:aPoint from:sourceView ifOk:okAction ifFail:failAction
"try to drop some object in a targetView;
if any view along the targetViews superView chain takes it,
the okAction is evaluated; if not, failAction is evaluated."
|v pnt|
v := targetView.
pnt := aPoint.
[v notNil] whileTrue:[
(v canDrop:something) ifTrue:[
v
drop:something
at:aPoint
from:sourceView
with:[:o | okAction. ^ true]
ifFail:[:o | failAction. ^ false].
].
v := v superView.
pnt := nil
].
failAction value.
^ false
"Modified: 4.4.1997 / 18:25:18 / cg"
!
handlesButtonMotion:button inView:aView
"query from event processor: am I interested in button-events ?
yes I am (to activate the clicked-on field)."
^ aView == dragView
"Created: 26.10.1996 / 15:05:36 / cg"
!
handlesButtonRelease:button inView:aView
"query from event processor: am I interested in button-events ?
yes I am (to activate the clicked-on field)."
^ aView == dragView
"Created: 26.10.1996 / 15:05:48 / cg"
! !
!DragAndDropManager methodsFor:'private'!
catchEventsFrom:aView
dragView := aView.
saveCursor := dragView cursor.
rememberedDelegate := aView delegate.
aView delegate:self.
"Created: 26.10.1996 / 15:03:12 / cg"
"Modified: 26.10.1996 / 15:21:57 / cg"
!
destinationViewAt:ip
|rootPoint t viewId offs destinationId lastViewId destinationView
rootView destinationPoint device|
device := dragView device.
rootView := device rootView.
rootPoint := ip.
"
get device coordinates
"
(t := dragView transformation) notNil ifTrue:[
rootPoint := t applyTo:ip.
].
viewId := rootView id.
"
translate to screen
"
offs := device translatePoint:0@0 from:(dragView id) to:viewId.
rootPoint := rootPoint + offs.
"search view the drop is in"
[viewId notNil] whileTrue:[
destinationId := device viewIdFromPoint:rootPoint in:viewId.
lastViewId := viewId.
viewId := destinationId
].
^ device viewFromId:lastViewId
!
endDragAt:ip
|rootPoint t viewId offs destinationId lastViewId destinationView
rootView destinationPoint device|
dragView cursor:saveCursor now:true.
device := dragView device.
rootView := device rootView.
rootPoint := ip.
"
get device coordinates
"
(t := dragView transformation) notNil ifTrue:[
rootPoint := t applyTo:ip.
].
viewId := rootView id.
"
translate to screen
"
offs := device translatePoint:0@0 from:(dragView id) to:viewId.
rootPoint := rootPoint + offs.
"search view the drop is in"
[viewId notNil] whileTrue:[
destinationId := device viewIdFromPoint:rootPoint in:viewId.
lastViewId := viewId.
viewId := destinationId
].
destinationView := device viewFromId:lastViewId.
destinationId := lastViewId.
dropAction notNil ifTrue:[
"/ initiator wants to do it himself, manually.
dropAction value:destinationView
value:destinationId
value:rootPoint
value:destinationPoint.
^ self
].
"/ default drop behavior:
"/ if its one of my own views, ask if dropping is ok.
"/ if not, ask the device to drop it.
destinationView notNil ifTrue:[
"/
"/ one of my views
"/
destinationPoint := device translatePoint:rootPoint
from:(rootView id)
to:(destinationView id).
destinationView transformation notNil ifTrue:[
destinationPoint := destinationView transformation applyInverseTo:destinationPoint
].
(destinationView canDrop:dropObjects) ifTrue:[
destinationView drop:dropObjects at:destinationPoint.
^ self.
].
"/ try superViews along the chain ...
destinationView := destinationView superView.
[destinationView notNil] whileTrue:[
(destinationView canDrop:dropObjects) ifTrue:[
destinationView drop:dropObjects at:nil.
^ self.
].
destinationView := destinationView superView.
].
^ self
].
"/
"/ not one of my views
"/
"/ XXX add external clipboard mechanism via display
device
drop:dropObjects
inWindowID:destinationId
position:destinationPoint
rootPosition:rootPoint
"Modified: 4.4.1997 / 18:32:43 / cg"
!
uncatchEvents
dragView delegate:rememberedDelegate.
"Created: 26.10.1996 / 15:22:29 / cg"
"
DragAndDropManager allInstancesDo:[:m |
m uncatchEvents
]
"
! !
!DragAndDropManager::DemoView2 methodsFor:'events'!
buttonPress:button x:x y:y
DragAndDropManager new
startGenericDrag:[:p :v | v displayString:'hello' at:p]
in:self
at:(x@y)
atEnd:[:view
:viewID
:rootPoint
:viewPoint | ]
"
self new open
"
! !
!DragAndDropManager::DemoView3 methodsFor:'events'!
buttonPress:button x:x y:y
DragAndDropManager new
startArrowDragIn:self
at:(x@y)
atEnd:[:view
:viewID
:rootPoint
:viewPoint | ]
"
self new open
"
! !
!DragAndDropManager::DemoView methodsFor:'events'!
buttonPress:button x:x y:y
DragAndDropManager new
startLineDragIn:self at:(x@y)
atEnd:[:view
:viewID
:rootPoint
:viewPoint |
Transcript show:'dropped at ';
show:viewPoint;
show:' in '.
view notNil ifTrue:[
Transcript showCR:view
] ifFalse:[
Transcript show:'alien view ';
showCR:viewID address
]
].
"
self new open
"
! !
!DragAndDropManager class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.12 1997-04-06 13:03:43 cg Exp $'
! !