Object subclass:#DragAndDropManager
	instanceVariableNames:'dragView motionAction releaseAction initialPoint previousPoint
		rememberedDelegate dragBlock lineMode dropAction opaque saveUnder
		dragSize dragOffset dropObject 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 methodsFor:'accessing'!

dropObject:aDropObject
    dropObject := aDropObject
! !

!DragAndDropManager methodsFor:'dragging - generic'!

doGenericDragX:x y:y
    |view|

    previousPoint notNil ifTrue:[
        opaque ifTrue:[
            self restoreGenericAt:previousPoint
        ] ifFalse:[
            self invertGenericAt:previousPoint
        ]
    ].
    previousPoint := x @ y.

    view := self destinationViewAt:previousPoint.
    view ~~ lastView ifTrue:[
        (view notNil and:[view canDrop:dropObject]) ifTrue:[
            dragView cursor:(Cursor thumbsUp) now:true.
        ] ifFalse:[
            dragView cursor:(Cursor thumbsDown) now:true
        ].
        lastView := view
    ].

    opaque ifTrue:[
        self drawGenericAt:previousPoint.
    ] ifFalse:[
        self invertGenericAt:previousPoint
    ].
!

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:'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 the targetView takes it, okAction is evaluated ;
     if not, failAction is evaluated"

    (targetView canDrop:something) ifFalse:[
        failAction value.
        ^ false
    ].
    targetView drop:something at:aPoint from:sourceView 
               with:[:o | okAction. ^ true]
               ifFail:[:o | failAction. ^ false].
    ^ false





!

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.

    "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 isNil ifTrue:[
        (destinationView notNil and:[destinationView canDrop:dropObject]) ifTrue:[
            destinationView drop:dropObject to:destinationPoint
        ].
        ^ self
    ].

    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.7 1997-01-31 16:01:33 ca Exp $'
! !