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 $'

! !