"

 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.

"

"{ Package: 'stx:libview2' }"

Object subclass:#DragAndDropManager

	instanceVariableNames:'dropContext dragView dropAction dragOffset handler restoreBlock

		alienCursor enabledCursor disabledCursor canDrop escapePressed

		passiveAction autoScrollTask disabledFlag giveFocusToTargetWidget

		notifyEndOfDropAction'

	classVariableNames:'DragContextQuerySignal DragOriginatorQuerySignal

		DragOffsetQuerySignal ActiveDragAndDropManagers'

	poolDictionaries:''

	category:'Interface-DragAndDrop'

!

!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:]

	DemoView1, DemoView2, ...

	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,

  to open a fileBrowser on that directory ...

								[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]

   more drag & drop; offset, displayObjects, ...

								[exBegin]

    |dropObj topView pannel icon buttonAction addButton|

    topView := StandardSystemView new.

    pannel  := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.

    pannel  horizontalLayout:#fit.

    pannel  verticalLayout:#fitSpace.

    icon    := Image fromFile:('xpmBitmaps/QUESTION3.xpm').

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

    addButton := [:offset :label :dispObj| |button|

	button := Button label:label in:pannel.

	button pressAction:[

	    DragAndDropManager startDrag:dropObj from:button offset:offset display:dispObj.

	    button turnOff.

	]

    ].

    addButton value:(0@-5)       value:'String'       value:'String'.

    addButton value:#topLeft     value:'String'       value:'String'.

    addButton value:#topRight    value:'Text'         value:(Text string:'hello' emphasis:#bold).

    addButton value:#bottomLeft  value:'Icon'         value:icon.

    addButton value:#bottomRight value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').

    addButton value:#center      value:'Mixed'        value:(Array with:'String' with:icon).

    topView label:'Drag & Drop'.

    topView openWithExtent:200@200.

								[exEnd]

"

! !

!DragAndDropManager class methodsFor:'initialization'!

initialize

    DragOriginatorQuerySignal := QuerySignal new.

    DragOffsetQuerySignal := QuerySignal new.

    DragContextQuerySignal := QuerySignal new.

    ActiveDragAndDropManagers := IdentityDictionary new.

    "

     self initialize

    "

    "Modified: 11.8.1997 / 00:54:21 / cg"

! !

!DragAndDropManager class methodsFor:'instance creation'!

new

    ^ self basicNew initialize

! !

!DragAndDropManager class methodsFor:'Signal constants'!

dragContextQuerySignal

    ^ DragContextQuerySignal

!

dragOffsetQuerySignal

    ^ DragOffsetQuerySignal

    "Created: 11.8.1997 / 00:54:10 / cg"

!

dragOriginatorQuerySignal

    ^ DragOriginatorQuerySignal

! !

!DragAndDropManager class methodsFor:'defaults'!

autoScrollDelayTimeMs

    "time measured in milli-seconds the autoscroll task is delayed"

    ^ 200

! !

!DragAndDropManager class methodsFor:'helpers'!

disabledFlag:aBoolean device:aDevice

    |activeManager|

    activeManager := ActiveDragAndDropManagers at:aDevice ifAbsent:nil.

    activeManager notNil ifTrue:[

        activeManager disabledFlag: aBoolean

    ].

!

postDraggingOnDevice:aDevice

    |activeManager|

    activeManager := ActiveDragAndDropManagers at:aDevice ifAbsent:nil.

    activeManager notNil ifTrue:[

        activeManager dragHandler postDragging

    ].

!

rereadSaveAreaOnDevice:aDevice

    |activeManager|

    activeManager := ActiveDragAndDropManagers at:aDevice ifAbsent:nil.

    activeManager notNil ifTrue:[

        activeManager dragHandler flushSaveArea; rereadSaveArea

    ].

!

saveDraw:aBlock device:aDevice

    |activeManager|

    activeManager := ActiveDragAndDropManagers at:aDevice ifAbsent:nil.

    activeManager isNil ifTrue:[

        aBlock value

    ] ifFalse:[

        activeManager saveDraw:aBlock

    ].

! !

!DragAndDropManager class methodsFor:'queries'!

isDragAndDropActiveOnDevice:aDevice

    ^ ActiveDragAndDropManagers includesKey:aDevice

! !

!DragAndDropManager class methodsFor:'simple start-drop source'!

startDragFrom:aView dropSource:aDropSource

    "start a drop at the current pointer position."

    ^ (self new) startDragFrom:aView dropSource:aDropSource

! !

!DragAndDropManager class methodsFor:'simple start-generic'!

startDrag:draggableObjects from:aView

    "start a drop at the current pointer position"

    ^ self startDrag:draggableObjects

                from:aView

              offset:0@0

               atEnd:nil

             display:draggableObjects

"

EXAMPLE:

    |button|

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

    button pressAction:[

        DragAndDropManager startDrag:(DropObject newFile:('.')) from:button.

        button turnOff

    ].

    button openAt:100@100

"

!

startDrag:draggableObjects from:aView atEnd:aFourArgEndBlock

    "start a drop at the current pointer position

     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 startDrag:draggableObjects

                from:aView

              offset:0@0

               atEnd:aFourArgEndBlock

             display:draggableObjects

"

EXAMPLE:

    |button|

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

    button pressAction:[

        DragAndDropManager startDrag:(DropObject newFile:('.'))

                                from:button

                               atEnd:[:targetView :targetViewId :screenPoint :targetPoint|

                                        Transcript showCR:'target  view: ', targetView   printString.

                                        Transcript showCR:'target    id: ', targetViewId printString.

                                        Transcript showCR:'point screen: ', screenPoint  printString.

                                        Transcript showCR:'point target: ', targetPoint  printString.

                                     ].

        button turnOff

    ].

    button openAt:100@100

"

!

startDrag:draggableObjects from:aView atEnd:aFourArgEndBlock display:something

    "start a drop at the current pointer position

     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 startDrag:draggableObjects

                from:aView

              offset:0@0

               atEnd:aFourArgEndBlock

             display:something

"

EXAMPLE:

    |button|

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

    button pressAction:[

        DragAndDropManager startDrag:(DropObject newFile:('.'))

                                from:button

                               atEnd:[:targetView :targetViewId :screenPoint :targetPoint|

                                        Transcript showCR:'target  view: ', targetView   printString.

                                        Transcript showCR:'target    id: ', targetViewId printString.

                                        Transcript showCR:'point screen: ', screenPoint  printString.

                                        Transcript showCR:'point target: ', targetPoint  printString.

                                     ]

                             display:(Array with:'String' with:(Image fromFile:('xpmBitmaps/QUESTION3.xpm'))).

        button turnOff

    ].

    button openAt:100@100

"

!

startDrag:draggableObjects from:aView display:something

    "start a drop at the current pointer position"

    ^ self startDrag:draggableObjects

                from:aView

              offset:0@0

               atEnd:nil

             display:something

"

EXAMPLE:

    |dropObj topView pannel icon buttonAction addButton|

    topView := StandardSystemView new.

    pannel  := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.

    pannel  horizontalLayout:#fit.

    pannel  verticalLayout:#fitSpace.

    icon    := Image fromFile:('xpmBitmaps/QUESTION3.xpm').

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

    addButton := [:label :dispObj| |button|

        button := Button label:label in:pannel.

        button pressAction:[

            DragAndDropManager startDrag:dropObj from:button display:dispObj.

            button turnOff.

        ]

    ].

    addButton value:'String'       value:'String'.

    addButton value:'Text'         value:(Text string:'hello' emphasis:#bold).

    addButton value:'Icon'         value:icon.

    addButton value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').

    addButton value:'Mixed'        value:(Array with:'String' with:icon).

    topView label:'Drag & Drop'.

    topView openWithExtent:200@200.

"

!

startDrag:draggableObjects from:aView offset:anOffset

    "start a drop at the current pointer position"

    ^ self startDrag:draggableObjects

                from:aView

              offset:anOffset

               atEnd:nil

             display:draggableObjects

"

EXAMPLE:

    |button|

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