Object subclass:#DragAndDropManager
instanceVariableNames:'dragView motionAction releaseAction initialPoint previousPoint
rememberedDelegate dragBlock lineMode dropAction'
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 methodsFor:'dragging - generic'!
doGenericDragX:x y:y
previousPoint notNil ifTrue:[
self invertGenericAt:previousPoint
].
previousPoint := x @ y.
self invertGenericAt:previousPoint
"Modified: 26.10.1996 / 15:16:59 / cg"
!
endGenericDragX:x y:y
previousPoint notNil ifTrue:[
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"
!
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"
! !
!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:'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"
!
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.
rememberedDelegate := aView delegate.
aView delegate:self
"Created: 26.10.1996 / 15:03:12 / cg"
"Modified: 26.10.1996 / 15:21:57 / cg"
!
endDragAt:ip
|rootPoint t viewId offs destinationId lastViewId destinationView
rootView destinationPoint device|
dropAction notNil ifTrue:[
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.
"into another one"
destinationView notNil ifTrue:[
destinationPoint := device translatePoint:rootPoint
from:(rootView id)
to:(destinationView id).
destinationView transformation notNil ifTrue:[
destinationPoint := destinationView transformation applyInverseTo:destinationPoint
].
] ifFalse:[
"
not one of my views
"
].
dropAction value:destinationView
value:destinationId
value:rootPoint
value:destinationPoint
]
!
uncatchEvents
dragView delegate:rememberedDelegate.
"Created: 26.10.1996 / 15:22:29 / cg"
! !
!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.6 1996-11-14 15:16:42 cg Exp $'
! !