0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-02-10 17:18:21 -05:00

♻️ Refactor drag'n drop code

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

View file

@ -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)

View file

@ -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]

View file

@ -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)))

View file

@ -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))))