🚧 Add ad-hoc d&d implementation.

React-Dnd is a very nice library but adds a lot of overhead. Causes
a lot of latency when a number of elements grows.

frontend/src/uxbox/main/ui/hooks.cljs

@@ -15,6 +15,7 @@
    [beicon.core :as rx]
    [goog.events :as events]
    [rumext.alpha :as mf]
+   [uxbox.util.transit :as t]
    [uxbox.util.dom :as dom]
    [uxbox.util.webapi :as wapi]
    ["mousetrap" :as mousetrap])
@@ -65,3 +66,139 @@
 
     [toggle @state]))
 
+;; (defn- extract-type
+;;   [dt]
+;;   (let [types (unchecked-get dt "types")
+;;         total (alength types)]
+;;     (loop [i 0]
+;;       (if (= i total)
+;;         nil
+;;         (if-let [match (re-find #"dnd/(.+)" (aget types i))]
+;;           (second match)
+;;           (recur (inc i)))))))
+
+
+(defn invisible-image
+  []
+  (let [img (js/Image.)
+        imd "data:image/gif;base64,R0lGODlhAQABAIAAAAUEBAAAACwAAAAAAQABAAACAkQBADs="]
+    (set! (.-src img) imd)
+    img))
+
+(defn use-sortable
+  [& {:keys [type data on-drop on-drag] :as opts}]
+  (let [ref   (mf/use-ref)
+        state (mf/use-state {})
+
+        on-drag-start
+        (fn [event]
+          ;; (dom/prevent-default event)
+          (dom/stop-propagation event)
+          (let [dtrans (unchecked-get event "dataTransfer")]
+            (.setDragImage dtrans (invisible-image) 0 0)
+            (set! (.-effectAllowed dtrans) "move")
+            (.setData dtrans "application/json" (t/encode data))
+            ;; (.setData dtrans (str "dnd/" type) "")
+            (when (fn? on-drag)
+              (on-drag data))
+            (swap! state (fn [state]
+                           (if (:dragging? state)
+                             state
+                             (assoc state :dragging? true))))))
+
+        on-drag-over
+        (fn [event]
+          (dom/stop-propagation event)
+          (dom/prevent-default event)
+
+          (let [target (dom/get-target event)
+                dtrans (unchecked-get event "dataTransfer")
+                ypos   (unchecked-get event "offsetY")
+                height (unchecked-get target "clientHeight")
+                thold  (/ height 2)
+                side   (if (> ypos thold) :bot :top)]
+
+            (set! (.-dropEffect dtrans) "move")
+            (set! (.-effectAllowed dtrans) "move")
+
+            (swap! state update :over (fn [state]
+                                        (if (not= state side)
+                                          side
+                                          state)))))
+
+        ;; on-drag-enter
+        ;; (fn [event]
+        ;;   (dom/prevent-default event)
+        ;;   (dom/stop-propagation event)
+        ;;   (let [dtrans (unchecked-get event "dataTransfer")
+        ;;         ty (extract-type dt)]
+        ;;     (when (= ty type)
+        ;;       #_(js/console.log "on-drag-enter" (:name data) ty type)
+        ;;       #_(swap! state (fn [state]
+        ;;                      (if (:over? state)
+        ;;                        state
+        ;;                        (assoc state :over? true)))))))
+
+        on-drag-leave
+        (fn [event]
+          (let [target (.-currentTarget event)
+                related (.-relatedTarget event)]
+            (when-not (.contains target related)
+              ;; (js/console.log "on-drag-leave" (:name data))
+              (swap! state (fn [state]
+                             (if (:over state)
+                               (dissoc state :over)
+                               state))))))
+
+        on-drop'
+        (fn [event]
+          (dom/stop-propagation event)
+          (let [target (dom/get-target event)
+                dtrans (unchecked-get event "dataTransfer")
+                dtdata (.getData dtrans "application/json")
+
+                ypos   (unchecked-get event "offsetY")
+                height (unchecked-get target "clientHeight")
+                thold  (/ height 2)
+                side   (if (> ypos thold) :bot :top)]
+
+            ;; TODO: seems unnecessary
+            (swap! state (fn [state]
+                           (cond-> state
+                             (:dragging? state) (dissoc :dragging?)
+                             (:over state) (dissoc :over))))
+
+            (when (fn? on-drop)
+              (on-drop side (t/decode dtdata)))))
+
+        on-drag-end
+        (fn [event]
+          (swap! state (fn [state]
+                         (cond-> state
+                           (:dragging? state) (dissoc :dragging?)
+                           (:over state) (dissoc :over)))))
+
+        on-mount
+        (fn []
+          (let [dom (mf/ref-val ref)]
+            (.setAttribute dom "draggable" true)
+            (.setAttribute dom "data-type" type)
+
+            (.addEventListener dom "dragstart" on-drag-start false)
+            ;; (.addEventListener dom "dragenter" on-drag-enter false)
+            (.addEventListener dom "dragover" on-drag-over false)
+            (.addEventListener dom "dragleave" on-drag-leave true)
+            (.addEventListener dom "drop" on-drop' false)
+            (.addEventListener dom "dragend" on-drag-end false)
+            #(do
+               (.removeEventListener dom "dragstart" on-drag-start)
+               ;; (.removeEventListener dom "dragenter" on-drag-enter)
+               (.removeEventListener dom "dragover" on-drag-over)
+               (.removeEventListener dom "dragleave" on-drag-leave)
+               (.removeEventListener dom "drop" on-drop')
+               (.removeEventListener dom "dragend" on-drag-end))))]
+
+    (mf/use-effect
+     (mf/deps type data on-drop)
+     on-mount)
+    [(deref state) ref]))