;;;-*- Mode: Lisp; Package: CL-USER -*-

;;
;; Drag and drop between windows
;;

(defclass drag-list (capi:list-panel)
  ((flavor :initform nil :initarg :flavor :accessor flavor))
  (:default-initargs
   :drag-callback #'drag-callback
   :drop-callback #'drop-callback
   :interaction :extended-selection))

(defun make-chooser (type items)
  (let* ((items-pane (make-instance 'drag-list :items items :flavor type))
         (layout 
          (make-instance 'capi:row-layout :adjust :center 
                         :description (list items-pane)))
         (window
          (make-instance 'capi:interface :title (format nil "~:(~as~)" type)
                         :best-width 200 :best-height 150 :layout layout)))
    (capi:display window)))

(defun drag-callback (pane indices)
  (list (flavor pane)
        (cons pane (map 'list 
                        #'(lambda (i) (elt (capi:collection-items pane) i))
                        indices))))

(defmethod drop-callback (pane drop-object stage)
  (case stage
    (:formats
     (capi:set-drop-object-supported-formats 
      drop-object 
      (list (flavor pane))))
    (:drag
     (let ((format (flavor pane)))
       (when (capi:drop-object-provides-format drop-object format)
         ;; Ignore drop position
         (setf (capi:drop-object-collection-index drop-object)
               (values -1 :item))
         (setf (capi:drop-object-drop-effect drop-object) :move))))
    (:drop
     (let ((format (flavor pane)))
       (when (capi:drop-object-provides-format drop-object format)
         (let ((drag (capi:drop-object-get-object drop-object pane format)))
           (move-items (cdr drag) (car drag) pane)
           (setf (capi:drop-object-drop-effect drop-object) :move)))))))

(defun move-items (items from to)
  (capi:remove-items from items)
  (capi:append-items to items))

; Example

(make-chooser :animal '("Alligator" "Buzzard" "Cheetah" "Dolphin" "Elephant"))
(make-chooser :animal '("Cat" "Mouse" "Giraffe" "Panther" "Tiger"))
(make-chooser :plant '("Daisy" "Oak" "Fern" "Rose" "Lily"))
(make-chooser :plant '("Sycamore" "Pine" "Hyacinth" "Cabbage" "Dandelion"))