Hoplon drag-n-drop demo.

core.cljs

(ns dnd.core
  (:require
    [hoplon.core :as h :refer [defelem on!]]
    [javelin.core :as j :refer [with-let cell cell= deref*]]))

(declare end!)

(defn start!
  "Start dragging the item at position <pos>."
  [this pos]
  (let [pos (deref* pos)
        {:keys [set-event-handler! on-start]} @this]
    @set-event-handler!
    (swap! this merge {:start-pos pos :current-pos pos})
    (on-start pos)))

(defn drag-to!
  "Move the item currently being dragged to the new position <new-pos>."
  [this new-pos]
  (let [new-pos (deref* new-pos)
        {:keys [current-pos reorder-fn! on-drag]} @this]
    (when current-pos
      (reorder-fn! current-pos new-pos)
      (swap! this assoc :current-pos new-pos)
      (on-drag current-pos new-pos))))

(defn end!
  "Stop dragging."
  [this]
  (let [{:keys [start-pos current-pos on-end]} @this]
    (when current-pos
      (swap! this merge {:start-pos nil :current-pos nil})
      (on-end start-pos current-pos))))

(defn make-dnd
  "Create a new drag-n-drop state machine. The <reorder-fn!> is a function that
  takes two arguments, <from> and <to>, and does whatever needs to be done to
  move the item at position <from> to be at the new position <to>.

  Three event handlers may be specified:

  :on-start (fn [start-pos] ...)          ;; Fired when the user starts to drag an item.
  :on-drag  (fn [prev-pos curr-pos] ...)  ;; Fired when the item is dragged to a new position.
  :on-end   (fn [start-pos end-pos] ...)  ;; Fired when the item is dropped to its final position."
  [reorder-fn! & {:keys [on-start on-drag on-end]}]
  (with-let [this (cell {:start-pos   nil
                         :current-pos nil
                         :reorder-fn! reorder-fn!
                         :on-start    (or on-start (fn [_]))
                         :on-drag     (or on-drag (fn [_ _]))
                         :on-end      (or on-end (fn [_ _]))})]
    (swap! this assoc :set-event-handler!
           (delay (on! (.-documentElement js/document) :mouseup #(end! this)) true))))

(defelem draggable-item
  "Add drag-n-drop functionality to an item."
  [{:keys [dnd pos] :as attr} [elem]]
  (elem
    :mousedown  #(start! dnd pos)
    :mouseenter #(drag-to! dnd pos)
    :class      (cell= {:dragging-this  (= pos (:current-pos dnd))
                        :dragging-other (and (:current-pos dnd) (not= pos (:current-pos dnd)))})))

index.cljs.hl

(page "index.html"
  (:require [dnd.core :as dnd]))

(defc items
  [{:name "foo1" :price "1.00"}
   {:name "foo2" :price "2.00"}
   {:name "foo3" :price "3.00"}
   {:name "foo4" :price "4.00"}
   {:name "foo5" :price "5.00"}
   {:name "foo6" :price "6.00"}])

(defc= items-indexed
  (map-indexed vector items))

(defn vec-move
  "Given a vector <coll>, moves the item at index <from> to be at index <to>."
  [coll from to]
  (let [v1 (into (subvec coll 0 from) (subvec coll (inc from)))]
    (into (conj (subvec v1 0 to) (get coll from)) (subvec v1 to))))

(def dnd-machine
  (dnd/make-dnd
    #(swap! items vec-move %1 %2)
    :on-start #(pr :on-start %1)
    :on-drag #(pr :on-drag %1 %2)
    :on-end #(pr :on-end %1 %2)))

(html
  (head
    (style
      "body > div         { width: 600px; margin: 0 auto; }
       h1                 { text-align: center; }
       ul                 { cursor: grabbing; cursor: -moz-grabbing; cursor: -webkit-grabbing; list-style-type: none; padding: 0; margin: 0; background: #6c6c6c; border: 1px solid black; }
       li                 { padding: 10px; background: white; border: 1px solid black; }
       li.draggable       { cursor: move; cursor: grab; cursor: -moz-grab; cursor: -webkit-grab; user-select: none; }
       li.dragging-other  { cursor: grabbing; cursor: -moz-grabbing; cursor: -webkit-grabbing; background: #efefef; }
       li.dragging-this   { cursor: grabbing; cursor: -moz-grabbing; cursor: -webkit-grabbing; transform: rotate(0.75deg); box-shadow: 0px 0px 10px #6c6c6c; }"))
  (body
    (div
      (h1 (code "DRAG AND DROP"))
      (ul (for-tpl [[idx {:keys [name price] :as item}] items-indexed]
            (dnd/draggable-item :dnd dnd-machine :pos idx
              (li :class "draggable" (cell= (str name ": " price)))))))))