"

 COPYRIGHT (c) 1996 by eXept Software AG / Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

Object subclass:#DragAndDropManager

	instanceVariableNames:'dragView motionAction releaseAction initialPoint previousPoint

		rememberedDelegate dragBlock lineMode dropAction opaque saveUnder

		dragSize dragOffset dropObjects saveCursor lastView

		lastScreenPosition'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-Support'

!

View subclass:#DemoView

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:DragAndDropManager

!

View subclass:#DemoView3

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:DragAndDropManager

!

View subclass:#DemoView2

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:DragAndDropManager

!

!DragAndDropManager class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996 by eXept Software AG / Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    this class provides low-level drag & drop mechanisms.

    Easy to use interface interfaces:

    A drag is usually initiated by a view or its application model,

    when a selection is moved (for example, SelectionInListView can

    be initializd to do so). 

    There, the view creates a collection of dropObjects from its selection,

    and starts the drag operation with:

        DragAndDropManager startDrag:collectionOfDragObjects from:aView.

    This easy to use interface starts a drag and also drops the collection

    into the target view.

    While dragging, a thumbsUp cursor is shown, if the view-under-the-drag

    can handle a drop, a thumbsDown is shown if not, and a question mark

    is shown for alien views (which means: we dont know).

    Alien view drop is supported (but no 'canDrop' query).

    For rubber-band line dragging, two more easy-to-use startup methods are

    provided:

        DragAndDropManager

                startLineDragIn:aView at:position

                atEnd:aFourArgEndBlock

    and:

        DragAndDropManager

                startArrowDragIn:aView at:position

                atEnd:aFourArgEndBlock

    both of the above expect a 4-arg block to be passed, which will be

    evaluated at end-drag, with the target view, its viewID, the drop position

    on the screen and within the target view as arguments.

    Expert interface:

    More control over the dragging (i.e. the drawing procedure)

    can be optained, by passing a dragBlock and an endDrag action:

        aDragAndDropMgr := DragAndDropManager new.

        aDragAndDropMgr dropObjects:(self collectionOfDragObjects).

        aDragAndDropMgr 

            startOpaqueDrag:[:aPoint :aView :dropObjects | 

                                self 

                                    showDragging:dropObjects

                                    in:aView 

                                    at:aPoint - (xOffset@0)

                            ]

            offset:clickOffset

            extent:saveUnderExtent

            in:self

            at:clickPoint

            atEnd:[:v :vId :posScreen :posView | ... ]

    the arguments are:

      startOpaqueDrag:

        a 3-arg block, which is evaluated by the d&d manager whenever the

        mouse moves; it is supposed to draw the dropObjects at some position

        in the passed view.

      offset:

        a clickOffset; drawing is offset by this amount

      extent:  

        a save extent; the size of the screen area that must be saved during

        the drag operation

      in:

        initiating view

      at:

        position where d&d operation starts

      atEnd:

        a 4-arg block that is evaluated when the d&d is finished.

        It gets the target view (or nil, for alien views), the targets

        view ID (needed if its an alien view), the screen position and the

        relative position within the target view of the drop as arguments.

        For internal (ST/X) views, the dropBlock should perform

        a simple canDrop:/doDrop message.

        For alien views, the Displays d&d functions can be used.

    [author:]

        Claus Gittinger

    [see also:]

        DemoView DemoView2 DemoView3 - examples

        SelectionInListView FileBrowser - for a concrete example

"

!

examples

"

  a button, which initiates dragging of a file-object

  Notice that this can be dropped into the launchers panel,

                                                                [exBegin]

     |o top v|

     top := StandardSystemView new.

     v := Button label:'press for drag' in:top.

     v pressAction:[

                |o|

                o := DropObject newFile:('/etc').

                DragAndDropManager startDrag:o from:v.

                v turnOff

              ].

     top openWithExtent:200@200

                                                                [exEnd]

  initiate a drag with some offset:

                                                                [exBegin]

     |o top v|

     top := StandardSystemView new.

     v := Button label:'press for drag' in:top.

     v pressAction:[

                |o|

                o := DropObject newFile:('.').

                DragAndDropManager startDrag:o from:v offset:10@10.

                v turnOff

              ].

     top openWithExtent:200@200

                                                                [exEnd]

  initiate a line drag:

                                                                [exBegin]

     |o top v endAction|

     endAction := [ :v :vID :sPos :vPos |

                    Transcript show:'end drag in '.

                    v isNil ifTrue:[

                        Transcript show:'alien view'

                    ] ifFalse:[

                        Transcript show:v

                    ].

                    Transcript show:' at screen: '; show:sPos;

                               show:' in view: '; showCR:vPos

                ].

     top := StandardSystemView new.

     v := Button label:'press for drag' in:top.

     v pressAction:[

                DragAndDropManager 

                    startLineDragIn:v at:10@10 atEnd:endAction.

                v turnOff

              ].

     top openWithExtent:200@200

                                                                [exEnd]

"

! !

!DragAndDropManager class methodsFor:'simple start'!

startArrowDragIn:aView at:dragPoint atEnd:aFourArgBlock

    "start a rubber-arrow-line dragging in aView at dragPoint.

     When finished, evaluate the fourArgBlock with targetView,

     targetID, screenPosition and targetViewPosition as arguments"

    ^ self new

        startArrowDragIn:aView at:dragPoint atEnd:aFourArgBlock

    "

     |o v|

     v := Button label:'press me'.

     v pressAction:[

                |o|

                o := DropObject newFile:('.').

                v turnOff; repairDamage.

                DragAndDropManager 

                    startArrowDragIn:v 

                    at:0@0 

                    atEnd:[:v :vID :sPos :vPos |

                                v isNil ifTrue:[

                                    Transcript show:'alien view'

                                ] ifFalse:[

                                    Transcript show:'view: ';

                                               show:v

                                ].

                                Transcript show:' screen: '; show:sPos;

                                           show:' inView: '; showCR:vPos.

                          ].

              ].

     v openAt:100@100

    "

    "Modified: 19.4.1997 / 12:04:08 / cg"

!

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

    "

    "Modified: 19.4.1997 / 11:42:40 / cg"

!

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

    "

    "Modified: 19.4.1997 / 11:42:45 / cg"

!

startLineDragIn:aView at:dragPoint atEnd:aFourArgBlock

    "start a rubber-line dragging in aView at dragPoint.

     When finished, evaluate the fourArgBlock with targetView,

     targetID, screenPosition and targetViewPosition as arguments"

    ^ self new

        startLineDragIn:aView at:dragPoint atEnd:aFourArgBlock

    "

     |o v|

     v := (Button label:'press me').

     v pressAction:[

                |o|

                o := DropObject newFile:('.').

                v turnOff; repairDamage.

                DragAndDropManager 

                    startLineDragIn:v 

                    at:0@0 

                    atEnd:[:v :vID :sPos :vPos |

                                v isNil ifTrue:[

                                    Transcript show:'alien view'

                                ] ifFalse:[

                                    Transcript show:'view: ';

                                               show:v

                                ].

                                Transcript show:' screen: '; show:sPos;

                                           show:' inView: '; showCR:vPos.

                          ].

              ].

     v openAt:100@100

    "

    "Modified: 19.4.1997 / 12:02:02 / cg"

! !

!DragAndDropManager methodsFor:'accessing'!

dropObjects

    "return the current dropObject collection"

    ^ dropObjects

    "Modified: 19.4.1997 / 10:19:06 / cg"

!

dropObjects:aCollectionOfDropObjects

    "set the current dropObject collection"

    aCollectionOfDropObjects isCollection ifTrue:[

        dropObjects := aCollectionOfDropObjects

    ] ifFalse:[

        dropObjects := Array with:aCollectionOfDropObjects

    ].

    "Modified: 19.4.1997 / 10:19:33 / cg"

! !

!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 and:[dragSize notNil]) ifTrue:[

            self restoreGenericAt:previousPoint

        ] ifFalse:[

            self invertGenericAt:previousPoint

        ]

    ].

    previousPoint := x @ y.

    lastScreenPosition := nil.

    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 and:[dragSize notNil]) ifTrue:[

        self drawGenericAt:previousPoint.

    ] ifFalse:[

        self invertGenericAt:previousPoint

    ].

    "Modified: 19.4.1997 / 11:33:54 / cg"

!

endGenericDragX:x y:y

    "finish a drag; restore from saveUnder (or reinvert),

     then call for the endAction"

    previousPoint notNil ifTrue:[

        (opaque and:[dragSize notNil]) 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: 19.4.1997 / 10:41:57 / cg"

!

startGenericDrag:aTwoArgDragBlock in:aView at:p atEnd:aFourArgEndBlock

    "start a generic (caller-provided drag);

     Here, an inverting drag is initiated (i.e. the drawing is undone

     by inverting again). See startOpaqueDrag for another variant.

     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.

    "Created: 26.10.1996 / 15:16:13 / cg"

    "Modified: 19.4.1997 / 10:44:32 / 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 - generic - inverting'!

invertGenericAt:ip

    "draw for a generic inverting drag"

    |t offs p rootView|

    rootView := dragView device rootView.

    (p := lastScreenPosition) isNil ifTrue:[

        p := ip.

        "

         get device coordinates

        "

        (t := dragView transformation) notNil ifTrue:[

            p := t applyTo:p.