"{ Encoding: utf8 }"

"

 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' }"

"{ NameSpace: Smalltalk }"

Object subclass:#DragAndDropManager

	instanceVariableNames:'dropContext dragView dropAction dragOffset handler restoreBlock

		alienCursor enabledCursor disabledCursor canDrop escapePressed

		passiveAction autoScrollTask disabledFlag giveFocusToTargetWidget

		notifyEndOfDropAction savedCursor lastTopView

		timeLastTopViewWasEntered raiseViewTimedAction'

	classVariableNames:'DragContextQuerySignal DragOriginatorQuerySignal

		DragOffsetQuerySignal ActiveDragAndDropManagers

		AutoScrollTimeInterval'

	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 don't 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 it's 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 Display's 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

    <resource: #obsolete>

    "time between autoscrolls in milli-seconds"

    self autoScrollTimeInterval

    "Modified: / 14-06-2018 / 10:43:26 / Claus Gittinger"

!

autoScrollTimeInterval

    "time between autoscrolls in milli-seconds"

    ^ AutoScrollTimeInterval ? 150

    "Created: / 14-06-2018 / 10:42:38 / Claus Gittinger"

!

autoScrollTimeInterval:millisOrNil

    "time between autoscrolls in milli-seconds"

    AutoScrollTimeInterval := millisOrNil

    "Created: / 14-06-2018 / 10:42:47 / Claus Gittinger"

! !

!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

!

startDragFrom:aView dropSource:aDropSource offset:offsetOrSymbol

    "start a drop at the current pointer position.

     offsetOrSymbol can be a point or one of:

        #center

        #topLeft"

    ^ (self new) startDragFrom:aView dropSource:aDropSource offset:offsetOrSymbol

    "Created: / 14-06-2018 / 10:49:43 / Claus Gittinger"

! !

!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 it's 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

"

    "Modified (comment): / 13-02-2017 / 20:36:27 / cg"

!

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 it's 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

"

    "Modified (comment): / 13-02-2017 / 20:36:31 / cg"

!

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.