;; (ql:quickload :qtools-ui)
;; (in-readtable :qtools)

;;; MIME data containing a Lisp data reference

(defvar *mime-data-with-qobject-type*
  "application/qtools-mime-data-with-qobject")

(define-widget mime-data-with-qobject (qmimedata)
  ((object :accessor object
           :initarg :object
           :initform nil)))

;;; Draggable

(define-widget draggable (QWidget)
  ((mime-type :accessor mime-type
              :initarg :mime-type
              :initform nil)))

(define-override (draggable mouse-press-event) (event)
  (when (eq (enum-value (q+:button event)) (q+:qt.left-button))
    (let ((drag (q+:make-qdrag draggable))
          (mime-data (make-instance 'mime-data-with-qobject
                                    :object draggable)))
      (setf (q+:data mime-data *mime-data-with-qobject-type*) ""
            (q+:mime-data drag) mime-data)
      (let ((drop-action (q+:exec drag)))
        drop-action)))
  (stop-overriding))

;;; Drop target

(define-widget drop-target (QWidget)
  ((callback :accessor callback
             :initarg :callback
             :initform (constantly nil))))

(define-initializer (drop-target initialize-drop-target)
  (setf (q+:accept-drops drop-target) t))

(define-override (drop-target drag-enter-event) (event)
  (when (q+:has-format (q+:mime-data event) *mime-data-with-qobject-type*)
    (q+:accept-proposed-action event)))

(define-override (drop-target drop-event) (event)
  (let ((mime-data (q+:mime-data event)))
    (when (typep mime-data 'mime-data-with-qobject)
      (funcall callback drop-target (object mime-data)))))

;;; Test - drag from top half of window to bottom half of window

(defun test ()
  (flet ((callback (drop-target object)
           (declare (ignore drop-target object))
           (print "DnD successful!")))
    (with-main-window (layout 'qui:flow-layout)
      (qui:add-widget (make-instance 'draggable) layout)
      (qui:add-widget (make-instance 'drop-target :callback #'callback)
                      layout))))