diff --git a/frontend/src/uxbox/main/ui/hooks.cljs b/frontend/src/uxbox/main/ui/hooks.cljs index 8534c7e2b..412864c92 100644 --- a/frontend/src/uxbox/main/ui/hooks.cljs +++ b/frontend/src/uxbox/main/ui/hooks.cljs @@ -17,6 +17,7 @@ [rumext.alpha :as mf] [uxbox.util.transit :as t] [uxbox.util.dom :as dom] + [uxbox.util.dom.dnd :as dnd] [uxbox.util.webapi :as wapi] [uxbox.util.timers :as ts] ["mousetrap" :as mousetrap]) @@ -73,18 +74,6 @@ (set! (.-src img) imd) img)) -(defn drop-side - [height ypos detect-center?] - (let [thold (/ height 2) - thold1 (* height 0.2) - thold2 (* height 0.8)] - (if detect-center? - (cond - (< ypos thold1) :top - (> ypos thold2) :bot - :else :center) - (if (> ypos thold) :bot :top)))) - (defn- set-timer [state ms func] (assoc state :timer (ts/schedule ms func))) @@ -98,24 +87,6 @@ (dissoc state :timer)) state))) -;; The dnd interface is broken in several ways. This is the official documentation -;; https://developer.mozilla.org/en-US/docs/Web/API/HTML_Drag_and_Drop_API -;; -;; And there is some discussion of the problems and many uncomplete solutions -;; https://github.com/lolmaus/jquery.dragbetter/#what-this-is-all-about -;; https://www.w3schools.com/jsref/event_relatedtarget.asp -;; https://stackoverflow.com/questions/14194324/firefox-firing-dragleave-when-dragging-over-text?noredirect=1&lq=1 -;; https://stackoverflow.com/questions/7110353/html5-dragleave-fired-when-hovering-a-child-element - -;; This function is useful to debug the erratic dnd interface behaviour when something weird occurs -;; (defn- trace -;; [event data label] -;; (js/console.log -;; label -;; "[" (:name data) "]" -;; (if (.-currentTarget event) (.-textContent (.-currentTarget event)) "null") -;; (if (.-relatedTarget event) (.-textContent (.-relatedTarget event)) "null"))) - (defn use-sortable [& {:keys [data-type data on-drop on-drag on-hold detect-center?] :as opts}] (let [ref (mf/use-ref) @@ -125,78 +96,61 @@ on-drag-start (fn [event] (dom/stop-propagation event) - ;; (trace event data "drag-start") - (let [dtrans (unchecked-get event "dataTransfer")] - (.setDragImage dtrans (invisible-image) 0 0) - (set! (.-effectAllowed dtrans) "move") - (.setData dtrans data-type (t/encode data)) - (when (fn? on-drag) - (on-drag data)))) + ;; (dnd/trace event data "drag-start") + (dnd/set-data! event data-type data) + (dnd/set-drag-image! event (invisible-image)) + (dnd/set-allowed-effect! event "move") + (when (fn? on-drag) + (on-drag data))) on-drag-enter (fn [event] (dom/prevent-default event) ;; prevent default to allow drag enter - (let [target (.-currentTarget event) - related (.-relatedTarget event)] - (when-not (.contains target related) ;; ignore events triggered by elements that are - (dom/stop-propagation event) ;; children of the drop target - ;; (trace event data "drag-enter") - (when (fn? on-hold) - (swap! state (fn [state] - (-> state - (cancel-timer) - (set-timer 1000 on-hold)))))))) + (when-not (dnd/from-child? event) + (dom/stop-propagation event) + ;; (dnd/trace event data "drag-enter") + (when (fn? on-hold) + (swap! state (fn [state] + (-> state + (cancel-timer) + (set-timer 1000 on-hold))))))) on-drag-over (fn [event] - (let [dtrans (unchecked-get event "dataTransfer") - target (.-currentTarget event) - related (.-relatedTarget event) - ypos (unchecked-get event "offsetY") - height (unchecked-get target "clientHeight") - side (drop-side height ypos detect-center?)] - (when (.includes (.-types dtrans) data-type) - (dom/prevent-default event) ;; prevent default to allow drag over - (when-not (.contains target related) - (dom/stop-propagation event) - ;; (trace event data "drag-over") + (when (dnd/has-type? event data-type) + (dom/prevent-default event) ;; prevent default to allow drag over + (when-not (dnd/from-child? event) + (dom/stop-propagation event) + ;; (dnd/trace event data "drag-over") + (let [side (dnd/drop-side event detect-center?)] (swap! state assoc :over side))))) on-drag-leave (fn [event] - (let [target (.-currentTarget event) - related (.-relatedTarget event)] - (when-not (.contains target related) - (dom/stop-propagation event) - ;; (trace event data "drag-leave") - (swap! state (fn [state] - (-> state - (cancel-timer) - (dissoc :over))))))) + (when-not (dnd/from-child? event) + (dom/stop-propagation event) + ;; (dnd/trace event data "drag-leave") + (swap! state (fn [state] + (-> state + (cancel-timer) + (dissoc :over)))))) on-drop' (fn [event] (dom/stop-propagation event) - ;; (trace event data "drop") - (let [dtrans (unchecked-get event "dataTransfer") - dtdata (.getData dtrans data-type) - - target (.-currentTarget event) - ypos (unchecked-get event "offsetY") - height (unchecked-get target "clientHeight") - side (drop-side height ypos detect-center?)] - + ;; (dnd/trace event data "drop") + (let [side (dnd/drop-side event detect-center?) + drop-data (dnd/get-data event data-type)] (swap! state (fn [state] (-> state (cancel-timer) (dissoc :over)))) - (when (fn? on-drop) - (on-drop side (t/decode dtdata))))) + (on-drop side drop-data)))) on-drag-end (fn [event] - ;; (trace event data "drag-end") + ;; (dnd/trace event data "drag-end") (swap! state (fn [state] (-> state (cancel-timer) diff --git a/frontend/src/uxbox/main/ui/workspace/viewport.cljs b/frontend/src/uxbox/main/ui/workspace/viewport.cljs index 0b68030b0..4f929efbc 100644 --- a/frontend/src/uxbox/main/ui/workspace/viewport.cljs +++ b/frontend/src/uxbox/main/ui/workspace/viewport.cljs @@ -312,14 +312,19 @@ on-drop (fn [event] (dom/prevent-default event) - (let [shape (dom/get-data-transfer event) - point (gpt/point (.-clientX event) (.-clientY event)) - viewport-coord (translate-point-to-viewport point) - final-x (- (:x viewport-coord) (/ (:width shape) 2)) - final-y (- (:y viewport-coord) (/ (:height shape) 2))] - (st/emit! (dw/add-shape (-> shape - (assoc :x final-x) - (assoc :y final-y)))))) + (if (dnd/has-type? event "uxbox/shape") + + (let [shape (dnd/get-data event "uxbox/shape") + point (gpt/point (.-clientX event) (.-clientY event)) + viewport-coord (translate-point-to-viewport point) + final-x (- (:x viewport-coord) (/ (:width shape) 2)) + final-y (- (:y viewport-coord) (/ (:height shape) 2))] + (st/emit! (dw/add-shape (-> shape + (assoc :x final-x) + (assoc :y final-y))))) + + (let [files (dnd/get-files event)] + (run! #(st/emit! (dw/upload-image % on-uploaded)) files)))) on-resize (fn [event] diff --git a/frontend/src/uxbox/util/dom.cljs b/frontend/src/uxbox/util/dom.cljs index ec491c9ee..3eac0c630 100644 --- a/frontend/src/uxbox/util/dom.cljs +++ b/frontend/src/uxbox/util/dom.cljs @@ -162,16 +162,6 @@ [node] (.focus node)) -(defn set-data-transfer - [event data] - (let [data-string (ts/encode data)] - (-> event .-dataTransfer (.setData "text/plain" data-string)))) - -(defn get-data-transfer - [event] - (let [data-string (-> event .-dataTransfer (.getData "text/plain"))] - (ts/decode data-string))) - (defn fullscreen? [] (boolean (.-fullscreenElement js/document))) diff --git a/frontend/src/uxbox/util/dom/dnd.cljs b/frontend/src/uxbox/util/dom/dnd.cljs index 8d27930d7..55d7bd64d 100644 --- a/frontend/src/uxbox/util/dom/dnd.cljs +++ b/frontend/src/uxbox/util/dom/dnd.cljs @@ -7,11 +7,44 @@ (ns uxbox.util.dom.dnd "Drag & Drop interop helpers." - (:require [uxbox.util.data :refer (read-string)])) + (:require + [uxbox.util.data :refer (read-string)] + [uxbox.util.transit :as t])) -(defn event->data-transfer - [e] - (.-dataTransfer e)) +;; This is the official documentation for the dnd API: +;; https://developer.mozilla.org/en-US/docs/Web/API/HTML_Drag_and_Drop_API +;; +;; The API is broken in several ways. Here is some discussion of the problems, +;; and many uncomplete solutions: +;; https://github.com/lolmaus/jquery.dragbetter/#what-this-is-all-about +;; https://www.w3schools.com/jsref/event_relatedtarget.asp +;; https://stackoverflow.com/questions/14194324/firefox-firing-dragleave-when-dragging-over-text?noredirect=1&lq=1 +;; https://stackoverflow.com/questions/7110353/html5-dragleave-fired-when-hovering-a-child-element + +(defn trace + ;; This function is useful to debug the erratic dnd interface behaviour when something weird occurs + [event data label] + (js/console.log + label + "[" (:name data) "]" + (if (.-currentTarget event) (.-textContent (.-currentTarget event)) "null") + (if (.-relatedTarget event) (.-textContent (.-relatedTarget event)) "null"))) + +(defn set-data! + ([e data] + (set-data! e "uxbox/data" data)) + ([e data-type data] + (let [dt (.-dataTransfer e)] + (.setData dt data-type (t/encode data)) + e))) + +(defn set-drag-image! + ([e image] + (set-drag-image! e image 0 0)) + ([e image offset-x offset-y] + (let [dt (.-dataTransfer e)] + (.setDragImage dt image offset-x offset-y) + e))) (defn set-allowed-effect! [e effect] @@ -25,40 +58,44 @@ (set! (.-dropEffect dt) effect) e)) -(defn set-data! - ([e data] - (set-data! e "uxbox/data" data)) - ([e key data] - (let [dt (.-dataTransfer e)] - (.setData dt (str key) (pr-str data))))) +(defn has-type? + [e data-type] + (let [dt (.-dataTransfer e)] + (.includes (.-types dt) data-type))) -(defn set-image! - ([e data] - (set-image! e data 0 0)) - ([e data x y] - (let [dt (.-dataTransfer e) - st (.-style data)] - (.setDragImage dt data x y)))) +(defn from-child? + [e] + ;; The relatedTarget property contains the dom element that was under + ;; the mouse *before* the event. This is useful, for example, to filter + ;; out enter or over events initiated by children of the drop target. + (let [target (.-currentTarget e) + related (.-relatedTarget e)] + (.contains target related))) (defn get-data ([e] (get-data e "uxbox/data")) - ([e key] + ([e data-type] (let [dt (.-dataTransfer e)] - (read-string (.getData dt (str key)))))) + (t/decode (.getData dt data-type))))) -(defn get-hover-position - [event group?] - (let [target (.-currentTarget event) - brect (.getBoundingClientRect target) - width (.-offsetHeight target) - y (- (.-clientY event) (.-top brect)) - part (/ (* 30 width) 100)] - (if group? +(defn get-files + [e] + (let [dt (.-dataTransfer e)] + (.-files dt))) + +(defn drop-side + [e detect-center?] + (let [ypos (.-offsetY e) + target (.-currentTarget e) + height (.-clientHeight target) + thold (/ height 2) + thold1 (* height 0.2) + thold2 (* height 0.8)] + (if detect-center? (cond - (> part y) :top - (< (- width part) y) :bottom - :else :middle) - (if (>= y (/ width 2)) - :bottom - :top)))) + (< ypos thold1) :top + (> ypos thold2) :bot + :else :center) + (if (> ypos thold) :bot :top)))) +