Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-02-13 18:48:37 -05:00
Code Issues Activity

♻️ Refactor drag'n drop code

Browse source
This commit is contained in:
Andrés Moya 2020-06-01 14:51:22 +02:00
parent 9901f0a52b
commit f5f7607ce3
4 changed files with 116 additions and 130 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

112
frontend/src/uxbox/main/ui/hooks.cljs
View file

@ -17,6 +17,7 @@
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.util.transit :as t] [uxbox.util.transit :as t]
[uxbox.util.dom :as dom] [uxbox.util.dom :as dom]
[uxbox.util.dom.dnd :as dnd]
[uxbox.util.webapi :as wapi] [uxbox.util.webapi :as wapi]
[uxbox.util.timers :as ts] [uxbox.util.timers :as ts]
["mousetrap" :as mousetrap]) ["mousetrap" :as mousetrap])
@ -73,18 +74,6 @@
(set! (.-src img) imd) (set! (.-src img) imd)
img)) 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 (defn- set-timer
[state ms func] [state ms func]
(assoc state :timer (ts/schedule ms func))) (assoc state :timer (ts/schedule ms func)))
@ -98,24 +87,6 @@
(dissoc state :timer)) (dissoc state :timer))
state))) 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 (defn use-sortable
[& {:keys [data-type data on-drop on-drag on-hold detect-center?] :as opts}] [& {:keys [data-type data on-drop on-drag on-hold detect-center?] :as opts}]
(let [ref (mf/use-ref) (let [ref (mf/use-ref)
@ -125,78 +96,61 @@
on-drag-start on-drag-start
(fn [event] (fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
;; (trace event data "drag-start") ;; (dnd/trace event data "drag-start")
(let [dtrans (unchecked-get event "dataTransfer")] (dnd/set-data! event data-type data)
(.setDragImage dtrans (invisible-image) 0 0) (dnd/set-drag-image! event (invisible-image))
(set! (.-effectAllowed dtrans) "move") (dnd/set-allowed-effect! event "move")
(.setData dtrans data-type (t/encode data)) (when (fn? on-drag)
(when (fn? on-drag) (on-drag data)))
(on-drag data))))
on-drag-enter on-drag-enter
(fn [event] (fn [event]
(dom/prevent-default event) ;; prevent default to allow drag enter (dom/prevent-default event) ;; prevent default to allow drag enter
(let [target (.-currentTarget event) (when-not (dnd/from-child? event)
related (.-relatedTarget event)] (dom/stop-propagation event)
(when-not (.contains target related) ;; ignore events triggered by elements that are ;; (dnd/trace event data "drag-enter")
(dom/stop-propagation event) ;; children of the drop target (when (fn? on-hold)
;; (trace event data "drag-enter") (swap! state (fn [state]
(when (fn? on-hold) (-> state
(swap! state (fn [state] (cancel-timer)
(-> state (set-timer 1000 on-hold)))))))
(cancel-timer)
(set-timer 1000 on-hold))))))))
on-drag-over on-drag-over
(fn [event] (fn [event]
(let [dtrans (unchecked-get event "dataTransfer") (when (dnd/has-type? event data-type)
target (.-currentTarget event) (dom/prevent-default event) ;; prevent default to allow drag over
related (.-relatedTarget event) (when-not (dnd/from-child? event)
ypos (unchecked-get event "offsetY") (dom/stop-propagation event)
height (unchecked-get target "clientHeight") ;; (dnd/trace event data "drag-over")
side (drop-side height ypos detect-center?)] (let [side (dnd/drop-side event 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")
(swap! state assoc :over side))))) (swap! state assoc :over side)))))
on-drag-leave on-drag-leave
(fn [event] (fn [event]
(let [target (.-currentTarget event) (when-not (dnd/from-child? event)
related (.-relatedTarget event)] (dom/stop-propagation event)
(when-not (.contains target related) ;; (dnd/trace event data "drag-leave")
(dom/stop-propagation event) (swap! state (fn [state]
;; (trace event data "drag-leave") (-> state
(swap! state (fn [state] (cancel-timer)
(-> state (dissoc :over))))))
(cancel-timer)
(dissoc :over)))))))
on-drop' on-drop'
(fn [event] (fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
;; (trace event data "drop") ;; (dnd/trace event data "drop")
(let [dtrans (unchecked-get event "dataTransfer") (let [side (dnd/drop-side event detect-center?)
dtdata (.getData dtrans data-type) drop-data (dnd/get-data event data-type)]
target (.-currentTarget event)
ypos (unchecked-get event "offsetY")
height (unchecked-get target "clientHeight")
side (drop-side height ypos detect-center?)]
(swap! state (fn [state] (swap! state (fn [state]
(-> state (-> state
(cancel-timer) (cancel-timer)
(dissoc :over)))) (dissoc :over))))
(when (fn? on-drop) (when (fn? on-drop)
(on-drop side (t/decode dtdata))))) (on-drop side drop-data))))
on-drag-end on-drag-end
(fn [event] (fn [event]
;; (trace event data "drag-end") ;; (dnd/trace event data "drag-end")
(swap! state (fn [state] (swap! state (fn [state]
(-> state (-> state
(cancel-timer) (cancel-timer)

21
frontend/src/uxbox/main/ui/workspace/viewport.cljs
View file

@ -312,14 +312,19 @@
on-drop on-drop
(fn [event] (fn [event]
(dom/prevent-default event) (dom/prevent-default event)
(let [shape (dom/get-data-transfer event) (if (dnd/has-type? event "uxbox/shape")
point (gpt/point (.-clientX event) (.-clientY event))
viewport-coord (translate-point-to-viewport point) (let [shape (dnd/get-data event "uxbox/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2)) point (gpt/point (.-clientX event) (.-clientY event))
final-y (- (:y viewport-coord) (/ (:height shape) 2))] viewport-coord (translate-point-to-viewport point)
(st/emit! (dw/add-shape (-> shape final-x (- (:x viewport-coord) (/ (:width shape) 2))
(assoc :x final-x) final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(assoc :y final-y)))))) (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 on-resize
(fn [event] (fn [event]

10
frontend/src/uxbox/util/dom.cljs
View file

@ -162,16 +162,6 @@
[node] [node]
(.focus 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? (defn fullscreen?
[] []
(boolean (.-fullscreenElement js/document))) (boolean (.-fullscreenElement js/document)))

103
frontend/src/uxbox/util/dom/dnd.cljs
View file

@ -7,11 +7,44 @@
(ns uxbox.util.dom.dnd (ns uxbox.util.dom.dnd
"Drag & Drop interop helpers." "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 ;; This is the official documentation for the dnd API:
[e] ;; https://developer.mozilla.org/en-US/docs/Web/API/HTML_Drag_and_Drop_API
(.-dataTransfer e)) ;;
;; 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! (defn set-allowed-effect!
[e effect] [e effect]
@ -25,40 +58,44 @@
(set! (.-dropEffect dt) effect) (set! (.-dropEffect dt) effect)
e)) e))
(defn set-data! (defn has-type?
([e data] [e data-type]
(set-data! e "uxbox/data" data)) (let [dt (.-dataTransfer e)]
([e key data] (.includes (.-types dt) data-type)))
(let [dt (.-dataTransfer e)]
(.setData dt (str key) (pr-str data)))))
(defn set-image! (defn from-child?
([e data] [e]
(set-image! e data 0 0)) ;; The relatedTarget property contains the dom element that was under
([e data x y] ;; the mouse *before* the event. This is useful, for example, to filter
(let [dt (.-dataTransfer e) ;; out enter or over events initiated by children of the drop target.
st (.-style data)] (let [target (.-currentTarget e)
(.setDragImage dt data x y)))) related (.-relatedTarget e)]
(.contains target related)))
(defn get-data (defn get-data
([e] ([e]
(get-data e "uxbox/data")) (get-data e "uxbox/data"))
([e key] ([e data-type]
(let [dt (.-dataTransfer e)] (let [dt (.-dataTransfer e)]
(read-string (.getData dt (str key)))))) (t/decode (.getData dt data-type)))))
(defn get-hover-position (defn get-files
[event group?] [e]
(let [target (.-currentTarget event) (let [dt (.-dataTransfer e)]
brect (.getBoundingClientRect target) (.-files dt)))
width (.-offsetHeight target)
y (- (.-clientY event) (.-top brect)) (defn drop-side
part (/ (* 30 width) 100)] [e detect-center?]
(if group? (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 (cond
(> part y) :top (< ypos thold1) :top
(< (- width part) y) :bottom (> ypos thold2) :bot
:else :middle) :else :center)
(if (>= y (/ width 2)) (if (> ypos thold) :bot :top))))
:bottom
:top))))